[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]