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.