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