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

    unit FM;

    {Version 1.0

    Copyright 1996 Jack Neely

    This unit was written by Jack Neely using Borland's Turbo
    Pascal 7.0.  You may contact me for any reason using the
    e-mail address hneely@ac.net

    This unit takes advantage of the FM sound abilities of the
    Adlib/Sound Blaster and compatible sound cards.  All the
    procedures below should be self explanatory to those who
    know a little of creating FM sound.  Documentation to help
    you understand FM sound and that I used in writing this unit
    can be found on my Pascal page at

    http://www.ac.net/~hneely/pascal/

    The rhythm parts of FM sound I do not fully understand.  They
    are supported in this unit but un-tested.  Any pointers on how
    to uses these would be welcome.  If you find any bugs please
    let me know.  Bugs that I can confirm will be corrected
    and a new version of this unit will become available.

    I ask that you do not change this unit without my permission.
    All improvements I want to make so that I can make a new version
    of this unit available as I said before.

    I would like to give note to Jeffery S. Lee.  Without his
    documentation of the OPL2 chip I would not have been able to
    write this.  His documentation is available on my Pascal Page.
    I would also like to thank R. E. Donais for pointing out my
    stupid mistakes and for a bit of wisdom.

    I hope you enjoy this unit and that it satisfies your FM
    programming needs.  Please contact me and tell me what you
    think!

    Jack Neely
    hneely@ac.net
    http://www.ac.net/~hneely/                                   }

    interface

    const
       {  Note constants.  "s" implies a sharp.  Use for the PITCH parameter
       in the KEY_ON procedure.}
       Cs = $16B; Db = $16B;
       D =  $181;
       Ds = $198; Eb = $198;
       E =  $1B0;
       F =  $1CA;
       Fs = $1E5; Gb = $1E5;
       A =  $241;
       As = $263; Bb = $263;
       B = $287;
       C = $2AE;
       {  Offset array.  Offsets[operator, channel]  This is to be used for
          the offsets in the procedures below.  It calculates the correct
          channel and operator.}
       Offsets : array[1..2, 1..9] of word =
          (($00, $01, $02, $08, $09, $0A, $10, $11, $12),
           ($03, $04, $05, $0B, $0C, $0D, $13, $14, $15));
       {Main IO ports for Adlib/Sound Blaster}
       IOPort = $388;
       IODataPort = $389;

    type
       FMregisters = array[1..244] of byte;

    var
       IsSound:boolean;             {True if sound card detected else false.}
       FMdata:FMregisters;           {Contains the data in the FM registers.}
          {You cannot set the registers by changing the values in this array
           directly, you must call the apporpiate procedure.  This only stores
           the data curently in the registers sence they are write only.}

    procedure Out(p:word; reg:byte; value:byte);
       {Procedure Out sends VALUE to REG (register) using ports P and P + 1}
    procedure resetFM;
       {Resets the sound card by writing 0 to all registers.}
    procedure setvibrato(offset:word; bit, vd:boolean);
       {Changes the vibrato bit to the value of BIT. If VD is true the vibrato
       is set at 14 cent else 7 cent.  If BIT is false, VD is a dummy.  OFFSET
       controls channel and operator.}
    procedure amplitude_modulation(offset:word; bit, AMd:boolean);
       {Applies amplitued modulation when BIT is true.  When AMD is true depth
       is 4.8dB else 1 dB.  If BIT is false AMD is a dummy.  OFFSET controls
       channel and operator.}
    procedure setsustain(offset:word; bit:boolean);
       {When BIT is true the sustain level is maintained until released, else
       the sound begins to decay after susatin phase is hit.}
    procedure set_harmonic_op(offset:word; value:byte);
       {VALUE controls what harmonic multiple sound (or modulation) will be
       produced.
                          0 - one octave below
                          1 - at the voice's specified frequency
                          2 - one octave above
                          3 - an octave and a fifth above
                          4 - two octaves above
                          5 - two octaves and a major third above
                          6 - two octaves and a fifth above
                          7 - two octaves and a minor seventh above
                          8 - three octaves above
                          9 - three octaves and a major second above
                          A - three octaves and a major third above
                          B -  "       "     "  "   "     "     "
                          C - three octaves and a fifth above
                          D -   "      "     "  "   "     "
                          E - three octaves and a major seventh above
                          F -   "      "     "  "   "      "      "  }
    procedure setvolume(offset:word; value:byte);
       {BYTE must be in the range of [0..63] (decimal).  0 is loudest 63
       is softest.}
    procedure attackrate(offset:word; value:byte);
       {VALUE must be in rang of [0..F] (hex).  0 is slowest, F is shortest.}
    procedure decayrate(offset:word; value:byte);
       {Same as attackrate.}
    procedure sustain_level(offset:word; value:byte);
       {VALUE must be in rang of [0..F] (hex). 0 is loudest, F is softest.}
    procedure release_rate(offset:word; value:byte);
       {VALUE must be in rang of [0..F] (hex). 0 is slowest, F is fastest.}
    procedure waveform(offset:word; value:byte);
       {Changes waveform.  Diagram below.  Numbers are in binary.
             ___              ___            ___    ___       _      _
            /   \            /   \          /   \  /   \     / |    / |
           /_____\_______   /_____\_____   /_____\/_____\   /__|___/__|___
                  \     /
                   \___/

                00              01               10               11
        }
    procedure scalling_rate(offset:word; value:byte);
       {Causes output level to decrease as frequency rises. Numbers are in binary.
                              00   -  no change
                              10   -  1.5 dB/8ve
                              01   -  3 dB/8ve
                              11   -  6 dB/8ve
       }
    procedure feedback(channel:word; value:byte);
       {Feedback strength.  Value must be in the range [1..7].  0 is the
       least ad 7 is the greatest.  CHANNLE is the channel affected.}
    procedure connection(channel:word; value:boolean);
       {If FALSE operator 1 modulates operator 2, therefore operator 2 is the
       only one producing sound.  If TRUE both operators produce sound
       directly.  Create complex sounds by setting to FALSE.  CHANNEL is the
       channel affected.}
    procedure key_on(channel:word; octave:byte; pitch:word);
       {Sounds note.  OCTAVE is [0..7] where 4 contains middle C.  Pitch
       is a note constant defined above.  CHANNEL is the channel to sound
       note on.}
    procedure key_off(channel:word);
       {Truns note off.}
    procedure rhythm(value:boolean);
       {If VALUE true then rhythm is enabled, else disenabled.  When enabled,
       KEY-ON bits for channels 6 - 8 must be off.  6 melodic voices.  Other
       parameters such as attack/decay/sustain/release must be set appropriately.
       When disenabled, 9 melodic voices.}
    procedure bass_drum(value:boolean);
       {Bass drum on/off.}
    procedure Snare_drum(value:boolean);
       {Snare on/off}
    procedure Tom_tom(value:boolean);
       {Tom tom on/off}
    procedure cymbal(value:boolean);
       {Cymbal on/off}
    procedure Hi_Hat(value:boolean);
       {Hi hat on/off}

    implementation  {Documentation ENDS here.}

    PROCEDURE MyDelay(Clocks: Longint);
    VAR
       Elapsed: Longint;
       Last, Next, NCopy, Diff: Word;
    BEGIN
       Elapsed := 0;
       Port[$43] := 0;
       Last := Port[$40];
       Last := NOT((Port[$40] shl 8) + Last);
       REPEAT
          Port[$43] := 0;
          Next := Port[$40];
          Next := NOT((Port[$40] shl 8) + Next);
          NCopy := Next;
          Dec(Next, Last);
          Inc(Elapsed, Next);
          Last := NCopy;
       UNTIL Elapsed >= Clocks;
    END;

    procedure out(p:word; reg:byte; value:byte);
    begin
       port[p]:= reg;
       mydelay(8);
       port[p+1]:= value;
       mydelay(55);
    end;

    procedure detect(var sound:boolean);
    var
       store1, store2:byte;
    begin
       out(IOport, 4, $60);
       out(ioport, 4, $80);
       store1:= port[$388];
       out(ioport, 2, $FF);
       out(ioport, 4, $21);
       mydelay(191);
       store2:= port[$388];
       out(ioport, 4, $60);
       out(ioport, 4, $80);
       sound:= ((store1 and $E0 = 0) and (store2 and $E0 = $C0));
    end;

    procedure setbit(var b:byte; bit:integer; value:boolean);
    var
       c:byte;
    begin
       c:= 1;
       if value then
          b:= b or (c shl bit)
       else
          b:= b and not(c shl bit);
    end;

    procedure resetFM;
    var
       i:integer;
    begin
       for i:= 1 to 244 do
          begin
             out(IOport, i, 0);
             FMdata[i]:= 0;
          end;
       setbit(FMdata[1], 5, true);
       out(IOport, 1, FMdata[1]);
    end;

    procedure setvibrato(offset:word; bit, vd:boolean);
    begin
       setbit(FMdata[offset+$20], 6, bit);
       setbit(FMdata[$BD], 6, vd);
       out(ioport, offset+$20, FMdata[offset+$20]);
       out(ioport, $BD, FMdata[$BD]);
    end;

    procedure amplitude_modulation(offset:word; bit, amd:boolean);
    begin
       setbit(FMdata[offset+$20], 7, bit);
       setbit(FMdata[$BD], 7, amd);
       out(ioport, offset+$20, FMdata[offset+$20]);
       out(ioport, $BD, FMdata[$BD]);
    end;

    procedure setsustain(offset:word; bit:boolean);
    begin
       setbit(FMdata[offset+$20], 5, bit);
       out(ioport, offset+$20, FMdata[offset+$20]);
    end;

    procedure set_harmonic_op(offset:word; value:byte);
    begin
       FMdata[offset+$20]:= FMdata[offset+$20] and 240;
       FMdata[offset+$20]:= FMdata[offset+$20] + value;
       out(ioport, offset+$20, FMdata[offset+$20]);
    end;

    procedure setvolume(offset:word; value:byte);
    begin
       FMdata[offset+$40]:= FMdata[offset+$40] and 192;
       FMdata[offset+$40]:= FMdata[offset+$40] + value;
       out(ioport, offset+$40, FMdata[offset+$40]);
    end;

    procedure attackrate(offset:word; value:byte);
    var
       temp:byte;
    begin
       temp:= FMdata[offset+$60] and 15;
       FMdata[offset+$60]:= (value shl 4) + temp;
       out(ioport, offset+$60, FMdata[offset+$60]);
    end;

    procedure decayrate(offset:word; value:byte);
    begin
       FMdata[offset+$60]:= (FMdata[offset+$60] and 240) + value;
       out(ioport, offset+$60, FMdata[offset+$60]);
    end;

    procedure sustain_level(offset:word; value:byte);
    var
       temp:byte;
    begin
       temp:= FMdata[offset+$80] and 15;
       FMdata[offset+$80]:= (value shl 4) + temp;
       out(ioport, offset+$80, FMdata[offset+$80]);
    end;

    procedure release_rate(offset:word; value:byte);
    begin
       FMdata[offset+$80]:= (FMdata[offset+$80] and 240) + value;
       out(ioport, offset+$80, FMdata[offset+$80]);
    end;

    procedure waveform(offset:word; value:byte);
    begin
       FMdata[offset+$E0]:= value;
       out(ioport, offset+$E0, FMdata[offset+$E0]);
    end;

    procedure scalling_rate(offset:word; value:byte);
    var
       temp:byte;
    begin
       temp:= FMdata[offset+$40] and 63;
       FMdata[offset+$40]:= (value shl 6) + temp;
       out(ioport, offset+$40, FMdata[offset+$40]);
    end;

    procedure feedback(channel:word; value:byte);
    begin
       channel:= channel - 1;
       FMdata[channel+$C0]:= (FMdata[channel+$C0] and 241) + (value shl 1);
       out(ioport, channel+$C0, FMdata[channel+$C0]);
    end;

    procedure connection(channel:word; value:boolean);
    begin
       channel:= channel - 1;
       setbit(FMdata[channel+$C0], 0, value);
       out(ioport, channel+$C0, FMdata[channel+$C0]);
    end;

    procedure key_on(channel:word; octave:byte; pitch:word);
    var
       highpitch,
       lowpitch:byte;
    begin
       lowpitch:= pitch and $00FF;
       highpitch:= (pitch and $FF00) shr 8;
       channel:= channel - 1;
       FMdata[channel+$B0]:= (octave shl 2) + highpitch;
       FMdata[channel+$A0]:= lowpitch;
       setbit(FMdata[channel+$B0], 5, true);
       out(ioport, channel+$A0, FMdata[channel+$A0]);
       out(ioport, channel+$B0, FMdata[channel+$B0]);
    end;

    procedure key_off(channel:word);
    begin
       channel:= channel - 1;
       setbit(FMdata[channel+$B0], 5, false);
       out(ioport, channel+$B0, FMdata[channel+$B0]);
    end;

    procedure rhythm(value:boolean);
    begin
       setbit(FMdata[$BD], 5, value);
       out(ioport, $BD, FMdata[$BD]);
    end;

    procedure bass_drum(value:boolean);
    begin
       setbit(FMdata[$BD], 4, value);
       out(ioport, $BD, FMdata[$BD]);
    end;

    procedure snare_drum(value:boolean);
    begin
       setbit(FMdata[$BD], 3, value);
       out(ioport, $BD, FMdata[$BD]);
    end;

    procedure Tom_tom(value:boolean);
    begin
       setbit(FMdata[$BD], 2, value);
       out(ioport, $BD, FMdata[$BD]);
    end;

    procedure cymbal(value:boolean);
    begin
       setbit(FMdata[$BD], 1, value);
       out(ioport, $BD, FMdata[$BD]);
    end;

    procedure Hi_hat(value:boolean);
    begin
       setbit(FMdata[$BD], 0, value);
       out(ioport, $BD, FMdata[$BD]);
    end;

    {initialization}
    begin
       detect(IsSound);
       if IsSound then
          resetFM;
    end.

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