{ ********************************************************************** }
{                                                                        }
{ COPYRIGHT AND DISCLAIMER                                               }
{ ------------------------                                               }
{                                                                        }
{ Copyright (c) 1997 Iacopo Giangrandi,                                  }
{ All rights reserved.                                                   }
{                                                                        }
{ Redistribution and use in source and binary forms, with or without     }
{ modification, are permitted provided that the following conditions     }
{ are met: 1. Redistributions of source code must retain the above       }
{ copyright notice, this list of conditions and the following            }
{ disclaimer. 2. Redistributions in binary form must reproduce the       }
{ above copyright notice, this list of conditions and the following      }
{ disclaimer in the documentation and/or other materials provided        }
{ with the distribution. 3. All advertising materials mentioning         }
{ features or use of this software must display the following            }
{ acknowledgment: "This product includes software developed by           }
{ Iacopo Giangrandi". 4. The name of the author (Iacopo Giangrandi)      }
{ may not be used to endorse or promote products derived from this       }
{ software without specific prior written permission.                    }
{                                                                        }
{ THIS SOFTWARE IS PROVIDED BY THE AUTHOR (IACOPO GIANGRANDI) "AS IS"    }
{ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT              }
{ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND              }
{ FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.                       }
{ IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,       }
{ INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,   }
{ BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;       }
{ LOSS OF USE, DATA, OR PROFITS, OR BUSINESS INTERRUPTION) HOWEVER       }
{ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT     }
{ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN      }
{ ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE        }
{ POSSIBILITY OF SUCH DAMAGE.                                            }
{                                                                        }
{ ********************************************************************** }

Unit AdLibSnd;

Interface

Const
  CardInstalled : Boolean = False; { True if a soundcard is found. }



Procedure SetChannel(Channel : Byte);
{ Prepares the specified channel to produce a "beep" using all procedures }
{ below. }

Procedure PlayNote(Channel, Octave : Byte; Freq : Word);
{ Starts playing the note given by Octave and Freq. Frequency is less then }
{ 1024, and is multiplied by Octave that is in 0..7 (4 multiplies by 1). }

Procedure StopNote(Channel : Byte);
{ Stops playing the specified channel. }



Procedure ResetSB;
{ Resets all registers of the FM chip. }



Procedure SetMiscParam(Channel, Operator, MiscFlag, FreqFactor : Byte);
{ Sets miscellaneous flags and parameters for the specified channel and   }
{ operator. The frequency factor (0..15) indicates which harmonic of the  }
{ operator will produce sound (or modulation); 1 for the specified        }
{ frequency. The flags are 4 (bit 3..0) and are (in the same order):      }
{ amplitude modulation, vibrato, sustain and scaling. }

Procedure SetVolume(Channel, Operator, ScalingLevel, Volume : Byte);
{ Sets scaling level (attenuation in function of the frequency) and the  }
{ volume for the specified channel and operator. ScalingLevel is a value }
{ in 0..3 and means 0, -1.5, -3, -6 dB/oct. Volume is in 0..$3F (0 the   }
{ softest and 63 the lodest). }

Procedure SetADSR(Channel, Operator, Attack, Decay, Sustain, Release : Byte);
{ Sets attack, decay, sustain and release rates. All values are in 0..15; }
{ 0 is the fastest, 15 the slowest (for the sustain 0 is the loudest and  }
{ 15 the softest). }

Procedure SetWaveForm(Channel, Operator, Wave : Byte);
{ Sets the wave form: 0 for a sine wave, 1 for a half redressed sine wave, }
{ 2 for a full redressed sine wave and 3 for a full redressed first half   }
{ peak only sine wave. }

Procedure SetFeedback(Channel, Feedback : Byte; Separate : Boolean);
{ Sets feedback 0..7, 0 being no feedback, 7 the most. Also sets whether }
{ operator 0 modulates operator 1 or they produce sound individually. }



Implementation

Uses
 Crt;


Procedure SetSBReg(Address, Value : Byte); Assembler;
{ Sets the specified FM register. }
Asm
      mov   dx,0388h
      mov   al,Address
      out   dx,al
      mov   cx,0006h
@@0:  in    al,dx
      loop  @@0
      inc   dx
      mov   al,Value
      out   dx,al
      dec   dx
      mov   cx,0035
@@1:  in    al,dx
      loop  @@1
End;



Function GetSBStatus : Byte; Assembler;
{ Reads then FM status register. }
Asm
      mov   dx,0388h
      in    al,dx
End;



Procedure ResetSB;
{ Resets all registers of the FM chip. }
Var
  Adr : Byte;
Begin
For Adr := 0 To $F5 Do
  SetSBReg(Adr,0);
End;



Function DetectSB : Boolean;
{ Detect if FM-chips is present (only on AdLibs or SoundBlasters). }
Var
  Result1, Result2 : Byte;
Begin
SetSBReg($04,$60);
SetSBReg($04,$80);
Result1 := GetSBStatus;
SetSBReg($02,$FF);
SetSBReg($04,$21);
Delay(10);
Result2 := GetSBStatus;
DetectSB := ((Result1 And $E0) = $00) And ((Result2 And $E0) = $C0);
End;



Function OperatorOffset(Channel, Operator : Byte) : Byte;
{ Calculates offset of the control byte for the given channel (from 0 to 8) }
{ and the given operator (0 or 1). }
Begin
OperatorOffset := Operator * 3 + Channel Mod 3 + (Channel Div 3) * 8;
End;



Procedure SetMiscParam(Channel, Operator, MiscFlag, FreqFactor : Byte);
{ Sets miscellaneous flags and parameters for the specified channel and   }
{ operator. The frequency factor (0..15) indicates which harmonic of the  }
{ operator will produce sound (or modulation); 1 for the specified        }
{ frequency. The flags are 4 (bit 3..0) and are (in the same order):      }
{ amplitude modulation, vibrato, sustain and scaling. }
Begin
SetSBReg($20 + OperatorOffset(Channel, Operator), (MiscFlag ShL 4) Or
         (FreqFactor And $0F));
End;



Procedure SetVolume(Channel, Operator, ScalingLevel, Volume : Byte);
{ Sets scaling level (attenuation in function of the frequency) and the  }
{ volume for the specified channel and operator. ScalingLevel is a value }
{ in 0..3 and means 0, -1.5, -3, -6 dB/oct. Volume is in 0..$3F (0 the   }
{ softest and 63 the lodest). }
Begin
SetSBReg($40 + OperatorOffset(Channel, Operator), (ScalingLevel ShL 6) Or
         ((Not Volume) And $3F));
End;



Procedure SetADSR(Channel, Operator, Attack, Decay, Sustain, Release : Byte);
{ Sets attack, decay, sustain and release rates. All values are in 0..15; }
{ 0 is the fastest, 15 the slowest (for the sustain 0 is the loudest and  }
{ 15 the softest). }
Begin
SetSBReg($60 + OperatorOffset(Channel, Operator), Attack Shl 4 Or
         (Decay And $0F));
SetSBReg($80 + OperatorOffset(Channel, Operator), Sustain Shl 4 Or
         (Release And $0F));
End;



Procedure SetFeedback(Channel, Feedback : Byte; Separate : Boolean);
{ Sets feedback 0..7, 0 being no feedback, 7 the most. Also sets whether }
{ operator 0 modulates operator 1 or they produce sound individually. }
Begin
SetSBReg($C0 + Channel, Feedback Shl 1 Or Byte(Separate));
End;



Procedure SetWaveForm(Channel, Operator, Wave : Byte);
{ Sets the wave form: 0 for a sine wave, 1 for a half redressed sine wave, }
{ 2 for a full redressed sine wave and 3 for a full redressed first half   }
{ peak only sine wave. }
Begin
SetSBReg($E0 + OperatorOffset(Channel, Operator), Wave And $03);
End;



Procedure PlayNote(Channel, Octave : Byte; Freq : Word);
{ Starts playing the note given by Octave and Freq. Frequency is less then }
{ 1024, and is multiplied by Octave that is in 0..7 (4 multiplies by 1). }
Begin
SetSBReg($A0 + Channel, Lo(Freq));
SetSBReg($B0 + Channel, $20 Or (Octave And 7) ShL 2 Or Hi(Freq) And 3);
End;



Procedure StopNote(Channel : Byte);
{ Stops playing the specified channel. }
Begin
SetSBReg($B0 + Channel, 0);
End;



Procedure SetChannel(Channel : Byte);
{ Prepares the specified channel to produce a "beep". }
Begin
{ Set operator 0 }
SetMiscParam(Channel,0,0,1);
SetVolume(Channel,0,0,63);
SetADSR(Channel,0,15,1,7,7);
SetFeedBack(Channel,0,True);
{ Set operator 1 }
SetMiscParam(Channel,1,0,1);
SetVolume(Channel,1,0,63);
SetADSR(Channel,1,15,1,7,7);
End;



Begin
CardInstalled := DetectSB; { Detect the soundcard. }
ResetSB;                   { And reset it. }
End.