home *** CD-ROM | disk | FTP | other *** search
/ Intermedia 1998 January / inter1_98.iso / www / rozi / WAV.ZIP / WAVPLAY.PAS < prev   
Pascal/Delphi Source File  |  1997-04-17  |  7KB  |  320 lines
  1. Program wavplay;
  2.  
  3. {$M 4096,0,65500}
  4.  
  5. Uses DOS,Crt;
  6.  
  7. Const dma    = 4096;
  8. Type  id_t   = Array[1..4] of Char;
  9.       riff_t = Record
  10.                 R_Ident : id_t;
  11.                 length  : Longint;
  12.                 C_Ident : id_t;
  13.                 S_Ident : id_t;
  14.                 s_length: Longint;
  15.                 Format  ,
  16.                 Modus   : Word;
  17.                 freq    ,
  18.                 byte_p_s: LongInt;
  19.                 byte_sam,
  20.                 bit_sam : Word;
  21.                 D_Ident : id_t;
  22.                 d_length: LongInt;
  23.               End;
  24.       blaster_T = Record
  25.                     port : Word;
  26.                     dmac ,
  27.                     hdmac,
  28.                     irq  : Byte;
  29.                   End;
  30.       buffer_T = Array[1..dma] of Byte;
  31.  
  32. Var id       : riff_T;
  33.     fn       : String;
  34.     wav      : File;
  35.     sbb      : Word;
  36.     Ende     : Boolean;
  37.     blaster  : Blaster_T;
  38.     alt_irq  : Pointer;
  39.     dma_buf_1,
  40.     dma_buf_2,
  41.     zwi      : ^Buffer_T;
  42.     Channel  : Byte;
  43.  
  44. Const RIFF : id_t = ('R','I','F','F');
  45.       WAVE : id_t = ('W','A','V','E');
  46.       FMT_ : id_t = ('f','m','t',' ');
  47.       DATA : id_t = ('d','a','t','a');
  48.  
  49.       DMA_Dat : Array [0..7,1..6] of Byte=
  50.                   (($A,$C,$B,$0,$87,$1),
  51.                    ($A,$C,$B,$2,$83,$3),
  52.                    ($A,$C,$B,$4,$81,$5),
  53.                    ($A,$C,$B,$6,$82,$7),
  54.                    ($D4,$D8,$D6,$C0,$8F,$C2),
  55.                    ($D4,$D8,$D6,$C4,$8B,$C6),
  56.                    ($D4,$D8,$D6,$C8,$89,$CA),
  57.                    ($D4,$D8,$D6,$CC,$8A,$CE));
  58.  
  59. Procedure Blaster_Command(c :Byte); Assembler;
  60. Asm
  61.     Mov dx,Word Ptr sbb
  62.     Add dx,$c
  63.  @t:In al,dx
  64.     And al,128
  65.     Jnz @t
  66.     Mov al,c
  67.     Out dx,al
  68. End;
  69.  
  70. Procedure Init_SB(base : Word);
  71. Var w,w2:Word;
  72. Begin
  73.   sbb:=base;
  74.   Port[base+6]:=1; Delay(4); Port[base+6]:=0; w:=0; w2:=0;
  75.   Repeat
  76.     Repeat Inc(w); Until ((Port[base+$e] and 128)=128) or (w>29);
  77.     Inc(w2);
  78.   Until (Port[base+$a]=$AA) or (W2>30);
  79.   If w2>30 then
  80.     Begin
  81.       WriteLn('Failed to ReSet Blaster');
  82.       Halt(128);
  83.     End;
  84.   Blaster_Command($d1);
  85. End;
  86.  
  87. Procedure Set_Stereo; Assembler;
  88. Asm
  89.   Mov dx,Word Ptr sbb
  90.   Add dx,$4
  91.   Mov al,$e
  92.   Out dx,al
  93.   Inc dx
  94.   In al,dx
  95.   And al,253
  96.   Or al,2
  97.   Out dx,al
  98. End;
  99.  
  100. Procedure Clear_Stereo; Assembler;
  101. Asm
  102.   Mov dx,Word Ptr sbb
  103.   Add dx,$4
  104.   Mov al,$e
  105.   Out dx,al
  106.   Inc dx
  107.   In al,dx
  108.   And al,253
  109.   Out dx,al
  110. End;
  111.  
  112. Function No_Wave(Var id:riff_T):Boolean;
  113. Begin
  114.   With id do
  115.     No_Wave:=(R_Ident<>RIFF) or
  116.              (C_Ident<>WAVE) or
  117.              (S_Ident<>FMT_) or
  118.              (D_Ident<>DATA);
  119. End;
  120.  
  121. Procedure Init;
  122. Var b : Byte;
  123. Begin
  124.   WriteLn;
  125.   WriteLn('ABo WAV-Player (16bit Test)      (p) 27.11.94 ABo');
  126.   Blaster.Port:=0;
  127.   Blaster.dmac:=0;
  128.   Blaster.hdmac:=0;
  129.   Blaster.irq:=0;
  130.   fn:=GetEnv('BLASTER');
  131.   If fn='' then
  132.     Begin
  133.       WriteLn('BLASTER must be set...');
  134.       Halt(100);
  135.     End;
  136.   b:=1;
  137.   Repeat
  138.     Case fn[b] of
  139.       'A' : Repeat
  140.               Inc(b);
  141.               Blaster.Port:=Blaster.Port*16+Ord(fn[b])-48;
  142.             Until Fn[b+1]=' ';
  143.       'D' : Begin
  144.               Blaster.DMAc:=Ord(fn[b+1])-48;
  145.               Inc(b,2);
  146.             End;
  147.       'I' : Repeat
  148.               Inc(b);
  149.               Blaster.IRQ:=Blaster.IRQ*16+Ord(fn[b])-48;
  150.             Until Fn[b+1]=' ';
  151.       'H' : Begin
  152.               Blaster.hDMAc:=Ord(fn[b+1])-48;
  153.               Inc(b,2);
  154.             End;
  155.         End;
  156.     Inc(b);
  157.   Until b>Length(fn);
  158.   With Blaster do
  159.     WriteLn('Blaster : P',Port,'  I',irq,'  D',dmac,'  H',hdmac);
  160.   Init_SB(Blaster.Port);
  161.   If ParamCount>0 then
  162.     fn:=ParamStr(1)
  163.   Else
  164.     Begin
  165.       Write('WAV-File: ');
  166.       ReadLn(fn);
  167.     End;
  168.   Assign(wav,fN);
  169.   {$I-} ReSet(wav,1); {$I+}
  170.   If IOResult<>0 then
  171.     Begin
  172.       WriteLn('File "',fn,'" not found!');
  173.       Halt(2);
  174.     End;
  175.   BlockRead(wav,id,Sizeof(id));
  176.   If no_Wave(id) then
  177.     Begin
  178.       WriteLn('"',fn,'" seems to be no WAVE-File...');
  179.       Halt(128);
  180.     End;
  181.   Write('Wave    : ',id.bit_sam,'bit ');
  182.   If id.Modus=2 then
  183.     Begin
  184.       Set_Stereo;
  185.       Write('stereo ');
  186.     End
  187.   Else
  188.     Begin
  189.       Clear_Stereo;
  190.       Write('mono    ');
  191.     End;
  192.   If (id.bit_sam>8) and (Blaster.hdmac>3) then
  193.     Channel:=Blaster.hdmac
  194.   Else Channel:=Blaster.dmac;
  195.   WriteLn(id.freq,' Hz  ',id.byte_p_s,' Bytes/Sec');
  196.   WriteLn('Length  : ',id.d_length,' Bytes    ',id.d_length div id.byte_p_s, ' Sec');
  197.   WriteLn('Playing : ',fn);
  198. End;
  199.  
  200. {$F+}
  201. Procedure Stelle_DMA(Freq: Word;Var size : Word);
  202. Var PageNr,PageAdress,DMALength: Word;
  203. Begin
  204.   Inline($FA);
  205.   Asm
  206.     Mov ax,Word Ptr DMA_Buf_1[2]
  207.     Shr ax,12
  208.     Mov Word Ptr PageNr,ax
  209.     Mov ax,Word Ptr DMA_Buf_1[2]
  210.     Shl ax,4
  211.     Mov Word Ptr PageAdress,ax
  212.     Mov ax,Word Ptr DMA_Buf_1
  213.     Add Word Ptr PageAdress,ax
  214.     Adc Word Ptr PageNr,0
  215.   End;
  216.   DMALength:=Size;
  217.   Freq:=256-Trunc(1000000/Freq);
  218.   If Channel>3 then
  219.     Begin
  220.       DMALength:=DMALength div 2;
  221.       PageAdress:=PageAdress div 2;
  222.       If Odd(PageNr) then
  223.         Begin
  224.           Dec(PageNr);
  225.           PageAdress:=PageAdress+$8000
  226.         End;
  227.     End;
  228.   If id.Modus=2 then
  229.     Begin
  230.       If id.bit_sam=16
  231.         then Blaster_Command($A4)
  232.         Else Blaster_Command($A8);
  233.     End
  234.   Else
  235.     If id.bit_sam=16
  236.       then Blaster_Command($A4);
  237.  
  238.   Dec(DMALength);
  239.  
  240.   Port[DMA_dat[Channel,1]]:=$4 or (Channel and $3);
  241.   Port[DMA_dat[Channel,2]]:=$0;
  242.   Port[DMA_dat[Channel,3]]:=$49;
  243.   Port[DMA_dat[Channel,4]]:=lo(PageAdress);
  244.   Port[DMA_dat[Channel,4]]:=hi(PageAdress);
  245.   Port[DMA_dat[Channel,5]]:=lo(PageNr);
  246.   Port[DMA_dat[Channel,6]]:=lo(DMALength);
  247.   Port[DMA_dat[Channel,6]]:=hi(DMALength);
  248.   Port[DMA_dat[Channel,1]]:=(Channel and $3);
  249.  
  250.   Blaster_Command($40);
  251.   Blaster_Command(Lo(Freq));
  252.   Blaster_Command($48);
  253.   Blaster_Command(lo(DMALength));
  254.   Blaster_Command(hi(DMALength));
  255.   Blaster_Command($91);
  256.   Inline($FB);
  257. End;
  258.  
  259. Procedure Ausgabe_IRQ; Interrupt;
  260. Var test : Byte;
  261. Begin
  262.   Inline($FA);
  263.   Port[$20]:=$20;
  264.   test:=Port[sbb+$e];
  265.   Ende:=True;
  266.   Inline($fB);
  267. End;
  268. {$F-}
  269.  
  270. Procedure Play;
  271. Var  p,s,s2 : Word;
  272.     w      : LongInt;
  273. Begin
  274.   GetMem(zwi,16);
  275.   GetMem(dma_buf_1,dma);
  276.   p:=16;
  277.   While (Seg(dma_buf_1^[1]) mod 4096)>(4096-(dma*2 div 16)) do
  278.     Begin
  279.       FreeMem(dma_buf_1,dma);
  280.       FreeMem(zwi,p);
  281.       p:=p+16;
  282.       If p>65525 then halt(111);
  283.       GetMem(zwi,p);
  284.       GetMem(dma_buf_1,dma);
  285.     End;
  286.   GetMem(dma_buf_2,dma);
  287.   FreeMem(zwi,p);
  288.   port[$21]:=Port[$21] and (255 xor (1 shl Blaster.IRQ));
  289.   GetIntVec(Blaster.IRQ+8,Alt_irq);
  290.   SetIntVec(Blaster.IRQ+8,@Ausgabe_IRQ);
  291.   w:=id.freq*id.modus;
  292.   BlockRead(wav,dma_buf_1^[1],dma,s);
  293.   Repeat
  294.     Ende:=False;
  295.     Stelle_DMA(w,s);
  296.     BlockRead(wav,dma_buf_2^[1],dma,s2);
  297.     Repeat Until Ende;
  298.     s:=s2;
  299.     zwi:=dma_buf_1;
  300.     dma_buf_1:=dma_buf_2;
  301.     dma_buf_2:=zwi;
  302.   Until EoF(wav) or Keypressed;
  303.   While KeyPressed do w:=Ord(ReadKey);
  304.   If EoF(wav) then
  305.     Begin
  306.       Ende:=False;
  307.       Stelle_DMA(w,s);
  308.       Repeat Until Ende;
  309.     End;
  310.   SetintVec(Blaster.IRQ+8,Alt_IRQ);
  311.   FreeMem(dma_buf_1,dma);
  312.   FreeMem(dma_buf_2,dma);
  313.   Port[$21]:=Port[$21] or (1 shl Blaster.IRQ);
  314.   Blaster_Command($d3);
  315. End;
  316.  
  317. Begin
  318.   Init;
  319.   Play;
  320. End.