const
CMSFreqMap:packed array[0..127] of byte=(
000,003,007,011,015,019,023,027,
031,034,038,041,045,048,051,055,
058,061,064,066,069,072,075,077,
080,083,086,088,091,094,096,099,
102,104,107,109,112,114,116,119,
121,123,125,128,130,132,134,136,
138,141,143,145,147,149,151,153,
155,157,159,161,162,164,166,168,
170,172,174,175,177,179,181,182,
184,186,188,189,191,193,194,196,
197,199,200,202,203,205,206,208,
209,210,212,213,214,216,217,218,
219,221,222,223,225,226,227,228,
229,231,232,233,234,235,236,237,
239,240,241,242,243,244,245,246,
247,249,250,251,252,253,254,255
);
type
tCmsOctaveStore:packed array[0..11] of byte;
var
soundPort:word;
cmsOctaveStore:^tCmsOctaveStore;
procedure cmsReset; assembler;
asm
{ reset all 32 registers }
mov dx,soundPort
mov cx,1
@loopReset:
mov bx,cx
mov cx,$20
xor ax,ax
@loopRegisters:
inc dx
out dx,al
inc al
xchg al,ah
dec dx
out dx,al
xchg al,ah
loop @loopRegisters
{ reset freq registers and enable sound }
inc dx
mov al,$1C
out dx,al
dec dx
mov al,3
out dx,al
mov cx,bx
loop @loopReset
les di,cmsOctaveStore;
mov cx,3
xor ax,ax
rep stosw
end; { cmsReset }
procedure cmsSound(voice,freq,octave,amplitudeLeft,amplitudeRight:byte); assembler;
asm
xor dx,dx
xor ah,ah
mov al,voice
{
octave registers are WRITE ONLY (stupid) so to preserve
other voices octave settings we have to track this ourselves
so let's get ES:DI pointed at the correct offset in our table
ahead of time.
}
mov bx,ax
shr bx,1
les di,cmsOctaveStore
add di,bx
{
BL = voice mod 6 = chip voice
DX = sound card port + (voice div 6)*2
typically $2x0 for chip 1, $2x2 for chip 2
}
mov bx,6
div bx
mov bx,dx { bl now equals chip voice }
mov dx,soundPort
shl ax,1 { deterimine which chip }
add dx,ax
{ set amplitude }
inc dx { set address register }
mov al,bl { amplitudes $00..$05 }
out dx,al
dec dx { set data register }
mov al,amplitudeLeft
mov ah,amplitudeRight
and al,$0F
mov cl,4
shl ah,cl
or al,ah
out dx,al
{ set frequency }
inc dx { set address register }
mov al,bl
or al,$08 { frequencies $08..$0D }
out dx,al
dec dx { set data register }
mov al,freq
out dx,al
{ set octave }
inc dx { set address register }
mov al,bl
shr al,1
or al,$10 { 2 octaves per register $10..$12 }
out dx,al
dec dx { set data register }
mov al,es:[di] { read from our buffer }
mov ah,octave
and ah,$07 { just in case, mask it off }
mov bh,bl
and bh,$01
jnz @voiceOdd
and al,$F8 { voice even, mask out bottom 3 bits }
jmp @outOctave
@voiceOdd:
and al,$8F { voice odd, mask out bits 4..6 }
mov cl,4
shl ah,cl { and slide our octave value over }
@outOctave:
or al,ah { put the two together }
out dx,al { and store on card}
mov es:[di],al { and in buffer }
{ freq enable }
inc dx { set address register }
mov al,$14 { channel on/off $14 bits 0..5 }
out dx,al
dec dx { set data register }
in al,dx
mov ah,$01
mov cl,bl
shl ah,cl
or al,ah
out dx,al
end; { cmsSound }
procedure cmsOutFreq(channel,freq,level:word;);
var
outOctave,
outFreq:word;
begin
if (freq<32) or (freq>7823) or (level=0) then begin
cmsSound(channel,0,0,0,0);
end else begin
outOctave:=4;
outFreq:=freq;
while (outFreq<489) do begin
outFreq:=outFreq*2;
dec(outOctave);
end;
while (outFreq>977) do begin
outFreq:=outFreq div 2;
inc(outOctave);
end;
cmsSound(
channel,
CMSFreqMap[((outFreq-489)*128) div 489],
outOctave,
level,level
);
end;
end;