[Back to SOUND SWAG index] [Back to Main SWAG index] [Original]

    {
      I got FM-synth code for the PAS (originally for the SB).  Here it is:
    }
    Program fmtest;
    uses
      sbfm, crt;
    const
      instrument: TFMInstrument = (SoundCharacteristic: ($11, $1);
                                   Level: ($8A, $40);
                                   AttackDecay: ($F0, $F0);
                                   SustainRelease: ($FF, $B3);
                                   WaveSelect: ($01, $00);
                                   FeedBack: $00;
                                   Filler: ($06, $00, $00, $00, $00, $00));
      notes: array[0..12] of integer = ($157, $16B, $181, $198, $1B0, $1C1, $1E5,
            $202, $220, $241, $263, $287, $2AE);
    begin
      SbFMReset;
      SbFMSetVoice(0,@instrument);
      SbFMSetVoice(1,@instrument);
      SbFMSetVoice(11,@instrument);
      SbFMSetVoice(12,@instrument);

      SbFMKeyOn(0,notes[0],2);
      delay(250);
      SbFMKeyOn(1,notes[4],3);
      delay(250);
      SbFMKeyOn(1,notes[7],3);
      delay(250);
      SbFMKeyOn(1,notes[12],3);
      delay(1000);

      sbFMKeyOff(0);
      sbFMKeyOff(1);
      sbFMKeyOff(11);
      sbFMKeyOff(12);
      sbFMReset;
    end.

    Unit SbFM;
    interface
    type
      PFMInstrument = ^TFMInstrument;
      TFMInstrument = record
                        SoundCharacteristic:array[0..1] of byte;
                        Level:              array[0..1] of byte;
                        AttackDecay:        array[0..1] of byte;
                        SustainRelease:     array[0..1] of byte;
                        WaveSelect:         array[0..1] of byte;
                        Feedback:           byte;
                        filler:             array[0..5] of byte;
                      end;
    const
      SbIOAddr=$220;
      LeftFmAddress=0;
      RightFmAddress=2;
      FMADDRESS=$08;
    Procedure WriteFM(chip, addr, data: byte);
    Procedure SbFmReset;
    Procedure SbFMKeyOff(voice: integer);
    Procedure SbFMKeyOn(voice, freq, octave: integer);
    Procedure SbFMVoiceVolume(voice, vol: integer);
    procedure sbFMSetVoice(voicenum: integer; Ins: PFMInstrument);
    implementation
    Procedure WriteFM(chip, addr, data: byte);
    var
      ChipAddr:                                integer;
      t:                                        byte;
    begin
      if chip>0 then chipaddr:=SbIOAddr + RightFMAddress else
                   chipaddr:=sbIOAddr + LeftFMAddress;
      chipaddr:=SbIOAddr + FMAddress;
      asm
        push dx
        push ax
        push cx
        mov dx,chipaddr
        mov al,addr
        out dx,al
        in al,dx
        inc dx
        mov al,data
        out dx,al
        dec dx
        mov cx,4
    @L:
        in al,dx
        loop @L
        pop cx
        pop ax
        pop dx
      end;
    end;
    Procedure SbFmReset;
    Begin
      WriteFM(0, 1, 0);
      WriteFM(1, 1, 0);
    end;
    Procedure SbFMKeyOff(voice: integer);
    var
      regnum:                                byte;
      chip:                                        integer;
    begin
      chip:=voice div 11;
      regnum:=$B0 + (voice mod 11);
      WriteFM(chip, regnum, 0);
    end;
    Procedure SbFMKeyOn(voice, freq, octave: integer);
    var
      regnum, t:                                byte;
      chip:                                        integer;
    begin
      chip:=voice div 11;
      regnum:=$A0 + (voice mod 11);
      WriteFM(chip, regnum, freq and $FF);
      regnum:=$B0 + (voice mod 11);
      t:=(freq shr 8) or (octave shl 2) or $20;
      WriteFM(chip, regnum, t);
    end;
    Procedure SbFMVoiceVolume(voice, vol: integer);
    var
      regnum:                                byte;
      chip:                                        integer;
    begin
      chip:=voice div 11;
      regnum:=$40 + (voice mod 11);
      WriteFM(chip, regnum, vol);
    end;
    procedure sbFMSetVoice(voicenum: integer; Ins: PFMInstrument);
    var
      opcellnum:                                byte;
      celloffset, i, chip:                        integer;
    begin
      chip:=voicenum div 11;
      voicenum:=voicenum mod 11;
      celloffset:=(voicenum mod 3) + ((voicenum div 3) shr 3);
      opcellnum:=$20 + celloffset;
      WriteFM(chip, opcellnum, ins^.SoundCharacteristic[0]);
      inc(opcellnum, 3);
      WriteFM(chip, opcellnum, ins^.SoundCharacteristic[1]);
      opcellnum:=$40 + celloffset;
      WriteFM(chip, opcellnum, ins^.level[0]);
      inc(opcellnum, 3);
      WriteFM(chip, opcellnum, ins^.Level[1]);
      opcellnum:=$60 + celloffset;
      WriteFM(chip, opcellnum, ins^.AttackDecay[0]);
      inc(opcellnum, 3);
      WriteFM(chip, opcellnum, ins^.AttackDecay[1]);
      opcellnum:=$80 + celloffset;
      WriteFM(chip, opcellnum, ins^.SustainRelease[0]);
      inc(opcellnum, 3);
      WriteFM(chip, opcellnum, ins^.SustainRelease[1]);
      opcellnum:=$E0 + celloffset;
      WriteFM(chip, opcellnum, ins^.WaveSelect[0]);
      inc(opcellnum, 3);
      WriteFM(chip, opcellnum, ins^.WaveSelect[1]);
      opcellnum:=$C0 + voicenum;
      WriteFM(chip, opcellnum, ins^.feedback);
    end;
    end.

    {
    Message 1 is FMTEST.PAS
    Messages 2+3 are SBFM.PAS
    That's all.  One thing: if you can make this work with more than two
    voices at a time, I'd be interested in improved code.  I think that this
    code uses the AdLib compatibility, which is by no means impressive :-).
    }

[Back to SOUND SWAG index] [Back to Main SWAG index] [Original]