[Back to SOUND SWAG index] [Back to Main SWAG index] [Original]
{Danny Swett
This will play upto 44khz on a Sound Blaster
}
{ NOTE : Other units needed are at the end !! }
unit sb_voice;
interface
var
SBstatus:word;
procedure setsb_port(address,int:word);
procedure setsb_speed(hertz:word);
procedure outputsb(buffer:pointer;len:longint);
procedure stopsb;
procedure continuesb;
procedure resetsb;
procedure setsb_speaker(on:boolean);
implementation
uses crt,dos;
var
SBint,SBio:word;
SBhighspeed,SBintset:boolean;
oldint:pointer;
s_low16:word;
s_high4:byte;
s_len:longint;
oldexitproc:pointer;
procedure writesb(a:byte);
begin
while((port[SBio+12] and $80)<>0) do ;
port[SBio+12]:=a;
end;
procedure resetsb;
var
a:byte;
begin
SBstatus:=0;
if(SBio<>0) then
begin
port[SBio+6]:=1;
delay(10);
port[SBio+6]:=0;
delay(10);
if(((port[SBio+14] and $80)<>$80) or (port[SBio+10]<>$aa)) then
SBio:=0;
end;
end;
procedure setsb_speed;
var
a:byte;
begin
if(SBio<>0) then
begin
a:=256-(1000000 div hertz);
writesb($40);
writesb(a);
if(hertz>22050) then
SBhighspeed:=true
else
SBhighspeed:=false;
end;
end;
procedure stopsb;
begin
if(SBio<>0) then
begin
SBstatus:=0;
if(SBhighspeed=false) then
writesb($d0)
else
port[$0a]:=5;
end;
end;
procedure continuesb;
begin
if(SBio<>0) then
begin
SBstatus:=1;
if(SBhighspeed=false) then
writesb($d4)
else
port[$0a]:=1;
end;
end;
procedure setsb_speaker;
begin
if(SBio<>0) then
begin
if(on=true) then
writesb($d1)
else
writesb($d3);
end;
end;
procedure outputcontinue;
var
l:word;
begin
l:=$ffff-s_low16;
if(l>s_len) then
l:=s_len;
port[$0a]:=5;
port[$0c]:=0;
port[$0b]:=$49;
port[$02]:=lo(s_low16);
port[$02]:=hi(s_low16);
port[$83]:=s_high4;
port[$03]:=lo(l);
port[$03]:=hi(l);
port[$0a]:=1;
if(SBhighspeed=false) then
begin
writesb($14);
writesb(lo(l));
writesb(hi(l));
end
else
begin
writesb($48);
writesb(lo(l));
writesb(hi(l));
writesb($91);
end;
s_len:=s_len-l;
s_low16:=0;
s_high4:=s_high4+1;
end;
procedure sbinter; interrupt;
var
a:byte;
begin
a:=port[SBio+14];
if(s_len>0) then
outputcontinue
else
begin
port[$0a]:=5;
SBstatus:=0;
a:=port[SBio+14];
end;
port[$20]:=$20;
end;
procedure setsb_int;
begin
if((SBintset=false) and (SBio<>0) and (SBint<>0)) then
begin
SBintset:=true;
getintvec(8+SBint,oldint);
setintvec(8+SBint,addr(sbinter));
port[$21]:=(port[$21] and ($ff-(1 shl SBint)));
end;
end;
procedure outputsb;
var
l:word;
begin
if((SBstatus=0) and (SBio<>0)) then
begin
s_len:=len-1;
setsb_int;
setsb_speaker(true);
SBstatus:=1;
s_low16:=word(ofs(buffer^)+(seg(buffer^) shl 4));
s_high4:=byte(((ofs(buffer^) shr 4)+seg(buffer^)) shr 12);
l:=$ffff-s_low16;
if(l>s_len) then
l:=s_len;
port[$0a]:=5;
port[$0c]:=0;
port[$0b]:=$49;
port[$02]:=lo(s_low16);
port[$02]:=hi(s_low16);
port[$83]:=s_high4;
port[$03]:=lo(l);
port[$03]:=hi(l);
port[$0a]:=1;
if(SBhighspeed=false) then
begin
writesb($14);
writesb(lo(l));
writesb(hi(l));
end
else
begin
writesb($48);
writesb(lo(l));
writesb(hi(l));
writesb($91);
end;
s_len:=s_len-l;
s_low16:=0;
s_high4:=s_high4+1;
end;
end;
procedure deinitsb; far;
begin
exitproc:=oldexitproc;
if(SBio<>0) then
begin
setsb_speaker(false);
if(SBstatus<>0) then
stopsb;
resetsb;
if(SBintset=true) then
setintvec(8+SBint,oldint);
SBstatus:=0;
end;
end;
procedure setsb_port;
begin
SBstatus:=0;
SBint:=int;
SBio:=address;
resetsb;
if(SBio<>0) then
begin
setsb_speaker(false);
setsb_int;
SBstatus:=1;
writesb($f2);
delay(100);
if(SBstatus<>0) then
begin
deinitsb;
SBio:=0;
writeln('IRQ failed');
end;
end;
end;
begin
oldexitproc:=exitproc;
exitproc:=addr(deinitsb);
SBintset:=false;
SBio:=0;
SBint:=0;
end.
__________
sb_xms.pas
~~~~~~~~~~
{Danny Swett
This will play upto 44khz on a Sound Blaster
Can also play sound that are loaded into XMS memory
}
unit sb_xms;
interface
var
SBstatus:word;
procedure setsb_port(address,int:word);
procedure setsb_speed(hertz:word);
procedure outputsb(buffer:pointer;len:longint);
procedure outputxmssb(buf:word);
procedure stopsb;
procedure continuesb;
procedure resetsb;
procedure setsb_speaker(on:boolean);
implementation
uses crt,dos,xms;
var
SBint,SBio:word;
SBhighspeed,SBintset:boolean;
oldint:pointer;
s_low16:word;
s_high4:byte;
s_len:longint;
oldexitproc:pointer;
procedure writesb(a:byte);
begin
while((port[SBio+12] and $80)<>0) do ;
port[SBio+12]:=a;
end;
procedure resetsb;
var
a:byte;
begin
SBstatus:=0;
if(SBio<>0) then
begin
port[SBio+6]:=1;
delay(10);
port[SBio+6]:=0;
delay(10);
if(((port[SBio+14] and $80)<>$80) or (port[SBio+10]<>$aa)) then
SBio:=0;
end;
end;
procedure setsb_speed;
var
a:byte;
begin
if(SBio<>0) then
begin
a:=256-(1000000 div hertz);
writesb($40);
writesb(a);
if(hertz>22050) then
SBhighspeed:=true
else
SBhighspeed:=false;
end;
end;
procedure stopsb;
begin
if(SBio<>0) then
begin
SBstatus:=0;
if(SBhighspeed=false) then
writesb($d0)
else
port[$0a]:=5;
end;
end;
procedure continuesb;
begin
if(SBio<>0) then
begin
SBstatus:=1;
if(SBhighspeed=false) then
writesb($d4)
else
port[$0a]:=1;
end;
end;
procedure setsb_speaker;
begin
if(SBio<>0) then
begin
if(on=true) then
writesb($d1)
else
writesb($d3);
end;
end;
procedure outputcontinue;
var
l:word;
begin
l:=$ffff-s_low16;
if(l>s_len) then
l:=s_len;
port[$0a]:=5;
port[$0c]:=0;
port[$0b]:=$49;
port[$02]:=lo(s_low16);
port[$02]:=hi(s_low16);
port[$83]:=s_high4;
port[$03]:=lo(l);
port[$03]:=hi(l);
port[$0a]:=1;
if(SBhighspeed=false) then
begin
writesb($14);
writesb(lo(l));
writesb(hi(l));
end
else
begin
writesb($48);
writesb(lo(l));
writesb(hi(l));
writesb($91);
end;
s_len:=s_len-l;
s_low16:=0;
s_high4:=s_high4+1;
end;
procedure sbinter; interrupt;
var
a:byte;
begin
a:=port[SBio+14];
if(s_len>0) then
outputcontinue
else
begin
port[$0a]:=5;
SBstatus:=0;
a:=port[SBio+14];
end;
port[$20]:=$20;
end;
procedure setsb_int;
begin
if((SBintset=false) and (SBio<>0) and (SBint<>0)) then
begin
SBintset:=true;
getintvec(8+SBint,oldint);
setintvec(8+SBint,addr(sbinter));
port[$21]:=(port[$21] and ($ff-(1 shl SBint)));
end;
end;
procedure outputsb;
var
l:word;
begin
if((SBstatus=0) and (SBio<>0)) then
begin
s_len:=len-1;
setsb_int;
setsb_speaker(true);
SBstatus:=1;
s_low16:=word(ofs(buffer^)+(seg(buffer^) shl 4));
s_high4:=byte(((ofs(buffer^) shr 4)+seg(buffer^)) shr 12);
l:=$ffff-s_low16;
if(l>s_len) then
l:=s_len;
port[$0a]:=5;
port[$0c]:=0;
port[$0b]:=$49;
port[$02]:=lo(s_low16);
port[$02]:=hi(s_low16);
port[$83]:=s_high4;
port[$03]:=lo(l);
port[$03]:=hi(l);
port[$0a]:=1;
if(SBhighspeed=false) then
begin
writesb($14);
writesb(lo(l));
writesb(hi(l));
end
else
begin
writesb($48);
writesb(lo(l));
writesb(hi(l));
writesb($91);
end;
s_len:=s_len-l;
s_low16:=0;
s_high4:=s_high4+1;
end;
end;
procedure outputxmssb;
var
l:word;
info:longint;
begin
if((SBstatus=0) and (SBio<>0)) then
begin
info:=xms_getinfo(buf);
s_len:=longint(longint(word(info)) shl 10)-1;
setsb_int;
setsb_speaker(true);
SBstatus:=1;
info:=xms_lock(buf);
xms_unlock(buf);
s_low16:=word(info);
s_high4:=byte(info shr 16);
l:=$ffff-s_low16;
if(l>s_len) then
l:=s_len;
port[$0a]:=5;
port[$0c]:=0;
port[$0b]:=$49;
port[$02]:=lo(s_low16);
port[$02]:=hi(s_low16);
port[$83]:=s_high4;
port[$03]:=lo(l);
port[$03]:=hi(l);
port[$0a]:=1;
if(SBhighspeed=false) then
begin
writesb($14);
writesb(lo(l));
writesb(hi(l));
end
else
begin
writesb($48);
writesb(lo(l));
writesb(hi(l));
writesb($91);
end;
s_len:=s_len-l;
s_low16:=0;
s_high4:=s_high4+1;
end;
end;
procedure deinitsb; far;
begin
exitproc:=oldexitproc;
if(SBio<>0) then
begin
setsb_speaker(false);
if(SBstatus<>0) then
stopsb;
resetsb;
if(SBintset=true) then
setintvec(8+SBint,oldint);
SBstatus:=0;
end;
end;
procedure setsb_port;
begin
SBstatus:=0;
SBint:=int;
SBio:=address;
resetsb;
if(SBio<>0) then
begin
setsb_speaker(false);
setsb_int;
SBstatus:=1;
writesb($f2);
delay(100);
if(SBstatus<>0) then
begin
deinitsb;
SBio:=0;
writeln('IRQ failed');
end;
end;
end;
begin
oldexitproc:=exitproc;
exitproc:=addr(deinitsb);
SBintset:=false;
SBio:=0;
SBint:=0;
end.
_______
xms.pas
~~~~~~~
unit xms;
interface
type
xmsmove_type=record
len:longint;
s_handle:word;
s_offset:longint;
d_handle:word;
d_offset:longint;
end;
xmsmove_ptr=^xmsmove_type;
{ For some unknown purpose, varables of xmsmove_type must be global
and not local varables }
function xms_version:word; {returns version number in BCD style}
function xms_enablea20:word; {Allows direct access to blocks}
function xms_disablea20:word;
function xms_statusa20:word;
function xms_largestfree:longint; {Max amount that can be allocated}
function xms_totalfree:longint; {Total free xms memory}
function xms_getmem(len:longint):word; {returns handle to block allocated}
function xms_freemem(buf:word):word; {frees allocated block}
function xms_movemem(m:xmsmove_ptr):word;{moves data around for you, only even
lengths are allowed}
function xms_lock(buf:word):longint; {returns 32bit address}
function xms_unlock(buf:word):word;
function xms_getinfo(buf:word):longint; {low word is size in kb}
implementation
{$S-}
{$I-}
var
xmm:pointer;
xms_installed:boolean;
function xms_version;
var
c:word;
begin
c:=0;
asm
mov ax,$4300
int $2f
cmp al,80h
jne @nodriver
mov [c],1
@nodriver:
end;
if(c=1) then
begin
asm
mov ax,$4310
int $2f
mov word ptr [xmm],bx
mov bx,es
mov word ptr [xmm+2],bx
xor ah,ah
call dword ptr [xmm]
mov [c],ax
end;
xms_version:=c;
xms_installed:=true;
end
else
xms_version:=0;
end;
function xms_enablea20;
var
c:word;
begin
xms_enablea20:=0;
if(xms_installed) then
begin
asm
mov ah,5
call dword ptr [xmm]
mov [c],ax
end;
xms_enablea20:=c;
end;
end;
function xms_disablea20;
var
c:word;
begin
xms_disablea20:=0;
if(xms_installed) then
begin
asm
mov ah,6
call dword ptr [xmm]
mov [c],ax
end;
xms_disablea20:=c;
end;
end;
function xms_statusa20;
var
c:word;
begin
xms_statusa20:=0;
if(xms_installed) then
begin
asm
mov ah,7
call dword ptr [xmm]
mov [c],ax
end;
xms_statusa20:=c;
end;
end;
function xms_largestfree;
var
c:word;
begin
xms_largestfree:=0;
if(xms_installed) then
begin
asm
mov ah,8
call dword ptr [xmm]
mov [c],ax
end;
xms_largestfree:=longint(c) shl 10;
end;
end;
function xms_totalfree;
var
c:word;
begin
xms_totalfree:=0;
if(xms_installed) then
begin
asm
mov ah,8
call dword ptr [xmm]
mov [c],dx
end;
xms_totalfree:=longint(c) shl 10;
end;
end;
function xms_getmem;
var
c:word;
begin
xms_getmem:=0;
if(xms_installed) then
begin
c:=word((len shr 10)+1);
asm
mov dx,[c]
mov ah,9
call dword ptr [xmm]
mov [c],dx
end;
xms_getmem:=c;
end;
end;
function xms_freemem;
var
c:word;
begin
xms_freemem:=0;
if(xms_installed) then
begin
asm
mov dx,[buf]
mov ah,10
call dword ptr [xmm]
mov [c],ax
end;
xms_freemem:=c;
end;
end;
function xms_movemem;
var
c:word;
begin
xms_movemem:=0;
if(xms_installed) then
begin
asm
push ds
push si
mov bx,word ptr [m+2]
mov si,word ptr [m]
mov ds,bx
mov ah,11
call dword ptr [xmm]
mov [c],ax
pop si
pop ds
end;
xms_movemem:=c;
end;
end;
function xms_lock;
var
c:longint;
begin
xms_lock:=0;
if(xms_installed) then
begin
asm
mov dx,[buf]
mov ah,12
call dword ptr [xmm]
mov word ptr [c],bx
mov word ptr [c+2],dx
end;
xms_lock:=c;
end;
end;
function xms_unlock;
var
c:word;
begin
xms_unlock:=0;
if(xms_installed) then
begin
asm
mov dx,[buf]
mov ah,13
call dword ptr [xmm]
mov [c],ax
end;
xms_unlock:=c;
end;
end;
function xms_getinfo;
var
c:longint;
begin
xms_getinfo:=0;
if(xms_installed) then
begin
asm
mov dx,[buf]
mov ah,14
call dword ptr [xmm]
mov word ptr [c],dx
mov word ptr [c+2],bx
end;
xms_getinfo:=c;
end;
end;
begin
xms_installed:=false;
xms_version;
end.
[Back to SOUND SWAG index] [Back to Main SWAG index] [Original]