[Back to SOUND SWAG index] [Back to Main SWAG index] [Original]
{
Mini FM Organ Using Yamaha OPL-3 Chip
Autodetect Sound Blaster using BLASTER Environment variable
By : Roby Johanes
http://www.geocities.com/SiliconValley/Park/3230
Finished in 1996
Latest update: December 1997 for submission to SWAG
}
Program Sound_Blaster_Mini_FM_Organ;
uses crt,dos;
type
CardType = (SB_1, SB_2, SBPro, SB_16, SBAWE32);
Str4 = string[4];
TSBdata = record
Portno : word;
ctype : CardType;
irq : byte;
dma : byte;
end;
TFMInst = record
modchr, carchr, modlev, carlev,
modatk, caratk, modsus, carsus,
modwav, carwav, feedback : byte;
reserved : array[1..5] of byte;
end;
const
CardName : array [1..5] of string[8] = (
'SB v1.0', 'SB v2.0', 'SB Pro', 'SB 16', 'SB AWE32');
Notefreq : array[1..12] of word = ($16B,$181,$198,$1B0,$1CA,$1E5,
$202,$220,$241,$263,$287,$2AE);
const
waitctr = $400;
FMaddr = $388;
EOI = $20;
PIC = $20;
PICStatus = $21;
Modofs : array[1..9] of byte = (0,1,2,8,9,10,16,17,18);
Carofs : array[1..9] of byte = (3,4,5,11,12,13,19,20,21);
var
SBdata : TSBdata;
c : TSBData;
v : word;
f : tfminst;
s : string;
t : string[3];
Function WordToHex(no : word): Str4;
const
h : array [0..15] of char = '0123456789ABCDEF';
begin
WordToHex:=h[hi(no) shr 4]+h[hi(no) and 15]+h[lo(no) shr 4]+
h[lo(no) and 15];
end;
Function ResetChip(Portno : Word) : Boolean; Assembler;
asm
mov bx,-1
mov dx,[Portno]
add dl,6
mov al,1
out dx,al
mov cx,waitctr
@@1:
loop @@1
dec al
out dx,al
mov cx,waitctr
@@2:
loop @@2
add dl,8
mov cx,waitctr
@@testreadybit:
in al,dx
test al,80h
loopz @@testreadybit
jz @@SBnotpresent
sub dl,4
mov cx,waitctr
@@pollfor0AAh:
in al,dx
cmp al,0AAh
je @@done
loop @@pollfor0AAh
@@SBnotpresent:
xor bx,bx
@@done:
mov ax,bx
end;
Function SBRead: byte; assembler;
asm
mov dx,[SBData.Portno]
add dl,0eH
mov cx,waitctr
@@loopit:
in al,dx
test al,80H
loopz @@loopit
sub dx,4
in al,dx
end;
Procedure SBWrite(Data : byte); assembler;
asm
mov dx,[SBData.Portno]
add dl,0cH
mov cx,waitctr
@@loopit:
in al,dx
test al,80H
loopnz @@loopit
mov al,[Data]
out dx,al
end;
Function GetDSPVersion : Word; assembler;
asm
push 00e1H
call SBwrite
call SBread
mov ah,al
call SBread
end;
Procedure FMwrite(reg, data : byte); assembler;
asm
mov dx,FMaddr
mov al,[reg]
out dx,al
mov cx,6
@@1:
in al,dx
loop @@1
inc dl
mov al,[data]
out dx,al
dec dl
mov cx,35
@@2:
in al,dx
loop @@2
end;
Procedure FMreset;
begin
FMwrite(1,0);
end;
Procedure FMKeyon(channel: byte; freq: word; octave: byte);
begin
FMWrite($A0+channel-1,freq and $FF);
FMWrite($B0+channel-1,(freq shr 8) or (octave shl 2) or $20);
end;
Procedure FMKeyoff(channel: byte);
begin
FMWrite($B0+channel-1,0);
end;
Procedure FMSetVolume(channel, vol: byte);
begin
FMWrite($40+Modofs[channel],vol and $3F);
FMWrite($40+Carofs[channel],vol and $3F);
end;
Procedure FMSetup(channel: byte; FMInst : TFMInst);
var
i, j : byte;
begin
i:=modofs[channel]; j:=carofs[channel];
FMWrite($20+i,FMInst.modchr); FMWrite($20+j,FMInst.carchr);
FMWrite($40+i,FMInst.modlev); FMWrite($40+j,FMInst.carlev);
FMWrite($60+i,FMInst.modatk); FMWrite($60+j,FMInst.caratk);
FMWrite($80+i,FMInst.modsus); FMWrite($80+j,FMInst.carsus);
FMWrite($E0+i,FMInst.modwav); FMWrite($E0+j,FMInst.carwav);
FMWrite($C0+channel-1,FMInst.feedback);
end;
Procedure SBSetcard(CardData : TSBdata);
begin
with SBData do
begin
portno:=CardData.portno;
ctype :=CardData.ctype;
irq :=CardData.irq;
dma :=CardData.dma;
end;
end;
Function AutoDetectIRQ : Byte;
var
i : Integer;
s : string;
j : byte;
begin
for I:=1 to EnvCount do
begin
s:=EnvStr(i);
if copy(s,1,7)='BLASTER' then break;
end;
if copy(s,1,7)<>'BLASTER' then
begin
AutoDetectIRQ:=0;
exit;
end;
j:=pos('I',s);
if j=0 then
begin
j:=pos('i',s);
if j=0 then
begin
AutoDetectIRQ:=0;
exit;
end;
end;
s:=copy(s,j+1,1);
j:=ord(s[1])-48;
AutoDetectIRQ:=j;
end;
Function AutoDetectDMA : Byte;
var
i : Integer;
s : string;
j : byte;
begin
for I:=1 to EnvCount do
begin
s:=EnvStr(i);
if copy(s,1,7)='BLASTER' then break;
end;
if copy(s,1,7)<>'BLASTER' then
begin
AutoDetectDMA:=0;
exit;
end;
j:=pos('D',s);
if j=0 then
begin
j:=pos('d',s);
if j=0 then
begin
AutoDetectDMA:=0;
exit;
end;
end;
s:=copy(s,j+1,1);
j:=ord(s[1])-48;
AutoDetectDMA:=j;
end;
Procedure DetectSB (var CardData : TSBdata); assembler;
asm
{ Port AutoDetect }
mov ax,ds
mov es,ax
mov di,[offset SBData]
mov si,di
mov ax,220h
@@detectionloop:
mov bx,ax
push bx
push ax
call ResetChip
pop bx
cmp ax,-1
je @@success
mov ax,bx
add ax,20h
cmp ax,300h
jb @@detectionloop
xor bx,bx
@@success:
mov ax,bx
cld
stosw
{ Card Type AutoDetect }
call GetDSPVersion
cmp ah,4
jne @@nexts
cmp al,10
jl @@nexts
inc ah
@@nexts:
mov al,ah
cld
stosb
{ IRQ autodetect }
push es
push di
push si
call AutoDetectIRQ
pop si
pop di
pop es
cld
stosb
{ DMA autodetect }
push es
push di
push si
call AutoDetectDMA
pop si
pop di
pop es
cld
stosb
les di,[CardData]
mov cx,5
cld
rep movsb
end;
procedure createbkgr; assembler;
asm
mov ax,0b800h
mov es,ax
xor di,di
mov cx,2000
mov ax,39b1h
cld
rep stosw
mov ah,2
xor bh,bh
xor dx,dx
int 10h
mov ah,1
mov cx,-1
int 10h
end;
procedure writexy(x,y,c : byte; s : string); assembler;
asm
mov ax,0b800h
mov es,ax
mov al,[y]
dec al
xor ah,ah
shl ax,5
mov di,ax
shl ax,1
shl ax,1
add di,ax
mov al,[x]
dec al
xor ah,ah
shl ax,1
add di,ax
xor ch,ch
push ds
lds si,[s]
mov cl,[si]
jcxz @@done
mov ah,[c]
inc si
cld
@@loops:
lodsb
stosw
loop @@loops
@@done:
pop ds
end;
procedure organ;
var
ch : char;
n,o : byte;
begin
repeat
n:=0;
ch:=Upcase(readkey);
FMKeyoff(2);
case ch of
',','A': begin n:=1; o:=2; end;
'W': begin n:=2; o:=2; end;
'.','S': begin n:=3; o:=2; end;
'E': begin n:=4; o:=2; end;
'/','D': begin n:=5; o:=2; end;
'F': begin n:=6; o:=2; end;
'T': begin n:=7; o:=2; end;
'G': begin n:=8; o:=2; end;
'Y': begin n:=9; o:=2; end;
'H': begin n:=10;o:=2; end;
'U': begin n:=11;o:=2; end;
'J': begin n:=12;o:=2; end;
'K': begin n:=1; o:=3; end;
'O': begin n:=2; o:=3; end;
'L': begin n:=3; o:=3; end;
'P': begin n:=4; o:=3; end;
';': begin n:=5; o:=3; end;
#39: begin n:=6; o:=3; end;
#13: begin n:=8; o:=3; end;
'M': begin n:=12;o:=1; end;
'N': begin n:=10;o:=1; end;
'B': begin n:=8; o:=1; end;
'V': begin n:=6; o:=1; end;
'C': begin n:=5; o:=1; end;
'X': begin n:=3; o:=1; end;
'Z': begin n:=1; o:=1; end;
end;
if n>0 then FMKeyon(2,NoteFreq[n],o);
until ch=#27;
end;
procedure DrawOrgan;
begin
textattr:=$0F;
gotoxy(21, 9); write('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
gotoxy(21,10); write('ºÞÛÝ ÞÝ ÞÛÛÞÛÝ ÞÝ ÞÝ ÞÛÛÞÛÝ ÞÝ ÞÛÛ º');
gotoxy(21,11); write('ºÞÛÝ ÞÝ ÞÛÛÞÛÝ ÞÝ ÞÝ ÞÛÛÞÛÝ ÞÝ ÞÛÛ º');
gotoxy(21,12); write('ºÞÛÝ ÞÝ ÞÛÛÞÛÝ ÞÝ ÞÝ ÞÛÛÞÛÝ ÞÝ ÞÛÛ º');
gotoxy(21,13); write('ºÞÛÛÛÞÛÛÛÞÛÛÛÞÛÛÛÞÛÛÛÞÛÛÛÞÛÛÛÞÛÛÛÞÛÛÛÞÛÛÛ º');
gotoxy(21,14); write('ºÞÛÛÛÞÛÛÛÞÛÛÛÞÛÛÛÞÛÛÛÞÛÛÛÞÛÛÛÞÛÛÛÞÛÛÛÞÛÛÛ º');
gotoxy(21,15); write('ºÞÛÛÛÞÛÛÛÞÛÛÛÞÛÛÛÞÛÛÛÞÛÛÛÞÛÛÛÞÛÛÛÞÛÛÛÞÛÛÛ º');
gotoxy(21,16); write('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');
end;
procedure ShowCursor; assembler;
asm
mov ah,1
mov cx,0708h
int 10h
end;
begin
with SBdata do
begin
portno:=$220;
ctype :=sb_16;
irq :=7;
dma :=1;
end;
DetectSB(c);
If c.portno=0 then
begin
writeln('Sound Blaster not present !',#10,#13); halt;
end;
createbkgr;
textattr:=$1E;
fillchar(s,81,' '); s[0]:=#80;
writexy(1,1,$1E,s);
writeln('Sound Blaster present in '+WordToHex(c.portno)+'h'+
' of type '+cardname[ord(c.ctype)]+' with IRQ ',c.irq,' and DMA ',c.dma);
v:=GetDSPversion; textattr:=$1F;
s:=s+t; writexy(1,25, $1E,s);
fillchar(s,81,' '); s[0]:=#80;
str(v shr 8,t);
s:='DSP version '+t+'.';
str(v and $FF,t); s:=s+t;
writexy(1,25, $1E,s);
writexy(64,25,$1E,'By : Roby Johanes');
gotoxy(36,7); writeln('FM Mini Organ'); textattr:=$4E;
gotoxy(36,8); writeln('version 0.007'); textattr:=$2F;
gotoxy(19,17); writeln('Press a key to produce a sound, or Esc to quit');
with f do
begin
modchr:=$41; carchr:=$41; modlev:=$8a; carlev:=$40;
modatk:=$F1; caratk:=$F1; modsus:=$31; carsus:=$33;
modwav:=0; carwav:=0; feedback:=6;
end;
DrawOrgan; FMReset;
FMSetup(2,f); organ;
FMKeyoff(2); FMReset;
textattr:=7; clrscr; ShowCursor;
end.
[Back to SOUND SWAG index] [Back to Main SWAG index] [Original]