[Back to SOUND SWAG index] [Back to Main SWAG index] [Original]
{
NB> DOes anyone have Source code to play WAV files in Turbo Pascal 7.0?
Try this. It won't work on a SB16, but on nearly all cheap 16-bit-cards.
I took it from the german PASCAL echo (PASCAL.GER).
{from: BOMMER@MULTICOM.mc.org (Andree Borrmann)}
Program ABo_WAV;
{$M 4096,0,65500}
Uses DOS,Crt;
Const dma = 4096;
Type id_t = Array[1..4] of Char;
riff_t = Record
R_Ident : id_t;
length : Longint;
C_Ident : id_t;
S_Ident : id_t;
s_length: Longint;
Format ,
Modus : Word;
freq ,
byte_p_s: LongInt;
byte_sam,
bit_sam : Word;
D_Ident : id_t;
d_length: LongInt;
End;
blaster_T = Record
port : Word;
dmac ,
hdmac,
irq : Byte;
End;
buffer_T = Array[1..dma] of Byte;
Var id : riff_T;
fn : String;
wav : File;
sbb : Word;
Ende : Boolean;
blaster : Blaster_T;
alt_irq : Pointer;
dma_buf_1,
dma_buf_2,
zwi : ^Buffer_T;
Channel : Byte;
Const RIFF : id_t = ('R','I','F','F');
WAVE : id_t = ('W','A','V','E');
FMT_ : id_t = ('f','m','t',' ');
DATA : id_t = ('d','a','t','a');
DMA_Dat : Array [0..7,1..6] of Byte=
(($A,$C,$B,$0,$87,$1),
($A,$C,$B,$2,$83,$3),
($A,$C,$B,$4,$81,$5),
($A,$C,$B,$6,$82,$7),
($D4,$D8,$D6,$C0,$8F,$C2),
($D4,$D8,$D6,$C4,$8B,$C6),
($D4,$D8,$D6,$C8,$89,$CA),
($D4,$D8,$D6,$CC,$8A,$CE));
Procedure Blaster_Command(c :Byte); Assembler;
Asm
Mov dx,Word Ptr sbb
Add dx,$c
@t:In al,dx
And al,128
Jnz @t
Mov al,c
Out dx,al
End;
Procedure Init_SB(base : Word);
Var w,w2:Word;
Begin
sbb:=base;
Port[base+6]:=1; Delay(4); Port[base+6]:=0; w:=0; w2:=0;
Repeat
Repeat Inc(w); Until ((Port[base+$e] and 128)=128) or (w>29);
Inc(w2);
Until (Port[base+$a]=$AA) or (W2>30);
If w2>30 then
Begin
WriteLn('Failed to ReSet Blaster');
Halt(128);
End;
Blaster_Command($d1);
End;
Procedure Set_Stereo; Assembler;
Asm
Mov dx,Word Ptr sbb
Add dx,$4
Mov al,$e
Out dx,al
Inc dx
In al,dx
And al,253
Or al,2
Out dx,al
End;
Procedure Clear_Stereo; Assembler;
Asm
Mov dx,Word Ptr sbb
Add dx,$4
Mov al,$e
Out dx,al
Inc dx
In al,dx
And al,253
Out dx,al
End;
Function No_Wave(Var id:riff_T):Boolean;
Begin
With id do
No_Wave:=(R_Ident<>RIFF) or
(C_Ident<>WAVE) or
(S_Ident<>FMT_) or
(D_Ident<>DATA);
End;
Procedure Init;
Var b : Byte;
Begin
WriteLn;
WriteLn('ABo WAV-Player (16bit Test) (p) 27.11.94 ABo');
Blaster.Port:=0;
Blaster.dmac:=0;
Blaster.hdmac:=0;
Blaster.irq:=0;
fn:=GetEnv('BLASTER');
If fn='' then
Begin
WriteLn('BLASTER must be set...');
Halt(100);
End;
b:=1;
Repeat
Case fn[b] of
'A' : Repeat
Inc(b);
Blaster.Port:=Blaster.Port*16+Ord(fn[b])-48;
Until Fn[b+1]=' ';
'D' : Begin
Blaster.DMAc:=Ord(fn[b+1])-48;
Inc(b,2);
End;
'I' : Repeat
Inc(b);
Blaster.IRQ:=Blaster.IRQ*16+Ord(fn[b])-48;
Until Fn[b+1]=' ';
'H' : Begin
Blaster.hDMAc:=Ord(fn[b+1])-48;
Inc(b,2);
End;
End;
Inc(b);
Until b>Length(fn);
With Blaster do
WriteLn('Blaster : P',Port,' I',irq,' D',dmac,' H',hdmac);
Init_SB(Blaster.Port);
If ParamCount>0 then
fn:=ParamStr(1)
Else
Begin
Write('WAV-File: ');
ReadLn(fn);
End;
Assign(wav,fN);
{$I-} ReSet(wav,1); {$I+}
If IOResult<>0 then
Begin
WriteLn('File "',fn,'" not found!');
Halt(2);
End;
BlockRead(wav,id,Sizeof(id));
If no_Wave(id) then
Begin
WriteLn('"',fn,'" seems to be no WAVE-File...');
Halt(128);
End;
Write('Wave : ',id.bit_sam,'bit ');
If id.Modus=2 then
Begin
Set_Stereo;
Write('stereo ');
End
Else
Begin
Clear_Stereo;
Write('mono ');
End;
If (id.bit_sam>8) and (Blaster.hdmac>3) then
Channel:=Blaster.hdmac
Else Channel:=Blaster.dmac;
WriteLn(id.freq,' Hz ',id.byte_p_s,' Bytes/Sec');
WriteLn('Length : ',id.d_length,' Bytes ',id.d_length div id.byte_p_s, ' Sec');
WriteLn('Playing : ',fn);
End;
{$F+}
Procedure Stelle_DMA(Freq: Word;Var size : Word);
Var PageNr,PageAdress,DMALength: Word;
Begin
Inline($FA);
Asm
Mov ax,Word Ptr DMA_Buf_1[2]
Shr ax,12
Mov Word Ptr PageNr,ax
Mov ax,Word Ptr DMA_Buf_1[2]
Shl ax,4
Mov Word Ptr PageAdress,ax
Mov ax,Word Ptr DMA_Buf_1
Add Word Ptr PageAdress,ax
Adc Word Ptr PageNr,0
End;
DMALength:=Size;
Freq:=256-Trunc(1000000/Freq);
If Channel>3 then
Begin
DMALength:=DMALength div 2;
PageAdress:=PageAdress div 2;
If Odd(PageNr) then
Begin
Dec(PageNr);
PageAdress:=PageAdress+$8000
End;
End;
If id.Modus=2 then
Begin
If id.bit_sam=16
then Blaster_Command($A4)
Else Blaster_Command($A8);
End
Else
If id.bit_sam=16
then Blaster_Command($A4);
Dec(DMALength);
Port[DMA_dat[Channel,1]]:=$4 or (Channel and $3);
Port[DMA_dat[Channel,2]]:=$0;
Port[DMA_dat[Channel,3]]:=$49;
Port[DMA_dat[Channel,4]]:=lo(PageAdress);
Port[DMA_dat[Channel,4]]:=hi(PageAdress);
Port[DMA_dat[Channel,5]]:=lo(PageNr);
Port[DMA_dat[Channel,6]]:=lo(DMALength);
Port[DMA_dat[Channel,6]]:=hi(DMALength);
Port[DMA_dat[Channel,1]]:=(Channel and $3);
Blaster_Command($40);
Blaster_Command(Lo(Freq));
Blaster_Command($48);
Blaster_Command(lo(DMALength));
Blaster_Command(hi(DMALength));
Blaster_Command($91);
Inline($FB);
End;
Procedure Ausgabe_IRQ; Interrupt;
Var test : Byte;
Begin
Inline($FA);
Port[$20]:=$20;
test:=Port[sbb+$e];
Ende:=True;
Inline($fB);
End;
{$F-}
Procedure Play;
Var p,s,s2 : Word;
w : LongInt;
Begin
GetMem(zwi,16);
GetMem(dma_buf_1,dma);
p:=16;
While (Seg(dma_buf_1^[1]) mod 4096)>(4096-(dma*2 div 16)) do
Begin
FreeMem(dma_buf_1,dma);
FreeMem(zwi,p);
p:=p+16;
If p>65525 then halt(111);
GetMem(zwi,p);
GetMem(dma_buf_1,dma);
End;
GetMem(dma_buf_2,dma);
FreeMem(zwi,p);
port[$21]:=Port[$21] and (255 xor (1 shl Blaster.IRQ));
GetIntVec(Blaster.IRQ+8,Alt_irq);
SetIntVec(Blaster.IRQ+8,@Ausgabe_IRQ);
w:=id.freq*id.modus;
BlockRead(wav,dma_buf_1^[1],dma,s);
Repeat
Ende:=False;
Stelle_DMA(w,s);
BlockRead(wav,dma_buf_2^[1],dma,s2);
Repeat Until Ende;
s:=s2;
zwi:=dma_buf_1;
dma_buf_1:=dma_buf_2;
dma_buf_2:=zwi;
Until EoF(wav) or Keypressed;
While KeyPressed do w:=Ord(ReadKey);
If EoF(wav) then
Begin
Ende:=False;
Stelle_DMA(w,s);
Repeat Until Ende;
End;
SetintVec(Blaster.IRQ+8,Alt_IRQ);
FreeMem(dma_buf_1,dma);
FreeMem(dma_buf_2,dma);
Port[$21]:=Port[$21] or (1 shl Blaster.IRQ);
Blaster_Command($d3);
End;
Begin
Init;
Play;
End.
[Back to SOUND SWAG index] [Back to Main SWAG index] [Original]