home *** CD-ROM | disk | FTP | other *** search
/ PC Interdit / pc-interdit.iso / sound / voc / vocdemo.pas < prev    next >
Pascal/Delphi Source File  |  1994-10-30  |  3KB  |  124 lines
  1. uses crt,dos,vocplay,design;
  2.  
  3. var ch : char;
  4.     next_voc : integer;
  5.     Vocname : string;
  6.  
  7. procedure Write_Helptext;
  8. begin;
  9.   textcolor(lightgray);
  10.   textbackground(black);
  11.   clrscr;
  12.   writeln(' MICRO APPLICATION  VOC-Player      Version 1.0, (c) 1994',
  13.             '      Auteur : Boris Bertelsons');
  14.   writeln;
  15.   writeln(' Usage: Vocdemo <Filename[.VOC]> [options]');
  16.   writeln;
  17.   writeln(' Les options :');
  18.     writeln(' -H        : cet écran');
  19.   writeln(' -In       : utilise l''interruption n');
  20.     writeln(' -Dn       : utilise le canal DMA n');
  21.   writeln(' -Pxxx     : utilise l''adresse de base xxx');
  22.   writeln;
  23.   Cursor_On;
  24.   halt(0);
  25. end;
  26.  
  27. procedure interprete_commandline;
  28. var cs,hs : string;
  29.     li,code : integer;
  30.     FicNom : boolean;
  31. begin;
  32.   for li := 1 to 10 do begin;
  33.     cs := paramstr(li);
  34.     FicNom := true;
  35.     { demande d'Aide ? }
  36.     if (pos('-h',cs) <> 0) or (pos('/h',cs) <> 0) or
  37.        (pos('-H',cs) <> 0) or (pos('/H',cs) <> 0) or
  38.        (pos('-?',cs) <> 0) or (pos('/?',cs) <> 0) then begin;
  39.        write_Helptext;
  40.       FicNom := false;
  41.     end;
  42.     { force irq }
  43.     if (pos('-i',cs) <> 0) or (pos('/i',cs) <> 0) or
  44.        (pos('-I',cs) <> 0) or (pos('/I',cs) <> 0) then begin;
  45.       force_irq := true;
  46.       hs := copy(cs,3,length(cs)-2);
  47.       val(hs,dsp_irq,code);
  48.       FicNom := false;
  49.     end;
  50.     { Force DMA ? }
  51.     if (pos('-d',cs) <> 0) or (pos('/d',cs) <> 0) or
  52.        (pos('-D',cs) <> 0) or (pos('/D',cs) <> 0) then begin;
  53.       force_dma := true;
  54.       hs := copy(cs,3,length(cs)-2);
  55.       val(hs,dma_ch,code);
  56.       FicNom := false;
  57.     end;
  58.     { Force Base ? }
  59.     if (pos('-p',cs) <> 0) or (pos('/p',cs) <> 0) or
  60.        (pos('-P',cs) <> 0) or (pos('/P',cs) <> 0) then begin;
  61.        hs := copy(cs,3,length(cs)-2);
  62.        if hs = '200' then dsp_adr := $200;
  63.        if hs = '210' then dsp_adr := $210;
  64.        if hs = '220' then dsp_adr := $220;
  65.        if hs = '230' then dsp_adr := $230;
  66.        if hs = '240' then dsp_adr := $240;
  67.        if hs = '250' then dsp_adr := $250;
  68.        if hs = '260' then dsp_adr := $260;
  69.        if hs = '270' then dsp_adr := $270;
  70.        if hs = '280' then dsp_adr := $280;
  71.        Startport := dsp_adr;
  72.        Endport   := dsp_adr;
  73.       FicNom := false;
  74.     end;
  75.     if FicNom then begin;
  76.       Vocname := cs;
  77.     end;
  78.   end;
  79. end;
  80.  
  81. procedure Jouer_FicVoc(filename : string);
  82. var li : integer;
  83.     ch : char;
  84.     loopcounter : word;
  85. begin;
  86.   loopcounter := 0;
  87.   repeat
  88.     inc(loopcounter);
  89.     clrscr;
  90.     writexy(10,08,'Attention !  Le VOC se trouve dans une boucle !!!');
  91.     writexy(10,10,'Terminer en appuyant sur la touche  >>  Q  <<');
  92.     writexy(10,14,'Desactiver Smartdrv parce qu''il est leeeent !');
  93.     gotoxy(10,17);
  94.     write('Passage n°',loopcounter);
  95.     Init_Voc(filename);
  96.     ch := #0;
  97.     repeat
  98.       if keypressed then ch := readkey;
  99.     until VOC_READY or (upcase(ch) = 'Q');
  100.     VOC_DONE;
  101.   until upcase(ch) = 'Q';
  102. end;
  103.  
  104.  
  105. begin;
  106.  cursor_off;
  107.  interprete_commandline;
  108.  Init_SB;
  109.  textcolor(lightgray);
  110.  textbackground(black);
  111.  write_sbconfig;
  112.  delay(1333);
  113.  repeat
  114.    textcolor(15);
  115.    textbackground(1);
  116.    clrscr;
  117.    Vocname := select_fichier('*.voc','*.voc','','');
  118.    if Vocname = 'xxxx' then next_voc := 255
  119.    else Jouer_FicVoc(Vocname);
  120.  until next_voc = 255;
  121.  cursor_on;
  122.  textmode(3);
  123. end.
  124.