home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / spx / demo / demo7.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-05  |  3.5 KB  |  165 lines
  1. Program Demo7;
  2.  
  3. { SPX library - Sound demo 7  Copyright 1993 Scott D. Ramsay  }
  4.  
  5. Uses Crt,Dos,SPX_SND,SPX_KEY,SPX_FNC,LimEms;
  6.  
  7. type
  8.   sndmode = (CHKsnd,PCsnd,LPT1snd,SBsnd);
  9.  
  10. const
  11.   path    = '';
  12.   uems    : boolean = false;
  13.   sound   : array[0..2] of Psound = (nil,nil,nil);
  14.   sndport : word = $42;         { default device = PC speaker }
  15.   _sb     : boolean = false;
  16.   defsnd  : sndmode = CHKsnd;
  17.  
  18. procedure setup;
  19. var
  20.   d : integer;
  21. begin
  22.   setrate(8192);  { Sample rate for files is 8192 }
  23.   for d := 0 to 2 do
  24.     if uems
  25.       then sound[d]  := new(PEMSsound,init(path+'sound'+st(d+1)+'.sfx',sndport,_sb))
  26.       else sound[d]  := new(Psound,init(path+'sound'+st(d+1)+'.sfx',sndport,_sb));
  27. end;
  28.  
  29.  
  30. procedure showit;
  31. begin
  32.   writeln('Command line:');
  33.   writeln(' DEMO7  [PC][SB][LPT1]');
  34.   writeln('     PC    - use pc speaker');
  35.   writeln('     SB    - use sound blaster or compatible');
  36.   writeln('     LPT1  - use DAC device on LPT1');
  37.   writeln('Keys:');
  38.   writeln(' ESC          - quit demo');
  39.   writeln(' 1..3         - play sounds');
  40.   writeln;
  41.   write('Press any key.');
  42.   clearbuffer;
  43.   repeat until anykey;
  44. end;
  45.  
  46.  
  47. function getvst(s:string;b:byte):string;
  48. var
  49.   v : string;
  50. begin
  51.   inc(b); v := '';
  52.   while (b<=length(s)) and (s[b]<>#32) do
  53.     begin
  54.       v := v+s[b];
  55.       inc(b);
  56.     end;
  57.   getvst := v;
  58. end;
  59.  
  60.  
  61. { convert a hex number to a decimal }
  62. function hex2dec(what:string) : integer;
  63. var
  64.   i,rslt : integer;
  65. begin
  66.   rslt := 0;
  67.   for i := 1 to length(what) do
  68.     begin
  69.       rslt := rslt shl 4;
  70.       if what[i]<'A'
  71.         then rslt := rslt+(ord(what[i])-$30)
  72.         else rslt := rslt+(ord(what[i])-55);
  73.     end;
  74.   hex2dec := rslt;
  75. end;
  76.  
  77.  
  78. function blastercheck:boolean;
  79. var
  80.   s : string;
  81. begin
  82.   s := ups(getenv('BLASTER'));
  83.   if pos('A',s)<>0
  84.     then
  85.       begin
  86.         sndport := hex2dec(getvst(s,pos('A',s)));
  87.         _sb := SBReset(sndport);
  88.         if not _sb
  89.           then
  90.             begin
  91.               sndport := SBfindBase; _sb := (sndport<>0);
  92.               if not _sb
  93.                 then sndport := $42;
  94.             end;
  95.       end;
  96.   blastercheck := _sb;
  97. end;
  98.  
  99.  
  100. procedure checkparms;
  101. var
  102.   tp,pa : word;
  103.   s     : string;
  104.   d     : integer;
  105. begin
  106.   writeln('SPX library - Sound demo 7');
  107.   writeln('Copyright 1993 Scott D. Ramsay');
  108.   writeln;
  109.   s := '';
  110.   for d := 1 to paramcount do
  111.     s := s+ups(paramstr(1));
  112.   if pos('LPT1',s)<>0
  113.     then defsnd := LPT1snd
  114.     else
  115.   if pos('SB',s)<>0
  116.     then defsnd := SBsnd
  117.     else
  118.   if pos('PC',s)<>0
  119.     then defsnd := PCsnd;
  120.   if not EMSinstalled or not emsSTATUS
  121.     then uems := false
  122.     else
  123.       begin
  124.         EMSpages(tp,pa);
  125.         if pa>=5
  126.           then
  127.             begin
  128.               uems := true;
  129.               writeln('Expanded memory detected and used')
  130.             end
  131.           else writeln('Expanded memory detected, but not enough available');
  132.       end;
  133.   case defsnd of
  134.     CHKsnd,
  135.     SBsnd   : blastercheck;
  136.     LPT1snd : sndport := $378;
  137.   end;
  138.   if _sb
  139.     then writeln('Sound card detected')
  140.     else
  141.       if defsnd<>LPT1snd
  142.         then writeln('Using PC speaker')
  143.         else writeln('Using DAC on LPT1');
  144.   writeln;
  145. end;
  146.  
  147.  
  148. procedure animate;
  149. begin
  150.   clrscr;
  151.   writeln('ESC - quit    1..3 - sounds ');
  152.   repeat
  153.     if vl(ch) in [1..3]
  154.       then sound[vl(ch)-1]^.play(true);
  155.     delay(100);  { kill some cycles }
  156.   until esc;
  157. end;
  158.  
  159.  
  160. begin
  161.   checkparms;
  162.   showit;
  163.   setup;
  164.   animate;
  165. end.