unit Sounder2;

  {$C FIXED PRELOAD PERMANENT}
  {$M 65520,64500,655350}
interface

uses WadDecl;

var	SbIOAddr,SbIRQ:word;
		DMA_Complete:boolean;

Function InitSB:boolean;
Procedure SetSbIOAddr(NewAddr:word);
Procedure SetSbIRQ(NewIRQ:word);
Procedure SetVoice(State:integer);
Procedure PlayBuff(sBuff:PSoundBuff;BuffAddr:longint);
Procedure StopBuff;
Function Sys_InitSB:Boolean;
Procedure Sys_DoneSB;

Implementation

uses DOS,CRT;

CONST	DMA			=0;   	{DMA Constants}
		CH0_BASE 	=0;
		CH0_COUNT 	=1;
		CH1_BASE 	=2;
		CH1_COUNT 	=3;
		CH2_BASE 	=4;
		CH2_COUNT 	=5;
		CH3_BASE 	=6;
		CH3_COUNT 	=7;
		DMA_STATUS  =8;
		DMA_CMD		=8;
		DMA_REQUEST =9;
		DMA_MASK		=10;
		DMA_MODE		=11;
		DMA_FF		=12;
		DMA_TMP		=13;
		DMA_CLEAR	=13;
		DMA_CLRMSK	=14;
		DMA_WRMSK	=15;
		DMAPAGE		=$80;

		DSP_WRITE_STATUS	=$C;		{Sound Blaster Constants}
		DSP_WRITE_DATA		=$C;

PROCEDURE cli;
INLINE
  (
  $FA    {CLI}
  );

PROCEDURE sti;
INLINE
  (
  $FB    {STI}
  );

{$F+}


var	IRQVect:pointer;
		OldExit:Pointer;

Function InitSB:boolean;

	var RetVal:Boolean;

	begin
		asm
			 mov al,1
			 mov dx,sbIOaddr
			 add dx,6
			 out dx,al
			 in	al,dx
			 in	al,dx
			 in	al,dx
			 in	al,dx
			 mov al,0
			 out dx,al
			 add dx,4
			 mov cx,100
		@@1:
			 in al,dx
			 cmp al,0AAh
			 je @@2
			 loop @@1
			 mov  RetVal,False
			 jmp @@3
		@@2:
			 mov RetVal,True
		@@3:
		end;
		InitSb:=RetVal;
	end;

Procedure SetSbIOAddr(NewAddr:word);

	begin
		SbIOAddr:=NewAddr;
	end;

Procedure writeDAC(v:byte);

	var b:byte;

	begin
		repeat
			b:=port[sbIOAddr+DSP_WRITE_STATUS];
		until (b and $80)=0;
		port[sbIOAddr+DSP_WRITE_DATA]:=v;
	end;

Procedure SetVoice(State:Integer);

	begin
		case State of
			1:writeDAC($D1);	{Voice On}
			0:writeDAC($D3);	{Voice Off}
		end;
	end;

Procedure SetSampleRate(Rate:word);

	var	tc:byte;

	begin
		tc:=(256 - (1000000 div rate));
		writeDAC($40);
		writeDAC(tc);
	end;

Procedure SetPICStatus;

	var im,tm:byte;

	begin
		im:=port[$21];
		tm:=(1 shl sbIRQ) xor $FF;
		port[$21]:=(im and tm);
		sti;
	end;

Procedure SetDMAStatus(BuffAddr:longint;DataLen:word);

	var	t:word;

	begin
		{Set DMA Mode}
		port[DMA_MASK]:=5;
		port[DMA_FF]:=0;
		port[DMA_MODE]:=$49;
		{Set Transfer Address}
		t:=(BuffAddr shr 16);
      port[DMAPAGE+3]:=t;
      t:=(BuffAddr and $FFFF);
		port[CH1_BASE]:=(t and $FF);
      port[CH1_BASE]:=(t shr 8);
      {Set Transfer Length Byte Count}
      port[CH1_COUNT]:=(DataLen and $FF);
      port[CH1_COUNT]:=(DataLen shr 8) and $FF;
      {Unmask DMA Channel}
      port[DMA_MASK]:=1;
   end;

Procedure SetDACStatus(DataLen:word);

	begin
      {Set Up Sound Blaster for transfer}
      writeDAC($48);		{Setup DAC for DMA Transfer}
      writeDAC(DataLen and $FF);
      writeDAC((DataLen shr 8) and $FF);
      writeDAC($14);
      writeDAC(DataLen and $FF);
      writeDAC((DataLen shr 8) and $FF);
	end;

{$F+,S-,W-}
procedure IRQProc(Flags, CS, IP, AX, BX, CX, DX, SI, DI, DS, ES, BP: Word);

	interrupt;
   begin
   	STI;
      DMA_Complete:=True;
      port[$20]:=$20;
   end;
{$F-,S+}

Procedure SetSbIRQ(NewIRQ:word);

	begin
   	SbIRQ:=NewIRQ;
   end;

Function Sys_InitSB:boolean;

	var	Regs:Registers;

	begin
      if InitSB=False then begin
         writeln('Sb_Init: Failed to initialize Sound Blaster.');
   		Halt(1);
      end;
      CLI;
      GetIntVec($08+sbIRQ,IRQVect);
      SetIntVec($08+sbIRQ,@IRQProc);
      STI;
      DMA_Complete:=False;
      Sys_InitSB:=True;
      SetVoice(1);
	end;

Procedure Sys_DoneSB;

	begin
      SetIntVec($08+sbIRQ,IRQVect);
      ExitProc:=OldExit;
      SetVoice(0);
   end;

Procedure PlayBuff(sBuff:PSoundBuff;BuffAddr:longint);

	type TBuff=Array[0..46080] of byte;

	begin
   	DMA_complete:=False;
      InitSB;
      SetSampleRate(sBuff^.SampleRate);
      SetPICStatus;
		SetDMAStatus(BuffAddr,sBuff^.Samples);
      SetDACStatus(sBuff^.Samples);
      SetVoice(1);
   end;

Procedure StopBuff;

	begin
   	SetVoice(0);
   end;

begin
	sbIOAddr:=$220;
   sbIRQ:=5;
   DMA_Complete:=False;
   Sys_InitSb;
   OldExit:=ExitProc;
   ExitProc:=@Sys_DoneSB;
end.