PC Interdit/pc-interdit.iso/sound/sbmod/mod386.pas

Pascal/Delphi Source File | 1994-10-27 | 19.8 KB | 658 lines

{

 ****************************************************************************
 ***                   MICRO APPLICATION PC INTERDIT                      ***
 ***                  ===============================                     ***
 ***                                                                      ***
 ***                      Programme exemple MOD386                        ***
 ***                                                                      ***
 *** Ce programme illustre la mise en oeuvre de l'unité MOD_SB. Il permet ***
 *** d'exécuter des fichiers MOD et VOC. Le lancement de ce programme     ***
 *** sans paramètre, abouti à un menu de sélection qui permet de choisir  ***
 *** un fichier son parmi ceux du répertoire courant. Le paramètre -r     ***
 *** active le mode Repeat. Appuyer alors sur ESC si vous  désirez        ***
 *** sortir du programme.                                                 ***
 ***                                                                      ***
 *** Auteur          : Boris Bertelsons  (InspirE)                        ***
 *** Nom du fichier  : MOD386.PAS                                         ***
 *** Date            : 04.04.1994                                         ***
 *** Version         : 2.0                                                ***
 *** Compilateur     : Turbo Pascal 7                                     ***
 ****************************************************************************

}



uses crt,dos,mod_sb,variab,design;

{ $define polling}
{
 Normalement, la valeur est renvoyée par Timer-Interrupt. Mais s'il vous
 faut synchroniser avec le Retrace horizontal, vous devez utiliser la
 méthode Polling, qui calcule le son d'une façon non-périodique, quand
 elle a le temps. C'est une méthode, plus lente, qui produit une moins
 bonne qualité. Elle peut conduire à des problèmes avec des MOD à
 8 voix. Son utilisation est conséillée, si on ne peut pas faire
 autrement.
}

