{$A+,B-,D+,E-,F-,G+,I+,L+,N+,O-,P-,Q-,R-,S-,T-,V-,X+,Y+}
(****************************************************************************
 * Author           : Stefan Goehler, Germany                               *
 * Version          : official 1.12                                         *
 * Task             : Play and record with soundblaster and compatibles     *
 * Copyright        : Do what u want to do with this, but mention me!       *
 *                    But if you want to use it in commercial products - I  *
 *                    mean if you want to get any money for the software    *
 *                    with this unit, please contact me and I'll give you   *
 *                    my OK or not.                                         *
 *******                                                                    *
 * I don't know any bugs - if there are any, please email me!               *
 * If you don't know where's the bug, tell me what happened when and also   *
 * give me your machine configuration                                       *
 *                                                                          *
 * my homepage: http://www.geocities.com/SiliconValley/Bay/9553             *
 * ^^^note that you can get there always the actual version of this unit    *
 * if you have additions, tips or sth. else, mail to stefan.goehler@gmx.de  *
 *******                                                                    *
 * the following files you should get with this unit:                       *
 * soundlib.txt : readmefile for this unit                                  *
 * soundemo.pas : simple demoproggy                                         *
 * soundem2.pas : more complex demoproggy with mixer                        *
 * soundem3.pas : simple recording-unit                                     *
 * soundem4.pas : complex scope program for viewing what you hear (i.e. CD) *
 * bk.obj       : background file for soundem4.pas                          *
 *******                                                                    *
 * Maybe there'll come some bugfixed versions in the next time - so take    *
 * sometimes a look at my homepage                                          *
 ******                                                                     *
 * History                                                                  *
 * Version 1.0 : first public available Version (4th Sep. 1997)             *
 * Version 1.01: *fixed a bug with multifiles- LASTONE wasn't setted back   *
 *                and the sb played not without reseta 16bit-file after a  *
 *                8bit file correctly                                       *
 *               +added some additional in the readmefile(6th Sep. 1997)    *
 * Version 1.1   -removed needless things                                   *
 *               +added surround sound                                      *
 *               *fixed a bug when playback runs, that you can't open a file*
 *                I don't know why tp returns then with ioresult = 100, it  *
 *                seems that is a bug of tp (9th Sep. 1997)                 *
 *               +added function getactpos- gives back the fileremain minus *
 *                the already played sounddata - very accurate              *
 *               -removed LASTONE and used a better method                  *
 *               *fixed bug that the file won't play to the full end        *
 * Version 1.11  *fixed a bug which won't set the speaker on with older     *
 *                version of soundblasters                                  *
 *               *soundlib is now runable under TP6 without any changes     *
 * Version 1.12  *changed 'pitch' to 'treble'                               *
 *               *fixed a little bug that causes terrible sounds with some  *
 *                files smaller than the doublebuffer                       *
 *               *changed line to linein because of conflicts with linedraw *
 ****************************************************************************)
unit soundlib;
{$IFDEF DPMI}
This unit is not able to run with DPMI !
{$ENDIF}
interface
uses dos;
type
tplay = record
     hispeed    : boolean;{is the playback in hispeed? (filled with initplay)}

     blocksize  : longint;{half size of the getted buffermemory}
     p          : pointer;{pointer to the sounddata buffermemory}
     activeblock: byte;   {active bufferblock (because of doublebuffering)}
     callproc   : procedure;{the procedure to call with the interrupt}

     stopped    : boolean;{the playback is stopped}
     paused     : boolean;{playback is paused}

     data : array[0..19] of record
     frequency  : longint;{samplingrate}
     stereo     : boolean;{is playing in stereo}
     sound16bit : boolean;{is playing in 16 bit}
     adpcm      : boolean;{is file adpcm compressed(for future versions of this unit)}
     signed     : boolean;{is sounddata signed}

     fileremain : longint;{remain of the file to play}
     fdatasize  : longint;
     fsize      : longint;{size of the file to play}
     fdatastart : longint;{startposition of the sounddata in the file}
     f          : file;   {file to read/write}
     fclosed    : boolean;{shows if the file is open or not}
     end;
    end;

trec = record
     hispeed    : boolean;{is the playback in hispeed? (filled with initrecord)}

     blocksize  : longint;{half size of the getted buffermemory}
     p          : pointer;{pointer to the sounddata buffermemory}
     activeblock: byte;   {active bufferblock (because of doublebuffering)}
     callproc   : procedure;{the procedure to call with the interrupt}

     stopped    : boolean;{the playback is stopped}
     paused     : boolean;{playback is paused}

     frequency  : longint;{samplingrate}
     stereo     : boolean;{is playing in stereo}
     sound16bit : boolean;{is playing in 16 bit}
     adpcm      : boolean;{is file adpcm compressed(for future versions of this unit)}
     signed     : boolean;{is sounddata signed}

     fileremain : longint;{remain of the file to play}
     fdatasize  : longint;
     fsize      : longint;{size of the file to play}
     fdatastart : longint;{startposition of the sounddata in the file}
     f          : file;   {file to read/write}
     fclosed    : boolean;{shows if the file is open or not}
    end;

wavehdrtype = record {Header of a wavefile}
format        : array[0..3] of char;
filelength    : longint;
kennstr       : array[0..7] of char;
formatlength  : longint;
formattag     : word;
channels      : word;
frequency     : longint;
bytespersecnd : longint;
blkalign      : word;
resolution    : word;
data          : array[0..3] of char;
chunklength   : longint;
end;

