UNIT Adlib;

{***************************************************************************}
{																			}
{		Author:				Kevin A. Lee									}
{																			}
{		Last Amended:		27th May, 1993									}
{																			}
{		Description:		Turbo Pascal V6 Adlib FM routines.       		}
{																			}
{							Low-level interface to the Adlib (or compatible)}
{							FM sound card. All information gleaned from     }
{							Jeffrey	S. Lee's "Programming the Adlib/Sound	}
{							Blaster FM Music Chips". See Lee's document for }
{							further information.                            }
{                                                                           }
{***************************************************************************}

INTERFACE


uses
	Crt;

const
	MIN_REGISTER		= 	$01;
    MAX_REGISTER		= 	$F5;
    ADLIB_FM_ADDRESS    =	$388;		{ Adlib address/status register }
    ADLIB_FM_DATA		=	$389;		{ Adlib data register			}

    { F-Numbers (in octave 4) for the chromatic scale. }
    D4b = $16B;		D4  = $181;		E4b = $198;		E4  = $1B0;
	F4  = $1CA;		G4b = $1E5;		G4  = $202;		A4b = $220;
	A4	= $241;		B4b = $263;		B4	= $287;		C4	= $2AE;

{																			}
{	FM Instrument definition for .SBI files - SoundBlaster instrument.		}
{	These are the important parts - we will skip the header, but since		}
{	I am not sure where it starts and ends I have had to guess.				}
{	However it SEEMS! to work. Each array has two values, one for			}
{	each operator; they corresponf to, in order:							}
{																			}
{		- modulator frequency multiple.										}
{		- modulator frequency level.										}
{		- modulator attack/decay.											}
{		- modulator sustain/release.										}
{		- output waveform distortion.										}
{       - feedback algorithm and strength.									}
{																			}
type
    FMInstrument = record
    	SoundCharacteristic: array[1..2] of byte;
        Level: array[1..2] of byte;
        AttackDecay: array[1..2] of byte;
		SustainRelease: array[1..2] of byte;
        WaveSelect: array[1..2] of byte;
        FeedBack: byte;
	end;


procedure WriteFM(Reg, Value: byte);
{																			}
{	Parameters:			Reg - which FM register to write to.				}
{						Value - value to write.								}
{																			}
{	Description:        writes a value to the specified register and waits	}
{						for the "official" recommended periods.				}


function ReadFM: byte;
{																		 	}
{	Returns:			the value in the status register.					}
{																			}
{	Description:		return a value in the status register.				}


function AdlibExists: boolean;
{																			}
{	Returns:			true if an Adlib compatible sound card is present	}
{						else false.											}
{																			}
{	Description:		determines whether an Adlib (or compatible) sound	}
{						card is present.									}


procedure FMReset;
{																			}
{	Description:		quick and dirty sound card reset (basically zeros	}
{						all registers).										}


procedure FMKeyOff(Voice: byte);
{																			}
{	Parameters:			Voice - which voice to turn off.					}
{																			}
{	Description:		turns off the specified voice.						}


procedure FMKeyOn(Voice: byte; Freq: word; Octave: byte);
{																			}
{	Parameters:			Voice - which voice to turn on.						}
{						Freq - its frequency (note).						}
{						Octave - its octave.								}
{																			}
{	Description:		turns on a voice of specified frequency and octave.	}


procedure FMVoiceVolume(Voice, Vol: byte);
{																			}
{	Parameters:			Voice - which voice to set volume of.				}
{						Vol - new volume value (experiment).				}
{																			}
{	Description:		sets the volume of a voice to the specified value.	}
{						I don't quite understand this bit.					}


procedure FMSetVoice(Voice: byte; var Ins: FMInstrument);
{																			}
{	Parameters:			Voice - which voice to set.							}
{						Ins - instrument to set voice to.					}
{																			}
{	Description:		sets the instrument of a voice.						}


procedure LoadSBI(FileName: string; var Ins: FMInstrument);
{																			}
{	Parameters:			FileName - name of .SBI file.						}
{						Ins - variable to place data in.					}
{																			}
{	Description:		loads a .SBI file into an instrument structure.		}



IMPLEMENTATION


procedure WriteFM(Reg, Value: byte);
var
	i: integer;
    Dummy: byte;
begin
	{ set up the register }
	port[ADLIB_FM_ADDRESS] := reg;
    { wait for 12 cycles }
    for i := 1 to 6 do Dummy := port[ADLIB_FM_ADDRESS];
    { write out the value }
    port[ADLIB_FM_DATA] := value;
    { wait 84 cycles }
    for i := 1 to 35 do Dummy := port[ADLIB_FM_ADDRESS];
end; {WriteFM}



function ReadFM: byte;
begin
	ReadFM := port[ADLIB_FM_ADDRESS];
end; {ReadFM}



function AdlibExists: boolean;
var Stat1, Stat2: byte;
begin
    WriteFM($04, $60);				{ reset both timers		  	}
    WriteFM($04, $60);				{ enable timer interrupts	}
    Stat1 := ReadFM;				{ read status register		}
    WriteFM($02, $FF);
    WriteFM($04, $21);				{ start timer 1				}
    delay(800);
    Stat2 := ReadFM;				{ read status register		}
    WriteFM($04, $60);				{ reset both timers			}
    WriteFM($04, $80);				{ enable both timers		}

    if (((Stat1 and $E0) = 0) and ((Stat2 and $E0) = $C0)) then
    	AdlibExists := true
    else
    	AdlibExists := false;
end; {AdlibExists}



procedure FMReset;
var i: byte;
begin
	for i := MIN_REGISTER to MAX_REGISTER do WriteFM(i, 0);

	{ allow FM chips to control the waveform of each operator }
	WriteFM($01, $20);

	{ set rhythm enabled (6 melodic voices, 5 percussive) }
	WriteFM($BD, $20);
end; {FMReset}



procedure FMKeyOff(Voice: byte);
var RegNum: byte;
begin
    { turn voice off }
    RegNum := $B0 + Voice mod 11;
    WriteFM(RegNum, 0);
end; {FMKeyOff}



procedure FMKeyOn(Voice: byte; Freq: word; Octave: byte);
var RegNum, Tmp: byte;
begin
	{ turn voice on }
    RegNum := $A0 + Voice mod 11;
    WriteFM(RegNum, Freq and $ff);
    RegNum := $B0 + Voice mod 11;
    Tmp := (Freq shr 8) or (Octave shl 2) or $20;
    WriteFM(RegNum, Tmp);
end; {FMKeyOn}



procedure FMVoiceVolume(Voice, Vol: byte);
var RegNum: byte;
begin
    RegNum := $40 + Voice mod 11;
    WriteFM(RegNum, Vol);
end; {FMVoicevolume}



procedure FMSetVoice(Voice: byte; var Ins: FMInstrument);
var OpCellNum, CellOffset, i: byte;
begin
    Voice := Voice mod 11;
    CellOffset := Voice mod 3 + ((Voice div 3) shl 3);

    { set sound characteristic }
    OpCellNum := $20 + CellOffset;
    WriteFM(OpCellNum, Ins.SoundCharacteristic[1]);
    OpCellNum := OpCellNum + 3;
    WriteFM(OpCellNum, Ins.SoundCharacteristic[2]);

    { set level/output }
    OpCellNum := $40 + CellOffset;
    WriteFM(OpCellNum, Ins.Level[1]);
    OpCellNum := OpCellNum + 3;
    WriteFM(OpCellNum, Ins.Level[2]);

    { set Attack/Decay }
    OpCellNum := $60 + CellOffset;
    WriteFM(OpCellNum, Ins.AttackDecay[1]);
    OpCellNum := OpCellNum + 3;
    WriteFM(OpCellNum, Ins.AttackDecay[2]);

    { set Sustain/Release }
    OpCellNum := $80 + CellOffset;
    WriteFM(OpCellNum, Ins.SustainRelease[1]);
    OpCellNum := OpCellNum + 3;
    WriteFM(OpCellNum, Ins.SustainRelease[2]);

    { set Wave Select }
    OpCellNum := $E0 + CellOffset;
    WriteFM(OpCellNum, Ins.WaveSelect[1]);
    OpCellNum := OpCellNum + 3;
    WriteFM(OpCellNum, Ins.WaveSelect[2]);

    { set Feedback/Selectivity }
    OpCellNum := $C0 + Voice;
    WriteFM(OpCellNum, Ins.Feedback);
end; {FMSetVoice}



procedure LoadSBI(FileName: string; var Ins: FMInstrument);
var
	f: file;
    Dummy: array[1..36] of byte;
    i: byte;
    NumRead: word;
begin
	assign(f, fileName);
  	{$I-} reset(f, 1); {$I+}
    if (IOResult <> 0) then
    begin
    	{ ErrFileNotFound }
        exit;
    end;

	{ skip the header - or do we? }
    BlockRead(f, Dummy, 36, NumRead);

	{ read the instrument data }
    BlockRead(f, Ins, sizeof(FMInstrument), NumRead);

	close(f);
end; {LoadSBI}



begin
end.