type
  t = record                      { Pour une impression directe sur l'écran }
       c : char;
       a : byte;
     end;

const Nummods : byte = 0;
      repeatmode : boolean = false;

var gi : integer;
    my_modname : string;
    stapo,stinc : integer;
    ch,dch : char;
    next_song : integer;
    effects : array[1..4] of effect_type;
    Modd : array[1..10] of string;

procedure Scala_boxes;
var li : integer;
begin;
  textcolor(1);
  textbackground(black);
  clrscr;
  write(' MOD386  Version 2.0, (c) 1994 MICRO APPLICATION',
          ' Programmeur : Boris Bertelsons (InspirE)');
  textcolor(lightblue);
  for li := 1 to 10 do begin;
    gotoxy(2,li+4);
    write(li:2,'. ',noms_inst[li]);
    gotoxy(28,li+4);
    write(li+10:2,'. ',noms_inst[li+10]);
    gotoxy(54,li+4);
    write(li+20:2,'. ',noms_inst[li+20]);
  end;
  if Voix = 4 then begin;
  textcolor(black);
  textbackground(7);
  writexy(02,16,'╔════════════════════════╦════════════════════'+
                  '═══════════════════════════════╗');
  writexy(02,17,'║                        ║                    '+
                  '                               ║');
  writexy(02,18,'║                        ║                    '+
                  '                               ║');
  writexy(02,19,'║                        ║                    '+
                  '                               ║');
  writexy(02,20,'║                        ║                    '+
                  '                               ║');
  writexy(02,21,'╚════════════════════════╩════════════════════'+
                  '═══════════════════════════════╝');
  gotoxy(1,23);
  end else begin;
  textcolor(black);
  textbackground(7);
  writexy(02,16,'╔════════════════════════╦════════════════════'+
                  '═══════════════════════════════╗');
  writexy(02,17,'║                        ║                    '+
                  '                               ║');
  writexy(02,18,'║                        ║                    '+
                  '                               ║');
  writexy(02,19,'║                        ║                    '+
                  '                               ║');
  writexy(02,20,'║                        ║                    '+
                  '                               ║');
  writexy(02,21,'║                        ║                    '+
                  '                               ║');
  writexy(02,22,'║                        ║                    '+
                   '                               ║');
  writexy(02,23,'║                        ║                    '+
                  '                               ║');
  writexy(02,24,'║                        ║                    '+
                  '                               ║');
  writexy(02,25,'╚════════════════════════╩════════════════════'+
                  '═══════════════════════════════╝');
  gotoxy(1,23);
  end;
  textbackground(black);
  textcolor(lightblue);
  writexy(47,2,'Volume: ');
  textcolor(lightcyan);
  write(Mastervolume:2);
  textcolor(lightblue);
  textbackground(black);
  writexy(58,2,'Balance ');
  textcolor(14);
  writexy(66,2,'■■■■■■■■■■■■■');
  textcolor(4);
  writexy(78-Balance DIV 2,2,'■');
  textcolor(lightblue);
  textbackground(black);
  writexy(36,2,'Filtre');
  textcolor(lightcyan);
  write(' OFF');
end;

procedure Scala;
var li,lj : integer;
    screen : array[1..50,1..80] of t absolute $B800:$0000;
    secu : string[3];
begin;
  textcolor(lightblue);
  textbackground(black);
  str(secpass,secu);
  if secpass < 10 then secu := '0'+secu;
  gotoxy(2,3);
  write('Nom de la chanson : ');
  textcolor(lightcyan);
  write(Nom_chanson);
  gotoxy(34,3);
  textcolor(lightblue);
  write('Fréquence : ');
  textcolor(lightcyan);
  write(Sampling_Frequence:5);
  textcolor(lightblue);
  write(' KHz   Durée : ');
  textcolor(lightcyan);
  write(minpass:2,':',secu);
  gotoxy(2,4);
  textcolor(lightblue);
  write('Pattern No.:');
  textcolor(lightcyan);
  write(Chanson[mlj]:3);
  textcolor(lightblue);
  write('    Pattern :');
  textcolor(lightcyan);
  write(mlj:3,'/',ChansonLongueur:3);
  textcolor(lightblue);
  write('    Ligne :');
  textcolor(lightcyan);
  write(mli:3);
  textcolor(lightblue);
  write('    Vitesse : ');
  textcolor(lightcyan);
  write(Playspeed:3,'/128');
  gotoxy(2,2);
  textcolor(lightblue);
  write('Memoire de libre : ');
  textcolor(lightcyan);
  write(Maxavail:6,' KB');
  textcolor(black);
  textbackground(7);
  for li := 1 to Voix do
    if In_St[li] <> 0 then writexy(4,16+li,Noms_Inst[In_St[li]]);

  for lj := 1 to Voix do begin;
    for li := 1 to 16 do begin;
      if (Frappe_Notes[lj] div 10) > li then
        begin;
          screen[16 +lj,29+li].c := '■';
          screen[16 +lj,29+li].a := 114;
        end else begin;
          screen[16 +lj,29+li].c := '■';
          screen[16 +lj,29+li].a := 112;
        end;
    end;
    for li := 16  to 32 do begin;
      if (Frappe_Notes[lj] div 10) > li then
        begin;
          screen[16 +lj,29+li].c := '■';
          screen[16 +lj,29+li].a := 126;
        end else begin;
          screen[16 +lj,29+li].c := '■';
          screen[16 +lj,29+li].a := 112;
        end;
    end;
    for li := 33 to 48 do begin;
      if (Frappe_Notes[lj] div 10) > li then
        begin;
          screen[16 +lj,29+li].c := '■';
          screen[16 +lj,29+li].a := 116;
        end else begin;
          screen[16 +lj,29+li].c := '■';
          screen[16 +lj,29+li].a := 112;
        end;
    end;
  end;
end;

var retraceincs : word;
    systemspeed : longint;
    modspeed    : longint;

procedure test_waitretrace;
begin;
retraceincs := 0;
  asm
    MOV   DX,03dAh
@WD_R:
    inc word ptr retraceincs
    IN    AL,DX
    TEST  AL,8d
    JZ    @WD_R
@WD_D:
    inc word ptr retraceincs
    IN    AL,DX
    TEST  AL,8d
    JNZ   @WD_D
  end;
end;

procedure test_systemspeed;
var li : integer;
begin;
  writeln;
  writeln('Test de rapidité du système, patientez SVP ...');
  writeln;
  test_waitretrace;
  systemspeed := 0;
  for li := 1 to 70 do begin;
    test_waitretrace;
    systemspeed := systemspeed+retraceincs;
  end;
end;

procedure test_modspeed;
var li : integer;
begin;
  writeln;
  writeln('Test de MOD-Speed, patientez SVP ...');
  writeln;
  test_waitretrace;
  modspeed := 0;
  for li := 1 to 210 do begin;
    test_waitretrace;
    modspeed := modspeed+retraceincs;
  end;
  modspeed := modspeed div 3;
end;

procedure write_performance;
begin;
  writeln;
  writeln('Reste :',(modspeed*100/systemspeed):6:2,' % performance du processeur');
  writeln;
  writeln;
  writeln;
  write('Appuyez sur <Entrée> pour continuer ...');
  readln;
end;

procedure Play_the_Mod(s : string);
var h : byte;
    error : integer;
    li : integer;
begin;
 Reset_Sb16;
 mod_SetSpeed(66);
 mod_Samplefreq(Samfreq);
 dsp_rdy_sb16 := true;
 error := charge_fichiermod(s,AUTO,AUTO,Samfreq);
 if error <> 0 then begin;
   clrscr;
   writeln('Erreur pendant le chargement du fichier MOD ! ');
   if error = -1 then writeln('Fichier introuvable !');
   if error = -2 then writeln('Mémoire insuffisante !');
   halt(0);
 end;
 {$ifdef polling}
 start_polling;
 {$else}
 periodic_on;   { Active l'exécution périodique }
 {$endif}
 Scala_boxes;
 ch := #255;
 while not (ch=#27) and not (upcase(ch)='X')
   and not (upcase(ch)='N') do begin;
  {$ifdef polling}
  mod_waitretrace(15);
  {$endif}
  Scala;
  if keypressed then ch := readkey;
  case ch of
    #0  : begin;
            dch := readkey;
            case dch of
              #61 : begin; { F3 }
                       if Mastervolume > 0 then dec(Mastervolume);
                       Set_Volume(Mastervolume);
                       textbackground(black);
                       textcolor(lightblue);
                       writexy(47,2,'Volume: ');
                       textcolor(lightcyan);
                       write(Mastervolume:2);
                       ch := #255;
                     end;
              #62 : begin; { F4 }
                       if Mastervolume < 31 then inc(Mastervolume);
                       Set_Volume(Mastervolume);
                       textbackground(black);
                       textcolor(lightblue);
                       writexy(47,2,'Volume : ');
                       textcolor(lightcyan);
                       write(Mastervolume:2);
                       ch := #255;
                     end;
              #63 : begin; { F5 }
                       if Balance > 0 then dec(Balance);
                       Set_Balance(Balance);
                       textcolor(lightblue);
                       textbackground(black);
                       writexy(58,2,'Balance ');
                       textcolor(14);
                       writexy(66,2,'■■■■■■■■■■■■■');
                       textcolor(4);
                       writexy(78-Balance DIV 2,2,'■');
                       ch := #255;
                     end;
              #64 : begin; { F6 }
                       if Balance < 24 then inc(Balance);
                       Set_Balance(Balance);
                       textcolor(lightblue);
                       textbackground(black);
                       writexy(58,2,'Balance ');
                       textcolor(14);
                       writexy(66,2,'■■■■■■■■■■■■■');
                       textcolor(4);
                       writexy(78-Balance DIV 2,2,'■');
                       ch := #255;
                     end;
              else begin;
                     ch := #255;
                   end;
             end;
          end;
    '6' : begin;
            inc(mli);
            ch := #255;
          end;
    'f' : begin;
            filtre_actif := not filtre_actif;
            if filtre_actif then begin;
                          filtre_on;
              textcolor(lightblue);
              textbackground(black);
              writexy(36,2,'Filtre');
              textcolor(lightcyan);
              write(' ON ');
            end else begin;
                          filtre_mid;
              textcolor(lightblue);
              textbackground(black);
              writexy(36,2,'Filtre');
              textcolor(lightcyan);
              write(' OFF');
            end;
            ch := #255;
          end;
    '4' : begin;
            if mli > 0 then
              dec(mli)
            else begin;
              if mlj > 0 then begin;
                dec(mlj);
                mli := 63
              end else begin;
                mli := 0;
                mlj := 0;
              end;
            end;
            ch := #255;
           end;
    '3' : begin;
            mli := 0;
            inc(mlj);
            ch := #255;
          end;
    '1' : begin;
            if mlj > 0 then begin;
              dec(mlj);
              mli := 0;
            end;
            ch := #255;
           end;
    'N',
    'n' : begin;
            next_song := 1;
          end;
    'x' : begin;
            next_song := 255;
          end;
    #27 : begin;
            next_song := 255;
          end;
    else begin;
           ch := #255;
    end;
   end;
 end;
 outfading := true;
 while outvolume > 1 do begin;
   Scala;
 end;
 {$ifndef polling}
 periodic_off;
 {$endif}
 fin_mod;
 Reset_Sb16;
end;



procedure Write_Helptext;
begin;
  textcolor(lightgray);
  textbackground(black);
  clrscr;
  writeln(' MOD386  Version 2.0, (c) 1994 MICRO APPLICATION',
          ' Programmeur : Boris Bertelsons (InspirE)');
  writeln;
  writeln(' Utilisation : Mod386 <Nom de fichier[.MOD]> [options]');
  writeln;
  writeln(' Options possibles :');
  writeln(' -H        : cette écran');
  writeln(' -In       : utilise l''interruption n');
  writeln(' -Dn       : utilise le canal DMA n');
  writeln(' -Pxxx     : Utilise l''adresse xxx');
  writeln(' -Snn      : Choix du taux d''échantillonnage en KHz possible : ',
            '8,10,13,16,22');
  writeln(' -r        : sélectionne le mode "Repeat"');
  writeln(' -sb       : sans détection d''une SB16');
  writeln(' <nom>     : zusätzliche .MOD-Datei, spielt in zufälliger',
            ' Reihenfolge');
  writeln;
  writeln;
  writeln('             - Appuyez sur une touche pour continuer -');
  writeln;
  repeat until keypressed; readkey;
  clrscr;
  writeln(' MOD386  Version 2.0, (c) 1994 MICRO APPLICATION',
          '  Programmeur : Boris Bertelsons (InspirE)');
  writeln;
  writeln('Fonction des touches durant l''exécution du programme ');
  writeln;
  writeln('  F : Filtre X-Bass On/Off');
  writeln(' F3 : Baisse le volume        F4 : Augmente le volume');
  writeln(' F5 : Balance vers la gauche  F6 : Balance vers la droite');
  writeln('  1 : Retour d''un Pattern      3 : Avance d''un pattern');
  writeln('  4 : Retour d''une ligne       6 : Avance d''une ligne');
  writeln('  n : Fichier suivant      esc,X : Quitter');
  writeln('  p : Performance du système');
  writeln;
  Cursor_On;
  halt(0);
end;

procedure interprete_commandline;
var cs,hs : string;
    li,code : integer;
    sampelfr : word;
    Datnm : boolean;
begin;
  for li := 1 to 10 do begin;
    cs := paramstr(li);
    Datnm := true;
    { Utilisation de l'aide ? }
    if (pos('-h',cs) <> 0) or (pos('/h',cs) <> 0) or
       (pos('-H',cs) <> 0) or (pos('/H',cs) <> 0) or
       (pos('-?',cs) <> 0) or (pos('/?',cs) <> 0) then begin;
       write_Helptext;
      Datnm := false;
    end;
    { mode repeat ? }
    if (pos('-r',cs) <> 0) or (pos('/r',cs) <> 0) or
       (pos('-R',cs) <> 0) or (pos('/R',cs) <> 0) then begin;
       Repeatmode := true;
      Datnm := false;
    end;
    { Force NO Sb16 ? }
    if (pos('-sb',cs) <> 0) or (pos('/sb',cs) <> 0) or
       (pos('-SB',cs) <> 0) or (pos('/SB',cs) <> 0) then begin;
       force_SB := true;
      Datnm := false;
    end;
    if (pos('-i',cs) <> 0) or (pos('/i',cs) <> 0) or
       (pos('-I',cs) <> 0) or (pos('/I',cs) <> 0) then begin;
      force_irq := true;
      hs := copy(cs,3,length(cs)-2);
      val(hs,dsp_irq,code);
      Datnm := false;
    end;
    { Force DMA ? }
    if (pos('-d',cs) <> 0) or (pos('/d',cs) <> 0) or
       (pos('-D',cs) <> 0) or (pos('/D',cs) <> 0) then begin;
      force_dma := true;
      hs := copy(cs,3,length(cs)-2);
      val(hs,dma_ch,code);
      Datnm := false;
    end;
    { Force Base ? }
    if (pos('-p',cs) <> 0) or (pos('/p',cs) <> 0) or
       (pos('-P',cs) <> 0) or (pos('/P',cs) <> 0) then begin;
       hs := copy(cs,3,length(cs)-2);
       if hs = '200' then dsp_adr := $200;
       if hs = '210' then dsp_adr := $210;
       if hs = '220' then dsp_adr := $220;
       if hs = '230' then dsp_adr := $230;
       if hs = '240' then dsp_adr := $240;
       if hs = '250' then dsp_adr := $250;
       if hs = '260' then dsp_adr := $260;
       if hs = '270' then dsp_adr := $270;
       if hs = '280' then dsp_adr := $280;
       Startport := dsp_adr;
       Endport   := dsp_adr;
      Datnm := false;
    end;
    { Indiquer Sampelrate ? }
    if (pos('-s',cs) <> 0) or (pos('/s',cs) <> 0) or
       (pos('-S',cs) <> 0) or (pos('/S',cs) <> 0) then begin;
      hs := copy(cs,3,length(cs)-2);
      val(hs,Sampelfr,code);
      if Sampelfr >= 8000 then Sampelfr := Sampelfr DIV 1000;
      if Sampelfr >= 8 then Samfreq := 8;
      if Sampelfr >= 10 then Samfreq := 10;
      if Sampelfr >= 13 then Samfreq := 13;
      if Sampelfr >= 16 then Samfreq := 16;
      if Sampelfr >= 22 then Samfreq := 22;
      Datnm := false;
    end;
    if Datnm then begin;
      if cs <> '' then begin;
        Inc(Nummods);
        Modd[Nummods] := cs;
      end;
    end;
  end;
end;

procedure write_vocmessage;
begin;
  clrscr;
  writexy(10,08,'Attention !  Le Voc entrera dans une boucle sans fin !!!');
  writexy(10,10,'Commencer  par  Q  ');
  writexy(10,11,'Pause     avec  P  ');
  writexy(10,12,'Continuer avec  C  ');
  writexy(10,13,'Reprendre avec  N  ');
  writexy(10,21,'                         E N J O Y');
end;

procedure play_sound(datname : string);
var li : integer;
    ch : char;
begin;
  for li := 1 to length(datname) do
     datname[li] := upcase(Datname[li]);
  if pos('.MOD',datname) <> 0 then begin;
    Play_The_Mod(datname);
    exit;
  end;
  if pos('.VOC',datname) <> 0 then begin;
  repeat
    Reset_Sb16;
    write_vocmessage;
    Init_Voc(datname);
    ch := #0;
    repeat
      if keypressed then ch := readkey;
      if ch = 'p' then begin;
        voc_pause;
        repeat
          ch := readkey;
        until ch = 'c';
        voc_continue;
      end;
    until VOC_READY or (ch = 'n') or (upcase(ch) = 'Q');
    VOC_DONE;
  until upcase(ch) = 'Q';
  end;
end;


begin;
 scala_boxes;
 Samfreq := 22;
 clrscr;
 Test_systemspeed;
 cursor_off;
 interprete_commandline;
 if (Nummods = 0) and not repeatmode then begin;
   textcolor(15);
   textbackground(1);
   clrscr;
   Nummods := 1;
   modd[1] := select_fichier('*.?o?','*.?o?','','Sélection de fichiers son');
   if modd[1] = 'xxxx' then begin;
     clrscr;
         writeln('Vous avez donc déjà un fichier son !');
     Cursor_on;
     halt(0);
   end;
 end;
 for i := 1 to Nummods do begin;
   if pos('.',modd[i]) = 0 then modd[i] := modd[i]+'.mod';
 end;
 Init_The_Mod;
 stereo := false;
 next_song := random(Nummods)+1;
 textcolor(lightgray);
 textbackground(black);
 write_sbconfig;
 writeln;
 writeln;
 write('            ENTREE pour continuer ...');
 readln;
 repeat
   if repeatmode then begin;
     textcolor(15);
     textbackground(1);
     clrscr;
     modd[1] := select_fichier('*.?o?','*.?o?','','');
     if modd[1] = 'xxxx' then next_song := 255
     else Play_Sound(modd[1]);
   end else
     Play_Sound(modd[next_song]);
   if next_song <> 255 then next_song := random(Nummods)+1;
 until next_song = 255;
 cursor_on;
 textmode(3);
end.