const
  sb16               = $400;
  sbpro              = $300;
  sb21               = $210;
  sb20               = $200;
  actfile            : byte = 0;{the momently used file}
{Constants for the dma-port-adresses}
  dma_lpage          : array[0..7] of byte = ($87,$83,$81,$82,$88,$8B,$89,$8A);
  dma_hpage          : array[0..7] of word = ($487,$483,$481,$482,$00,$48B,$489,$48A);
  dma_adr            : array[0..7] of byte = ($00,$02,$04,$06,$C0,$C4,$C8,$CC);
  dma_wc             : array[0..7] of byte = ($01,$03,$05,$07,$C2,$C6,$CA,$CE);

{Constants for volume settings}
 master  = 1;
 voice   = 2;
 midi    = 3;
 cd      = 4;
 linein    = 5;
 mike    = 6;
 speaker = 7;
 treble   = 8;
 bass    = 9;

 buffersize : word = 16384;
 autorestore: boolean = true;{automatic restore mixersettings}
 surround   : boolean = false;

var
    oldexitproc     : Pointer;

    blaster          : record
     irq         : byte;
     lodma,hidma : word;
     adress      : word;
     version     : word;
     available   : boolean;
     {following will be filled with the maximum playback values}
     frequency   : word;
     sound16bit  : boolean;
     stereo      : boolean;
     end;

    play             : tplay;
    rec              : trec;
    dummy            : word;

    oldint           : pointer;
    irqmsk,irqvec    : byte;
    lastblock        : boolean;

