PC Interdit/pc-interdit.iso/sound/gusmod/tcp.pas

Pascal/Delphi Source File | 1994-10-21 | 12.3 KB | 541 lines

{$A+,B-,D+,E+,F+,G+,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
{$M 16384,0,250000}

program gusdemo;

uses crt,dos,design,fselect,gus_mod;

type
  Pphun = ^TPhun;
  TPhun = array[0..799] of string[80];

const mod_chem = '';

const Programm_quitter : boolean = false;

var phun : Pphun;
    phuncount : integer;
    modify_voice : integer;
    i : integer;
    Les_files : Pfileselect_struct;
    curr_modnr : integer;

{
  Intégration des écrans ANSI
}

{$L c:\edition\prog\fr\asm\tcpans}
procedure tcpans; external;
{$L c:\edition\prog\fr\asm\we_are}
procedure we_are; external;
{$L c:\edition\prog\fr\asm\buy_it}
procedure buy_it; external;
{$L c:\edition\prog\fr\asm\call}
procedure call; external;
{$L c:\edition\prog\fr\asm\helptxt}
procedure helptxt; external;


function fichier_exists(dname : string) : boolean;
{
 Vérifie si le fichier transmis existe
}
var dumf : file;
begin;
  {$I-}
  assign(dumf,dname);
  reset(dumf,1);
  {$I+}
  if IOResult <> 0 then
    fichier_exists := false
  else begin;
    fichier_exists := true;
    close(dumf);
  end;
end;

procedure color_writeln(s : string);
{
 Pour sortir une chaîne dans la combinaison de couleurs TC
}
var colpos,li : integer;
begin;
  colpos := 1;
  for li := 1 to length(s) do begin;
    if s[li] = ' ' then colpos := 0;
    inc(colpos);
    case colpos of
        1..2 : begin;
                 textcolor(8);
               end;
        3..4 : begin;
                textcolor(2);
               end;
      5..$ff : begin;
                 textcolor(10);
               end;
    end;
    write(s[li]);
  end;
end;

procedure write_nomfichier(s : string);
{
 Affiche le nom de fichier de la chanson, centré
}
var li,slen : integer;
begin;
  gotoxy(33,13);
  while pos('\',s) <> 0 do begin;
    delete(s,1,pos('\',s));
  end;
  slen := length(s);
  slen := (15 - slen) div 2;
  for li := 1 to slen do s := ' '+s;
  write(s);
end;

procedure write_phunliners;
{
 Lit trois lignes dans le fichier "Phun.txt" et les affiche
 à l'écran. Le fichier "Phun.txt" est un fichier texte
 que l'on peut éditer librement !
}
var tf : text;
begin;
  randomize;
  if not fichier_exists('phun.txt') then exit;
  assign(tf,'phun.txt');
  reset(tf);
  phuncount := 0;
  {$I+}
  if ioresult = 0 then begin;
    while not eof(tf) do begin;
      readln(tf,phun^[phuncount]);
      inc(phuncount);
    end;
    close(tf);
    gotoxy(3,43);
    color_writeln(phun^[random(phuncount)]);
    gotoxy(3,44);
    color_writeln(phun^[random(phuncount)]);
    gotoxy(3,45);
    color_writeln(phun^[random(phuncount)]);
  end;
  {$I-}
end;

procedure display_modinfos;
{
 Affiche le nom des instruments dans le module actuel
}
var li : integer;
begin;
  textcolor(14);
  textbackground(black);
  for li := 1 to 16 do begin;
    gotoxy(6,17+li);
    color_writeln(Instruments[li]^.nom);
    gotoxy(50,17+li);
    color_writeln(Instruments[li+16]^.nom);
  end;
end;

procedure exit_program;
{
 Avant de quitter le programme, vite une dernière indication sur le TC WHQ,
 la "Farpoint Station" (04202 76145)...
}
begin;
  display_ansi(@call,co80+font8x8);
  cursor_off;
  repeat until keypressed;
  while keypressed do readkey;
  cursor_on;
  asm mov ax,03; int 10h; end;
  halt;
end;

procedure prochain_mod;
{
 Lance la sortie du MOD sélectionné suivant
}
begin;
  _gus_mod_quitter;
  inc(curr_modnr);
  if curr_modnr > Les_Files^.nofiles then
    curr_modnr := 1;
  if not _gus_modload(Les_Files^.fn[curr_modnr]) then begin;
    clrscr;
    gotoxy(10,10);
    write('Sorry dude, Cant''t handle this MOD-File');
    delay(1200);
    exit_program;
  end;
  display_ansi(@tcpans,co80+font8x8);
  cursor_off;
  write_phunliners;
  write_nomfichier(Les_Files^.fn[curr_modnr]);
  display_modinfos;
  fillchar(Play_Chanel,14,1);
  _gus_modstart;
end;

procedure display_we_are;
{
 Sortir un ANSI avec Infos par le groupe THE COEXISTENCE
}
begin;
  display_ansi(@we_are,co80+font8x8);
  cursor_off;
  repeat until keypressed;
  while keypressed do readkey;
  display_ansi(@tcpans,co80+font8x8);
  cursor_off;
  write_phunliners;
  write_nomfichier(Les_Files^.fn[curr_modnr]);
  display_modinfos;
end;

procedure display_buy_it;
{
 Affiche une réclame pour le livre PC Underground
}
begin;
  display_ansi(@buy_it,co80+font8x8);
  cursor_off;
  repeat until keypressed;
  while keypressed do readkey;
  display_ansi(@tcpans,co80+font8x8);
  cursor_off;
  write_phunliners;
  write_nomfichier(Les_Files^.fn[curr_modnr]);
  display_modinfos;
end;

procedure handle_keys(key1,key2 : char);
{
 Réagit aux saisies de l'utilisateur
}
var pchan : byte;
begin;
  case key1 of
    #00 : begin;
            case key2 of
              #45 : begin;
                      Programm_quitter := true;
                    end;
              #72 : begin;
                      if modify_voice > 1 then
                        dec(modify_voice);
                    end;
              #80 : begin;
                      if modify_voice < Modinf.Voix then
                        inc(modify_voice);
                    end;
              #75 : begin; { cursor left  }
                      runinf.Ligne := 64;
                      dec(runinf.Pattnr,2);
                      if runinf.Pattnr < -1 then runinf.Pattnr := -1;
                    end;
              #77 : begin; { cursor right  }
                      runinf.Ligne := 64;
                      inc(runinf.Pattnr);
                    end;
            end;
          end;
    #27 : begin;
            Programm_quitter := true;
          end;
    #32,
    'W',
    'w',
    'I',
    'i' : begin;
            display_we_are;
          end;
    'D',
    'd',
    'b',
    'B' : begin;
            display_buy_it;
          end;
    'L',
    'l' : begin;
            chpos[modify_voice] := 1;
            _gus_set_chanelpos;
          end;
    'R',
    'r' : begin;
            chpos[modify_voice] := 15;
            _gus_set_chanelpos;
          end;
    'M',
    'm' : begin;
            chpos[modify_voice] := 7;
            _gus_set_chanelpos;
          end;
    'U',
    'u' : begin;
            if Modinf.Voix = 4 then
            begin
              chpos[1] := 2;
              chpos[2] := 5;
              chpos[3] := 9;
              chpos[4] := 12;
            end;
            if Modinf.Voix = 8 then
            begin
              chpos[1] := 1;
              chpos[2] := 3;
              chpos[3] := 5;
              chpos[4] := 7;
              chpos[5] := 7;
              chpos[6] := 9;
              chpos[7] := 11;
              chpos[8] := 13;
            end;
            _gus_set_chanelpos;
          end;
    ',' : begin; { vers la gauche }
            if chpos[modify_voice] > 1 then
              dec(chpos[modify_voice]);
            _gus_set_chanelpos;
          end;
    '.' : begin; { vers la droite !!! }
            if chpos[modify_voice] < 15 then
              inc(chpos[modify_voice]);
            _gus_set_chanelpos;
          end;
    '1'..
    '8' : begin;
            pchan := ord(key1)-48;
            if Play_Chanel[pchan] = 1 then begin;
              Play_Chanel[pchan] := 0;
              textcolor(10);   gotoxy(77,2+pchan);
              write('M');      textcolor(2);
              write('UTE');
            end else begin;
              Play_Chanel[pchan] := 1;
              textcolor(10);   gotoxy(77,2+pchan);
              write('C');      textcolor(2);
              write('H  ');
            end;
          end;
    'n',
    'N' : begin;
            prochain_mod;
          end;
  end;
end;

procedure screen_update;
const colvals : array[1..35] of byte =
   (08,08,08,08,08,02,02,02,02,10,10,10,10,10,10,10,10,
    10,10,10,10,10,10,10,10,10,10,10,10,10,05,05,05,05,05);
var volstr : string[66];
    li : integer;
    auss : integer;
begin;
  { Remettre à jour les barres indiquant le volume }
  for li := 1 to Modinf.Voix do begin;
    for auss := 1 to round(Runinf.Volumes[li] / 1.78) do begin;
      screen[li+2,37+auss].a := colvals[auss];
    end;
    for auss := round(Runinf.Volumes[li] / 1.78)  to 36 do begin;
      screen[li+2,38+auss].a := 7;
    end;
  end;

  { Définir l'arrière-plan en couleurs pour la flèche }
  for li := 1 to 8 do begin;
    if li = modify_voice then begin;
      screen[2+li,34].a := 05;
      screen[2+li,35].a := 05;
      screen[2+li,36].a := 05;
      screen[2+li,37].a := 05;
    end else begin;
      screen[2+li,34].a := 07;
      screen[2+li,35].a := 07;
      screen[2+li,36].a := 07;
      screen[2+li,37].a := 07;
    end;
  end;

  { Afficher des informations en temps réel sur le MOD }
  gotoxy(18,14);
  color_writeln(Modinf.Titre);

  textcolor(7);
  gotoxy(18,16);
  write(runinf.pattnr:3);

  gotoxy(64,16);
  write(runinf.ligne:3);

  gotoxy(64,15);
  write(64:3);

  gotoxy(18,15);
  write(modinf.Nb_Patt:3);

  gotoxy(60,14);
  write(runinf.speed,' / ',runinf.bpm);
end;

procedure user;
{
 Vérifie les saisies aux claviers et remet à jour l'écran
}
var ch1,ch2 : char;
begin;
  repeat
    ch1 := #255;
    ch2 := #255;
    if keypressed then begin;
      ch1 := readkey;
      if keypressed then ch2 := readkey;
      handle_keys(ch1,ch2);
    end;
   screen_update;
  until Programm_quitter;
end;


procedure display_help;
{
 Affiche l'aide Ansi, même quand aucune carte GUS n'a été trouvée
}
begin;
  display_ansi(@helptxt,co80+font8x8);
  cursor_off;
  repeat until keypressed;
  while keypressed do readkey;
  exit_program;
end;


function check_commandline : boolean;
{
 retourne true, lorsqu'un nom de module a été donné
}
var pst : string;
    ist_mod : boolean;
    li : integer;
    retval : boolean;
begin;
  retval := false;
  for li := 1 to 9 do begin;
    pst := paramstr(li);
    ist_mod := true;

    if (pos('-h',pst) <> 0) or (pos('-H',pst) <> 0) or
       (pos('-?',pst) <> 0) then
    begin;
      ist_mod := false;
      display_help;
    end;

    if (pst <> '') and ist_mod then begin;
      if pos('.',pst) = 0 then pst := pst + '.mod';
      if fichier_exists(pst) then  { mode valide }
      begin
        inc(Les_Files^.nofiles);
        Les_Files^.fn[Les_Files^.nofiles] := pst;
        retval := true;
      end;
    end;
  end;
  check_commandline := retval;
end;

begin;
  cursor_off;
  clrscr;
  if not _gus_init_env then display_help;

  new(Les_Files);
  new(phun);
  Les_Files^.path := mod_chem;
  Les_Files^.Mask := '*.mod';
  Les_Files^.sx   := 24;
  Les_Files^.sy   := 10;
  Les_Files^.nofiles := 0;

  Les_Files^.Titre := 'Choisir un fichier MOD!!!';
  modify_voice := 1;

  for i := 1 to 30 do
    Les_Files^.fn[i] := '---';
  save_screen;
  if not check_commandline then begin;
    select_packfichiers(Les_Files);
    repeat
      restore_screen;

      if Les_Files^.fn[1] = '---' then exit_program;

        _gus_initialiser;

      display_ansi(@tcpans,co80+font8x8);
      cursor_off;
      write_phunliners;

      curr_modnr := 1;
      if not _gus_modload(Les_Files^.fn[1]) then begin;
        clrscr;
        gotoxy(10,10);
        write('Sorry dude, Cant''t handle this MOD-File');
        delay(1200);
        exit_program;
      end;
      write_nomfichier(Les_Files^.fn[1]);
      display_modinfos;
      fillchar(Play_Chanel,14,1);
      _gus_modstart;

      user;
      _gus_mod_quitter;
      dispose(Les_Files);
      new(Les_Files);
      Les_Files^.path := Mod_chem;
      Les_Files^.Mask := '*.mod';
      Les_Files^.sx   := 24;
      Les_Files^.sy   := 10;
      Les_Files^.nofiles := 0;
      for i := 1 to 30 do
        Les_Files^.fn[i] := '---';
      Programm_quitter := false;
      select_packfichiers(Les_Files);
    until Les_Files^.fn[1] = '---';

      dispose(Les_Files);
    dispose(phun);
    exit_program;
  end else begin;
  restore_screen;

  if Les_Files^.fn[1] = '---' then exit_program;

  _gus_initialiser;

  display_ansi(@tcpans,co80+font8x8);
  cursor_off;
  write_phunliners;

  curr_modnr := 1;
  _gus_modload(Les_Files^.fn[1]);
  write_nomfichier(Les_Files^.fn[1]);
  display_modinfos;
  fillchar(Play_Chanel,14,1);
  _gus_modstart;

  user;

  _gus_mod_quitter;
  dispose(Les_Files);
  dispose(phun);
  exit_program;

  end;
end.