program SB_tárcsázás;
uses
Crt;
const
NoteLength = 100;
NoteDelay = 50;
LongDelay = 1000;
mfAmpMod = $80;
mfVibrato = $40;
mfShortNote = $20;
mfShorten = $10;
slNo
= $00;
sl15db = $40;
sl3db = $80;
sl6db = $C0;
procedure SetSBReg(Address, Value: Byte); assembler;
asm
MOV DX,0388h
MOV AL,Address
OUT DX,AL
MOV CX,6
@@0:IN AL,DX
LOOP @@0
INC DX
MOV AL,Value
OUT DX,AL
DEC DX
MOV CX,35
@@1:IN AL,DX
LOOP @@1
end;
function GetSBStatus: Byte; assembler;
asm
MOV DX,0388h
IN AL,DX
end;
procedure ResetSB;
var
Adr: Byte;
begin
for Adr := 0 to $F5 do
SetSBReg(Adr, 0);
end;
function OperatorOffset(Channel, Operator: Byte): Byte;
begin
OperatorOffset := Operator * 3 + Channel mod 3 + (Channel div 3) * 8;
end;
procedure SetMiscParam(Channel, Operator, MiscFlag,
FreqvFaktor: Byte);
begin
SetSBReg($20 + OperatorOffset(Channel, Operator), MiscFlag or FreqvFaktor);
end;
procedure SetVolume(Channel, Operator, ScalingLevel, Volume:
Byte);
begin
SetSBReg($40 + OperatorOffset(Channel, Operator), ScalingLevel or Volume);
end;
procedure SetADSR(Channel, Operator, Attack, Decay, Sustain,
Release: Byte);
begin
SetSBReg($60 + OperatorOffset(Channel, Operator), Attack shl 4 or Decay);
SetSBReg($80 + OperatorOffset(Channel, Operator), Sustain shl 4 or Release);
end;
procedure SetFeedback(Channel, Feedback: Byte; Separate:
Boolean);
begin
SetSBReg($C0 + Channel, Feedback shl 1 or Byte(Separate));
end;
procedure PlayNote(Channel, Octave: Byte; Freq: Word);
begin
SetSBReg($A0 + Channel, Lo(Freq));
SetSBReg($B0 + Channel, $20 or Octave shl 2 or Hi(Freq) and 3);
end;
procedure StopNote(Channel, Octave: Byte; Freq: Word);
begin
SetSBReg($A0 + Channel, Lo(Freq));
SetSBReg($B0 + Channel, Octave shl 2 or Hi(Freq) and 3);
end;
function DetectSB: Boolean;
var
Result1, Result2: Byte;
begin
SetSBReg($4, $60);
SetSBReg($4, $80);
Result1 := GetSBStatus;
SetSBReg($2, $FF);
SetSBReg($4, $21);
Delay (10);
Result2 := GetSBStatus;
DetectSB := ((Result1 and $E0) = 0) and ((Result2 and $E0) = $C0);
end;
procedure Dial(const No: string);
const
Tone: array [0..11, 0..1] of Byte = (
(3, 1),
(0, 0),
(0, 1),
(0, 2),
(1, 0),
(1, 1),
(1, 2),
(2, 0),
(2, 1),
(2, 2),
(3, 0),
(3, 2));
LoFreq: array [0..3] of
record
O: Byte;
F: Word;
end = (
(O: 5; F: 457),
(O: 5; F: 505),
(O: 5; F: 558),
(O: 5; F: 617));
HiFreq: array [0..2] of
record
O: Byte;
F: Word;
end = (
(O: 6; F: 396),
(O: 6; F: 438),
(O: 6; F: 484));
var
I, ToneNo: Integer;
begin
SetMiscParam(0, 0, 0, 1);
SetVolume(0, 0, 0, 8);
SetADSR(0, 0, 15, 1, 7, 15);
SetFeedBack(0, 0, True);
SetMiscParam(1, 0, 0, 1);
SetVolume(1, 0, 0, 8);
SetADSR(1, 0, 15, 1, 7, 15);
SetFeedBack(1, 0, True);
SetMiscParam(0, 1, 0, 1);
SetVolume(0, 1, 0, 8);
SetADSR(0, 1, 15, 1, 7, 15);
SetMiscParam(1, 1, 0, 1);
SetVolume(1, 1, 0, 8);
SetADSR(1, 1, 15, 1, 7, 15);
for I := 1 to Length(No) do
begin
if No[I] in ['0'..'9', '*', '#'] then
begin
if No[I] = '*' then
ToneNo := 10
else if No[I] = '#' then
ToneNo := 11
else
ToneNo := Byte(No[I]) - Byte('0');
PlayNote(0, LoFreq[Tone[ToneNo, 0]].O, LoFreq[Tone[ToneNo,
0]].F);
PlayNote(1, HiFreq[Tone[ToneNo, 1]].O, HiFreq[Tone[ToneNo,
1]].F);
Delay(NoteLength);
StopNote(0, LoFreq[Tone[ToneNo, 0]].O, LoFreq[Tone[ToneNo,
0]].F);
StopNote(1, HiFreq[Tone[ToneNo, 1]].O, HiFreq[Tone[ToneNo,
1]].F);
Delay(NoteDelay);
end;
if No[I] = '-' then
Delay(LongDelay);
end;
end;
begin
if not DetectSB then
begin
WriteLn('A program futtatáshoz Adlib vagy kompatibilis hangkártya
szűkséges');
Halt;
end;
Dial('123456789');
end.