error : byte;

 function  initblaster : boolean;{call it _before_ any usage of the blaster}
 function  getversionstring : string;
 procedure initrecord(p : pointer;buffersize,frequency : word;stereo,s16bit : boolean);
 procedure initplay(datanum: byte;p : pointer;buffersize,frequency : word;stereo,s16bit : boolean);
 procedure exitplay;{stop playback - use it only if you haven't used open****}
 procedure exitrecord;
 procedure pauserecord(pause : boolean);
 procedure pauseplay(pause : boolean);
 procedure startplay(datanum : byte);{start playback if you used open****}
 procedure stopplay; {stop  playback if you used open****}
 function  getactpos : longint;
 procedure silence(var p; count : word);
 procedure setplaypos(datanum : byte;pos : longint);{set fileposition of playback file - only if you used open****}
 function  setvolume(what,left,right : byte) : boolean;
 function  getvolume(what : byte;var left,right : byte) : boolean;
 function  SetSndOutput(output : byte;left,right : boolean) : boolean;
 function  SetSndInput(input,channel : byte;left,right : boolean) : boolean;
 function  getinput(input,channel : byte;var left,right : boolean) : boolean;
 function  setgain(out : boolean;left,right : byte) : boolean;
 function  getgain(out : boolean;var left,right : byte) : boolean;
 function  setmemsize(size : word) : boolean;
 function  openvoc(datanum : byte;filename : string) : boolean;
 function  openwav(datanum : byte;filename : string) : boolean;
 function  opensound(datanum : byte;s : string) : boolean;{open wave or vocfile -the program detects that with .wav or .voc}
 procedure closesound(datanum : byte);{close playback file and stop playback}
 procedure savemixer;
 procedure restoremixer;

implementation

 function  readmixer(Reg: byte) : byte;forward;
 procedure writemixer(Reg, Val: byte);forward;

const
errorstr : array[0..0] of string=('Soundcard seems to be busy');
(*
procedure error(num,errcode : byte);
begin
  {halt(errcode);}
  blaster.available := False;
end;
*)
function getversionstring : string;
begin
getversionstring := 'V 1.12';
end;

procedure writedsp(v : byte);assembler;
asm
 mov error, 0
 mov dx,blaster.adress
 add dx,0Ch
 xor cx,cx
 @lp:
   in al,dx
   dec cx
 jz @err
 cmp al,127
 ja @lp
 jmp @noerr
 @err:
   mov error, 1
{   push 0
   push 20
   call error}
   jmp @Fin
 @noerr:
 mov al,v
 out dx,al
 @Fin:
end;


function resetblaster : boolean;
var
incer,b : byte;
begin
  port[blaster.adress+$6] := 1;
Asm
  mov dx, 0c350h
  xor cx, cx
  mov ah, 86h
  int 15h
End;
  port[blaster.adress+$6] := 0;
  incer:= 0;
  repeat
    b := port[blaster.adress+$E];
    b := port[blaster.adress+$A];
    inc(incer);
  until (b = $AA)or(incer > 149);
  resetblaster := b = $AA;
end;


procedure setspeed(hz : byte);assembler;
asm
 push 40h
 call writedsp
 mov al,hz
 dec al
 push ax
 call writedsp
end;

procedure setspeedSB16play(hz : word);assembler;
asm
 push 42h
 call writedsp
 mov ax,hz
 mov al,ah
 xor ah,ah
 push ax
 call writedsp
 mov ax,hz
 xor ah,ah
 push ax
 call writedsp
end;

procedure setspeedSB16record(hz : word);assembler;
asm
 push 41h
 call writedsp
 mov ax,hz
 mov al,ah
 xor ah,ah
 push ax
 call writedsp
 mov ax,hz
 xor ah,ah
 push ax
 call writedsp
end;

procedure setsamplingrate(hz : word);
begin
if blaster.version >= sb16 then setspeedSB16play(hz) else
setspeed(256-(1000000 div (longint(hz)*succ(byte(play.data[actfile].stereo)))));
end;

procedure setsamplingraterec(hz : word);
begin
if blaster.version >= sb16 then setspeedSB16record(hz) else
setspeed(256-(1000000 div (longint(hz)*succ(byte(rec.stereo)))));
end;

procedure pauserecord(pause : boolean);
{Pause the playback - if you play at the same resolution
 (8 or 16 bit) as the recording, this procedure will pause
 both recording and playing}
begin
 if pause then begin
if not rec.paused then if (rec.sound16bit)and(blaster.version >= sb16) then writedsp($D5) else writedsp($D0);
 end else begin
   if rec.paused then if (rec.sound16bit)and(blaster.version >= sb16) then writedsp($D6) else writedsp($D4);
 end;
 rec.paused := pause;
end;

procedure pauseplay(pause : boolean);
{Pause the playback - if you record at the same resolution
 (8 or 16 bit) as the playing, this procedure will pause
 both recording and playing}
begin
 if pause then begin
if not play.paused then if (play.data[actfile].sound16bit)and(blaster.version>=sb16) then writedsp($D5) else writedsp($D0);
 end else begin
  if play.paused then if (play.data[actfile].sound16bit)and(blaster.version >= sb16) then writedsp($D6) else writedsp($D4);
 end;
 play.paused := pause;
end;


var
settings1 : array[1..9] of record
                    l,r : byte;
                    end;
settings2 : array[1..8] of byte;

procedure savemixer;
begin
 for dummy := 1 to 9 do getvolume(dummy,settings1[dummy].l,settings1[dummy].r);
 if blaster.version >= sb16 then
 for dummy := 1 to 8 do settings2[dummy] := readmixer($3B+dummy)
 else if blaster.version >= sbpro then begin
   settings2[1] := readmixer($0C);
   settings2[2] := readmixer($0E);
 end;
end;

procedure restoremixer;
begin
 for dummy := 1 to 9 do setvolume(dummy,settings1[dummy].l,settings1[dummy].r);
 if blaster.version >= sb16 then
 for dummy := 1 to 8 do writemixer($3B+dummy,settings2[dummy])
 else if blaster.version >= sbpro then begin
   writemixer($0C,settings2[1]);
   writemixer($0E,settings2[2]);
 end;
end;

procedure exitblaster;far;
begin
 exitproc := oldexitproc;
 if blaster.available then begin
   if not play.data[actfile].fclosed then closesound(actfile);
   if not rec.stopped then exitrecord;
   setintvec(irqvec+(blaster.irq and 7),oldint);
 if blaster.irq < 8 then
   port[$21] := port[$21] or irqmsk else
   port[$A1] := port[$A1] or irqmsk;
   port[blaster.adress+$c] := $d3;
 if blaster.irq < 8 then
   port[$20] := $20 else
   port[$A0] := $20;
{   if play.p <> nil then freemem(play.p,buffersize);}
   if autorestore then restoremixer;
 end;
end;

procedure initdma(dma : byte;p : pointer;size : word;get,autoinit : boolean);
var
b : byte;
l : longint;
segm,offs : word;
begin
 l := longint(seg(p^)) shl 4+ofs(p^);
 segm := l shr 16;
 if dma > 3 then
 offs := word((longint(p) and $FFFF0000) shr 13+(longint(p) and $FFFF) shr 1)
 else
 offs := l and $FFFF;

 if get then b := $44 else b := $48;
 if autoinit then inc(b,$10);

 if dma > 3 then begin
   port[$D4] := dma;
   port[$D6] := b+dma-4;
   port[$D8] := 0;
 end else begin
   port[$0A] := dma+4;
   port[$0B] := b+dma;
   port[$0C] := 0;
 end;
 port[dma_adr[dma]] := Lo(offs);
 port[dma_adr[dma]] := Hi(offs);
 port[dma_lpage[dma]] := segm;
 port[dma_wc[dma]] := Lo(size-1);
 port[dma_wc[dma]] := Hi(size-1);
 if dma > 4 then port[$D4] := dma-4 else port[$0A] := dma;
end;

function dmagetpos(dma : byte) : word;
var
w : word;
begin
 if dma > 3 then
   port[$D8] := 0 else
   port[$0C] := 0;
 w := port[dma_wc[dma]];
 w := word(port[dma_wc[dma]]) shl 8;
 inc(w);
 if dma > 4 then w := w shl 1;
dmagetpos := w;
end;

function getactpos : longint;
var
dma : byte;
l,l2: longint;
begin
if (blaster.version >= sb16)and(play.data[actfile].sound16bit) then
dma := blaster.hidma else dma := blaster.lodma;
l :=
(play.data[actfile].fsize - play.data[actfile].fileremain)+
 (buffersize-dmagetpos(dma))- pred(play.activeblock)*play.blocksize-buffersize;
l2 := play.data[actfile].fsize - play.data[actfile].fdatastart;
if l > l2 then l := l2;
getactpos := l;
end;

procedure playsb(p : pointer;dsize : word);
begin
 initdma(blaster.lodma,p,dsize,false,false);
 writedsp($14);
 writedsp(Lo(dsize-1));
 writedsp(Hi(dsize-1));
end;

procedure initrecord(p : pointer;buffersize,frequency : word;stereo,s16bit : boolean);
var
size,dma : word;
begin
 if not blaster.available then exit;
 rec.sound16bit := s16bit;
 rec.stereo     := stereo;
 rec.blocksize  := buffersize shr 1;
 rec.frequency  := frequency;
 rec.p          := p;
 rec.activeblock:= 2;{Block where the last data has been written to}
 rec.stopped    := false;
 rec.hispeed    := false;

 size := play.blocksize;

 setsamplingraterec(frequency);

 if blaster.version >= sb16 then begin
   size := rec.blocksize;
   if rec.sound16bit then begin
     size := size shr 1;
     dma := blaster.hidma;
   end else dma := blaster.lodma;

   initdma(dma,rec.p,size shl 1,true,true);
   if rec.sound16bit then begin
     writedsp($BE);
     if rec.stereo then writedsp($30) else writedsp($10);{signed!!!}
     end else begin
       writedsp($CE);
       if rec.stereo then writedsp($20) else writedsp($00);
     end;
     writedsp(Lo(size-1));
     writedsp(Hi(size-1));
   end else if
 ((blaster.version >= sb21)and((rec.frequency > 13000))or
 ((blaster.version >=sbpro)and((rec.frequency > 23000)or(rec.stereo)))) then begin
{sb21 or higher and sr > 13000 or sbpro and sr > 23000}
   writedsp($D3);
   rec.hispeed := true;
   if (rec.stereo)and(blaster.version >= sbpro) then{sbpro and stereo and sr >= 11025 and sr <= 22050}
   writedsp($A8);

   initdma(blaster.lodma,rec.p,size shl 1,true,true);
   setsamplingrate(rec.frequency);

   writedsp($48);
   writedsp(Lo(size-1));
   writedsp(Hi(size-1));
   writedsp($98);
 end else begin {sb20 or higher, mono and sr <=13000}
   writedsp($D3);
   initdma(blaster.lodma,rec.p,size shl 1,true,true);
   setsamplingrate(rec.frequency);

   writedsp($48);
   writedsp(Lo(size-1));
   writedsp(Hi(size-1));
   writedsp($2C);
 end;
end;


procedure downsample8(p1,p2 : pointer;adder,size : word);assembler;
asm
 mov cx,size
 or cx,cx
 jz @end
 push ds
 les di,p1
 lds si,p2
 mov bx,adder
 @lp:
   mov ax,es:[di]

   mov ds:[si],ax
   add di,bx
   add si,2
   dec cx
 jnz @lp
 pop ds
 @end:
end;

procedure downsample16(p1,p2 : pointer;adder,size : word);assembler;
asm
 mov cx,size
 or cx,cx
 jz @end
 push ds
 les di,p1
 lds si,p2
 mov bx,adder
 @lp:
   mov al,es:[di+1]
   mov ah,es:[di+3]
   add ax,$7980

   mov ds:[si],ax
   add di,bx
   add si,2
   dec cx
 jnz @lp
 pop ds
 @end:
end;

procedure surround16(p : pointer;size : word);assembler;
asm
 mov cx,size
 or cx,cx
 jz @end
 les di,p
 @lp:
   mov ax,es:[di]
   neg ax
   mov es:[di],ax
   add di,4
   dec cx
 jnz @lp
 @end:
end;

procedure surround8(p : pointer;size : word);assembler;
asm
 mov cx,size
 or cx,cx
 jz @end
 les di,p
 @lp:
   mov al,es:[di]
   neg al
   mov es:[di],al
   add di,2
   dec cx
 jnz @lp
 @end:
end;


var dummycalled : boolean;

procedure dummycaller;far;
begin
 dummycalled := true;
end;


procedure exitplay;
begin
 if not play.stopped then begin
   if blaster.version >= sb16 then begin
       if play.data[actfile].sound16bit then writedsp($D9) else writedsp($DA);
       resetblaster;
     end else if play.hispeed then begin
       resetblaster;
       writedsp($D3);
       writemixer($E,readmixer($E) and not 2);
     end else begin
       writedsp($D3);
       writedsp($DA);
       resetblaster;
   end;
   play.stopped  := true;
   play.callproc := dummycaller;
 end;
end;

procedure exitrecord;
begin
 if not rec.stopped then begin
   if blaster.version >= sb16 then begin
   if rec.sound16bit then writedsp($D9) else writedsp($DA);
       resetblaster;
     end else if rec.hispeed then begin
       resetblaster;
       writemixer($E,readmixer($E) and not 2);
     end else begin
       writedsp($DA);
       resetblaster;
     end;
   rec.stopped  := true;
   rec.callproc := dummycaller;
 end;
end;


procedure silence(var p; count : word);
procedure fillword(var X; Count: Word; value : word);assembler;
asm les di,x;mov cx,count;mov ax,value;rep stosw;end;
begin
if play.data[actfile].sound16bit then fillword(p,count shr 1,0) else fillword(p,count shr 1,$8080);
end;

procedure read(var f : file;p : pointer;size : word);
var
p2     : pointer;
mem    : word;
readen,dummy : word;
begin
lastblock := false;
 if (play.data[actfile].sound16bit) and (blaster.version < sb16) then begin
   if blaster.version < sb21 then dummy := 8 else dummy := 4;
   mem := size * (dummy shr 1);
   getmem(p2,mem);
   dummy := dummy*succ(byte(play.data[actfile].stereo));

   blockread(f,p2^,size*(dummy shr 2),readen);
   downsample16(p2,p,dummy,readen div dummy);
   dec(play.data[actfile].fileremain,size*(dummy shr 2));

   blockread(f,p2^,size*(dummy shr 2),readen);
   downsample16(p2,ptr(seg(p^),ofs(p^)+(size shr 1)),dummy,readen div dummy);

   freemem(p2,mem);
   dec(play.data[actfile].fileremain,size*(dummy shr 2));
   if (play.data[actfile].stereo)and(surround)and(blaster.version >= sbpro) then
   surround8(p,size shr 1);
 end else if (((play.data[actfile].frequency > 22050)and(play.data[actfile].stereo))
 or((play.data[actfile].frequency > 22050)and(blaster.version < sb21)))
 and (blaster.version < sb16) then begin
   if blaster.version < sb21 then dummy := 4 else dummy := 2;
   mem := size * (dummy shr 1);
   getmem(p2,mem);
   dummy := dummy*succ(byte(play.data[actfile].stereo));
   blockread(f,p2^,size*(dummy shr 1),readen);
   downsample8(p2,p,dummy,readen div dummy);
   freemem(p2,mem);
   dec(play.data[actfile].fileremain,size*(dummy shr 1));
 end else begin
   blockread(f,p^,size,readen);
   dec(play.data[actfile].fileremain,play.blocksize);
   if (play.data[actfile].stereo)and(surround)and(blaster.version >= sbpro) then begin
   if play.data[actfile].sound16bit then
   surround16(p,size shr 2) else
   surround8(p,size shr 1);
   end;
 end;
end;

procedure soundplaycaller;far;
var
  p : pointer;
begin
 if (play.data[actfile].fileremain > play.blocksize) then begin
   read(play.data[actfile].f,ptr(seg(play.p^),ofs(play.p^)+play.blocksize*pred(play.activeblock)),play.blocksize);
   if play.activeblock = 2 then play.activeblock := 1 else play.activeblock := 2;
 end else begin
   if play.data[actfile].fileremain > 0 then begin
     p := ptr(seg(play.p^),ofs(play.p^)+play.blocksize*pred(play.activeblock));
     silence(p^,play.blocksize);
     read(play.data[actfile].f,p,play.data[actfile].fileremain mod play.blocksize);
     if play.activeblock = 2 then play.activeblock := 1 else play.activeblock := 2;
   end else begin
     if lastblock then exitplay;
     if play.activeblock = 2 then play.activeblock := 1 else play.activeblock := 2;
     lastblock := true;
   end;
 end;
end;

var
  intrunning : boolean;

procedure intcaller;interrupt;
var
  h   : byte;
  run : boolean;
begin
  run := intrunning;
  intrunning := true;
  if blaster.version >= sb16 then begin
    h := readmixer($82);
    if h and 1 <> 0 then h := port[blaster.adress+$E] else h := port[blaster.adress+$F];
    if not run then begin{If interrupts overlap, the machine hangs!}
      if not rec.stopped then rec.callproc;
      if not play.stopped then play.callproc;
    end;
  end else begin
    h := port[blaster.adress+$E];
    if not run then begin{If interrupts overlap, the machine hangs!}
      if not play.stopped then play.callproc;
      if not rec.stopped then rec.callproc;
    end;
  end;
  if blaster.irq > 7 then
  port[$A0] := $20;
  port[$20] := $20;
  intrunning := false;
end;

function hex2word(s : string) : word;
const
number : set of char=['0'..'9'];
var
i : word;
w,w2 : word;
begin
  w := 0;
  for i := 1 to length(s) do begin
    if s[i] in number then
    w2 := ord(s[i])-48
    else
    w2 := ord(s[i])-55;
    inc(w,w2 shl ((length(s)-i)*4));
  end;
  hex2word := w;
end;

function getdspversion : word; assembler;
asm
 push $E1
 call writedsp
 mov dx,blaster.adress
 add dx,0Ah
 @lp1:
   in al,dx
   cmp al,$AA
   mov ah,al
 je @lp1
 @lp2:
   in al,dx
   cmp al,$AA
 je @lp2
end;

function initblaster : boolean;
{Detects Soundblaster via environment variable.
 Not professional, but _very_ compatible with
 all computer configurations and SB-clones}
var
s,s2 : string;
i : word;
i2: integer;
begin
 initblaster := false;
 if error = 1 then begin
   blaster.available:= false;
   exit;
 end;
 blaster.version := 0;
 s := getenv('BLASTER');
 if s = '' then exit;
 for i := 1 to length(s)
 do s[i] := upcase(s[i]);

 i := pos('D',s);
 if i <> 0 then begin
   val(s[i+1],i,i2);
   blaster.lodma := i;
 end else exit;
 i := pos('H',s);
 if i <> 0 then begin
   val(s[i+1],i,i2);
   blaster.hidma := i;
 end else blaster.version := sbpro;

 i := pos('I',s);
 if i <> 0 then begin
   val(s[i+1],i,i2);
   blaster.irq := i;
   i := pos('I',s);
   if (i+2 <= length(s))and(s[i+2] <> ' ') then begin
     blaster.irq := blaster.irq*10;
     val(s[i+2],i,i2);
     inc(blaster.irq,i);
   end;
 end else exit;

 i := pos('A',s);
 if i <> 0 then begin
   for i2 := 1 to 3 do s2[i2] := s[i+i2];
   s2[0] := #3;
   s2[4] := #0;
   blaster.adress := hex2word(s2);
 end else exit;


 {if not resetblaster then exit;}resetblaster;
 i := getdspversion;
 if error = 1 then exit;
 if blaster.version = 0 then blaster.version := i else
 begin
   if blaster.version < sb16 then blaster.version := i;
 end;
 if blaster.version < sb20 then exit;        {blasters lower than version }
                                             {2.0 aren't supported because}
                                             {they cannot run the autoinit}
                                             {mode}
 with blaster do begin
   if version >= sb16 then begin
     frequency := 45000;
     sound16bit:= true;
     stereo    := true;
   end else if version >= sbpro then begin
     frequency := 45000;
     sound16bit:= false;
     stereo    := true;
   end else if version >= sb21 then begin
     frequency := 45000;
     sound16bit:= false;
     stereo    := false;
   end else begin
     frequency := 22050;
     sound16bit:= false;
     stereo    := false;
   end;
 end;
 if blaster.irq < 8 then
 irqvec := $8 else irqvec := $70;
 getintvec(irqvec+(blaster.irq and 7),oldint);
 setintvec(irqvec+(blaster.irq and 7),@intcaller);
 irqmsk := 1 shl (blaster.irq and 7);
 if blaster.irq < 8 then
 port[$21] := port[$21] and not irqmsk else
 port[$A1] := port[$A1] and not irqmsk;
 if error = 1
 then blaster.available := False
 else blaster.available := True;
 if blaster.available then initblaster := true;
 savemixer;{save mixer settings}
end;



procedure writemixer(Reg, Val: byte);assembler;
asm
 mov dx,blaster.adress
 add dx,04h
 mov al,reg
 out dx,al
 inc dx
 mov al,val
 out dx,al
end;

function readmixer(Reg: byte) : byte;assembler;
asm
 mov dx,blaster.adress
 add dx,04h
 mov al,reg
 out dx,al
 inc dx
 in al,dx
end;

function setagc(on : boolean) : boolean;
begin
 setagc := false;
 if blaster.version < sb16 then exit else setagc := true;
 writemixer($43,readmixer($43) or byte(on));
end;

function SetSndOutput(output : byte;left,right : boolean) : boolean;
procedure setbit(bit : byte;on : boolean);
begin
 if on then
 writemixer($3C,readmixer($3C) or 1 shl bit) else
 writemixer($3C,readmixer($3C) and not (1 shl bit));
 end;

begin
 SetSndOutput := false;
 if blaster.version < sb16 then exit;
 case output of
   mike : setbit(0,left);
   cd   : begin;setbit(1,right);setbit(2,left);end;
   linein : begin;setbit(3,right);setbit(4,left);end;
   else exit;
 end;
 SetSndOutput := true;
end;

function SetSndInput(input,channel : byte;left,right : boolean) : boolean;
{How to use this function?
 -channel is 1 for left, 2 for right
 -you can switch the input for left _and_ right for one channel
 -if you record mono, the left configuration will be used -
  so if you wanna record both left and right in mono, switch
  channel 1(left) to left and right
 -if the blaster is sbpro - you can't set anything off -
  only on with the call you will set the called input on}
procedure setbit(reg,bit : byte;left,right : boolean);
begin
 if bit = 0 then right := left;
 if right then
 writemixer(reg,readmixer(reg) or 1 shl bit) else
 writemixer(reg,readmixer(reg) and not (1 shl bit));

 if bit > 0 then
 if left then
 writemixer(reg,readmixer(reg) or 1 shl succ(bit)) else
 writemixer(reg,readmixer(reg) and not (1 shl succ(bit)));
end;

var b : byte;
begin
 SetSndInput := false;
 if blaster.version >= sb16 then begin
   b := channel+$3C;
   case input of
     mike : setbit(b,0,left,false);
     cd   : setbit(b,1,left,right);
     linein : setbit(b,3,left,right);
     midi : setbit(b,5,left,right);
     else exit;
   end;
 end else if (blaster.version >= sbpro)and((left)or(right)) then begin
   case input of
     cd   : b := 1;
     mike : b := 2;
     linein : b := 3;
     else exit;
   end;
   writemixer($0C,readmixer($0C) or (b shl 1));
 end else exit;
 SetSndInput := true;
end;

function getinput(input,channel : byte;var left,right : boolean) : boolean;
procedure getbit(reg,bit : byte;var left,right : boolean);
begin
 byte(right) := (readmixer(reg) and (1 shl bit)) shr bit;
 if bit > 0 then
 byte(left) := (readmixer(reg) and (1 shl succ(bit))) shr succ(bit);
 if bit = 0 then left := right;
end;

var b,b2 : byte;
begin
 getinput := false;
 if blaster.version >= sb16 then begin
   b := channel+$3C;
   case input of
     mike : getbit(b,0,left,right);
     cd   : getbit(b,1,left,right);
     linein : getbit(b,3,left,right);
     midi : getbit(b,5,left,right);
     else exit;
   end;
 end else if blaster.version >= sbpro then begin
   b2 := readmixer($0C) shr 1 and 3;
   case input of
     cd   : b := 1;
     mike : b := 2;
     linein : b := 3;
     else exit;
   end;
   left := b2 = b;
 end else exit;
 getinput := true;
end;


function setgain(out : boolean;left,right : byte) : boolean;
{This function controls the amplify of the sb16
 set out to true if you want to amplify the output
 else for the input set it false.
 The maximum size for left and right is 3!}
var b : byte;
begin
 setgain := false;
 if blaster.version >= sb16 then begin
   if out then b := $41 else b := $3F;
   writemixer(b,left shl 6);
   writemixer(b+1,right shl 6);
   setgain := true;
 end;
end;

function getgain(out : boolean;var left,right : byte) : boolean;
var b : byte;
begin
 getgain := false;
 if blaster.version >= sb16 then begin
   if out then b := $41 else b := $3F;
   left := readmixer(b) shr 6;
   right:= readmixer(b+1) shr 6;
   getgain := true;
 end;
end;

function setvolume(what,left,right : byte) : boolean;
{Maximum for left and right is 63. I know that this
 resolution is higher as the res of the sb. This
 is only for future versions of the sb - you have
 not to reprogram all things for volume settings!
 If the playback is mono, then the left volume will
 be used. The procedure returns false if the volume
 couldn't be setted (the soundcard doesn't support
 this volume type then)}
procedure setvol(reg,left,right : byte);
begin
 if blaster.version >= sb16 then begin
   writemixer(reg,left);
   if (reg <> $3A)and(reg <> $3B) then writemixer(reg+1,right);
 end else if blaster.version >= sbpro then begin
   writemixer(reg,left shl 4 or right);
 end else begin
   if reg = $0A then left := left shr 1;
   writemixer(reg,left);
 end;
end;

begin
 if left  > 63 then left  := 63;
 if right > 63 then right := 63;
 left  := left  shr 1;
 right := right shr 1;
 setvolume := true;
 if blaster.version >= sb16 then begin
   left  := left  shl 3;
   right := right shl 3;
   case what of
     master  : setvol($30,left,right);
     voice   : setvol($32,left,right);
     midi    : setvol($34,left,right);
     cd      : setvol($36,left,right);
     linein  : setvol($38,left,right);
     mike    : setvol($3A,left,0);
     speaker : setvol($3A,left,0);
     treble  : setvol($44,left,right);
     bass    : setvol($46,left,right);
     else setvolume := false;
   end;
 end else if blaster.version >= sbpro then begin
   left  := left  shr 1;
   right := right shr 1;
   case what of
     master  : setvol($22,left,right);
     voice   : setvol($04,left,right);
     midi    : setvol($26,left,right);
     cd      : setvol($28,left,right);
     linein  : setvol($2E,left,right);
     else setvolume := false;
   end;
 end else begin
   left  := left shr 2;
   case what of
     master  : setvol($02,left,0);
     voice   : setvol($0A,left,0);
     midi    : setvol($06,left,0);
     cd      : setvol($08,left,0);
     else setvolume := false;
   end;
 end;
end;


function getvolume(what : byte;var left,right : byte) : boolean;
procedure getvol(reg : byte;var left,right : byte);
begin
 if blaster.version >= sb16 then begin
 left := readmixer(reg);
 if (reg <> $3A)and(reg <> $3B) then right := readmixer(reg+1) else right := left;
 end else if blaster.version >= sbpro then begin
   left  := readmixer(reg);
   right := left and $0F;
   left  := left shr 4;
 end else
 left := readmixer(reg);
 if reg = $0A then left := left shr 1;
end;

begin
 getvolume := true;
 if blaster.version >= sb16 then begin
   case what of
     master  : getvol($30,left,right);
     voice   : getvol($32,left,right);
     midi    : getvol($34,left,right);
     cd      : getvol($36,left,right);
     linein  : getvol($38,left,right);
     mike    : getvol($3A,left,right);
     speaker : getvol($3A,left,right);
     treble  : getvol($44,left,right);
     bass    : getvol($46,left,right);
     else getvolume := false;
   end;
   left  := left  shr 2;
   right := right shr 2;
 end else if blaster.version >= sbpro then begin
   case what of
     master  : getvol($22,left,right);
     voice   : getvol($04,left,right);
     midi    : getvol($26,left,right);
     cd      : getvol($28,left,right);
     linein  : getvol($2E,left,right);
     else getvolume := false;
   end;
   left  := left  shl 2;
   right := right shl 2;
 end else begin
   case what of
     master  : getvol($02,left,right);
     voice   : getvol($0A,left,right);
     midi    : getvol($06,left,right);
     cd      : getvol($08,left,right);
     else getvolume := false;
   end;
   left  := left shl 3;
   right := left;
 end;
end;


procedure initplay(datanum : byte;p : pointer;buffersize,frequency : word;stereo,s16bit : boolean);
var
size,dma : word;
savecallproc     : procedure;
begin
 if not blaster.available then exit;
 play.data[datanum].sound16bit := s16bit;
 play.data[datanum].stereo     := stereo;
 play.blocksize  := buffersize shr 1;
 play.data[datanum].frequency  := frequency;
 play.p          := p;
 play.activeblock:= 1;
 play.stopped    := false;
 play.hispeed    := false;

 size := play.blocksize;
 if blaster.version >= sb16 then begin
   setsamplingrate(play.data[datanum].frequency);

   if play.data[datanum].sound16bit then begin
     size := size shr 1;
     dma := blaster.hidma;
   end else dma := blaster.lodma;

   initdma(dma,play.p,size shl 1,false,true);
   if play.data[datanum].sound16bit then writedsp($B6)
   else writedsp($C6);
   if play.data[datanum].signed then begin
     if play.data[datanum].stereo then writedsp($30) else writedsp($10) end
     else begin if play.data[datanum].stereo then writedsp($20) else writedsp($00);end;
     writedsp(Lo(size-1));
     writedsp(Hi(size-1));
   end else if (blaster.version >= sb21)and((play.data[datanum].frequency > 23000)
   or(play.data[datanum].stereo)) then begin{sb21 or higher and sr > 23000}
   writedsp($D1);
   play.hispeed := true;
   if (stereo)and(blaster.version >= sbpro) then begin{sbpro and stereo and sr >= 11025 and sr <= 22050}
     {This part switches the sbpro to stereo mode
      This should work according to the manual from
      creative labs}
     writemixer($E,readmixer($E) or 2);
     savecallproc  := play.callproc;
     dummycalled   := false;
     play.callproc := dummycaller;
     dummy := $80;
     playsb(@dummy,1);
     repeat until dummycalled;
     play.callproc := savecallproc;
   end;

   initdma(blaster.lodma,play.p,size shl 1,false,true);

   setsamplingrate(play.data[datanum].frequency);

   writedsp($48);
   writedsp(Lo(size-1));
   writedsp(Hi(size-1));
   writedsp($90);
 end else begin {sb20 or higher, mono and sr <=23000}
   writedsp($D1);
   initdma(blaster.lodma,play.p,size shl 1,false,true);
   setsamplingrate(play.data[datanum].frequency);
    if stereo then writemixer($0E,readmixer($0E) or $20);
   writedsp($48);
   writedsp(Lo(size-1));
   writedsp(Hi(size-1));
   writedsp($1C);
 end;
end;


procedure startplay(datanum : byte);
var size : word;
begin
 if(play.data[datanum].fclosed) then Exit;
 if play.stopped then begin
   play.blocksize := buffersize shr 1;
   actfile := datanum;
   seek(play.data[datanum].f,play.data[datanum].fdatastart);
   if play.data[datanum].fdatasize < buffersize then begin
     silence(play.p^,buffersize);
   play.data[datanum].fileremain := play.data[datanum].fdatasize;
   if play.data[datanum].fdatasize > play.blocksize then size := play.blocksize else
   size := play.data[datanum].fdatasize;
   read(play.data[datanum].f,play.p,size);
   if play.data[datanum].fdatasize > play.blocksize then
   read(play.data[datanum].f,ptr(seg(play.p^),ofs(play.p^)+play.blocksize),play.data[datanum].fileremain);
   end else begin
   play.data[datanum].fileremain := play.data[datanum].fdatasize;
   read(play.data[datanum].f,play.p,play.blocksize);
   read(play.data[datanum].f,ptr(seg(play.p^),ofs(play.p^)+play.blocksize),play.blocksize);
   end;
   play.paused := false;
   play.callproc := soundplaycaller;
   with play do
   initplay(datanum,p,blocksize shl 1,data[datanum].frequency,data[datanum].stereo,data[datanum].sound16bit);
 end;
end;

procedure stopplay;
begin
 if not play.stopped then begin
   exitplay;
   play.stopped := true;
 end;
end;


procedure setplaypos(datanum : byte;pos : longint);
begin
 seek(play.data[datanum].f,pos);
 play.data[actfile].fileremain := play.data[actfile].fsize-play.data[actfile].fdatastart-pos;
end;

function setmemsize(size : word) : boolean;
begin
 if (size <= 32768)and(size >= 500)and(play.stopped) then begin
   size := size and $FFFC; {must be divideable by four!}
   freemem(play.p,buffersize);
   buffersize := size;
   getmem(play.p,buffersize);
   setmemsize := true;
 end else setmemsize := false;
end;

function openvoc(datanum : byte;filename : string) : boolean;
type
vochdrtype = record
kennstr    : array[1..21] of char;
datastart  : word;
version    : word;
kennung    : word;
unknown2   : array[0..2] of byte;
frequency  : word;
unknown3   : word;
resolution : byte;
channels   : byte;
unknown4   : array[0..7] of byte;
end;
var
vochdr : vochdrtype;
begin
 openvoc          := false;
 if not play.data[datanum].fclosed then closesound(datanum);
 if not blaster.available then exit;

 assign(play.data[datanum].f,filename);
 filemode := 64;
 {$I-}reset(play.data[datanum].f,1);{$I+}

 if (dummy <> 0)and(dummy <> 100) then exit;

 blockread(play.data[datanum].f,vochdr,sizeof(vochdr));
 if vochdr.kennstr <> 'Creative Voice File'#26#26 then begin
   close(play.data[datanum].f);
   exit;
 end;
 play.data[datanum].fdatastart := filepos(play.data[datanum].f);

 byte(play.data[datanum].sound16bit) := vochdr.resolution div 16;
 play.data[datanum].signed           := play.data[datanum].sound16bit;
 byte(play.data[datanum].stereo)     := vochdr.channels div (vochdr.kennung - 7);
 play.data[datanum].frequency        := vochdr.frequency;

 play.data[datanum].fdatasize  := play.data[datanum].fsize - filepos(play.data[datanum].f);
 play.data[datanum].fileremain := play.data[datanum].fdatasize;

 play.data[datanum].fclosed := false;
 openvoc      := true;
end;


function openwav(datanum : byte;filename : string) : boolean;
var
wavehdr  : wavehdrtype;
begin
 openwav                    := false;
 if not play.data[datanum].fclosed then closesound(datanum);
 if not blaster.available then exit;
 assign(play.data[datanum].f,filename);
 filemode := 64;
 {$I-}reset(play.data[datanum].f,1);{$I+}
 dummy := ioresult;
 if (dummy <> 0)and(dummy <> 100) then exit;

 blockread(play.data[datanum].f,wavehdr,sizeof(wavehdr));
 if wavehdr.kennstr <> 'WAVEfmt ' then begin
   close(play.data[datanum].f);
   exit;
 end;
 play.data[datanum].fdatastart := filepos(play.data[datanum].f);
 if wavehdr.formattag <> 1 then exit;{compressed file or unknown sampletype}

 byte(play.data[datanum].sound16bit) := wavehdr.resolution div 16;
 play.data[datanum].signed           := play.data[datanum].sound16bit;
 byte(play.data[datanum].stereo)     := wavehdr.bytespersecnd div
 wavehdr.frequency div succ(byte(play.data[datanum].sound16bit))-1;
 play.data[datanum].frequency        := wavehdr.frequency;

 play.data[datanum].fsize := filesize(play.data[datanum].f);
 play.data[datanum].fdatasize := wavehdr.chunklength;
 play.data[datanum].fileremain := play.data[datanum].fdatasize;

 play.data[datanum].fclosed := false;
 openwav      := true;
end;


function opensound(datanum : byte;s : string) : boolean;
var i : byte;
begin
 for i := 1 to length(s) do s[i] := upcase(s[i]);
 if pos('.VOC',s) <> 0 then opensound := openvoc(datanum,s) else
 opensound := openwav(datanum,s);
end;

procedure closesound(datanum : byte);
begin
 if not blaster.available then exit;
 {$I-}
 if not play.data[datanum].fclosed then close(play.data[datanum].f);
 {$I+}
 dummy := ioresult;
 exitplay;
 play.data[datanum].fclosed := true;
end;

begin
 getmem(play.p,buffersize);
 blaster.available        := false;
 oldexitproc              := ExitProc;
 exitproc                 := @exitblaster;
 play.callproc            := dummycaller;
 play.stopped             := true;
 for dummy := 0 to 9 do
 play.data[dummy].fclosed := true;
 rec.callproc             := dummycaller;
 rec.stopped              := true;
 rec.fclosed              := true;
end.
