1060 lines
33 KiB
ObjectPascal
1060 lines
33 KiB
ObjectPascal
{****************************************************************************
|
||
** Background MIDI unit **
|
||
** by Steven H Don **
|
||
** Personalitzada per ICEKAS per al Final Tech **
|
||
*****************************************************************************
|
||
** The file FM.DAT is necessary to play through Sound Blaster/compatible **
|
||
*****************************************************************************
|
||
** Unit for playing MIDI files in the background through either an FM **
|
||
** sound card, such as the Sound Blaster (any version) or a General MIDI **
|
||
** device, such as the Roland cards or a Gravis UltraSound using MegaEM. **
|
||
** It does not implement all of the MIDI effects and asynchronous files **
|
||
** are not supported. It works with most files I have, however. As you can **
|
||
** see from the size of the file, as well as the complexity of the code, **
|
||
** MIDI is no easy stuff. This file should be useful though. **
|
||
** **
|
||
** For questions, feel free to e-mail me. **
|
||
** **
|
||
** shd@earthling.net **
|
||
** http://shd.cjb.net **
|
||
** **
|
||
** Arranged by The JailDoctor. **
|
||
** **
|
||
** Now General Midi initializes by itself & other fixes. **
|
||
** **
|
||
** e-mail me if you vols to jaildoctor@jazzfree.com **
|
||
** **
|
||
*****************************************************************************}
|
||
unit musica;
|
||
|
||
interface
|
||
|
||
{
|
||
Functions available to the calling program are:
|
||
LoadMIDI : loads the MIDI file into memory.
|
||
Expects a filename including .MID extension
|
||
Returns TRUE if successful
|
||
UnloadMIDI : unloads the MIDI file and fress the memory.
|
||
PlayMIDI : starts MIDI playback
|
||
StopMIDI : stops MIDI playback
|
||
SetGM : sets the playback device to General MIDI.
|
||
SetFM : sets the playback device to the FM synthesizer
|
||
SetVol : sets the playback volume, from 0..255
|
||
Playing : returns FALSE when the MIDI file has ended
|
||
}
|
||
|
||
var
|
||
{ cont‚ el arxiu que ha de tocar-se }
|
||
midi : string[12];
|
||
{ Midi ON / OFF }
|
||
midiOK : boolean;
|
||
{ midi en memoria }
|
||
midiMEM : boolean;
|
||
|
||
procedure IniMidi;
|
||
{ Funci¢: Prepara el General Midi }
|
||
procedure StartMidi(nom : string);
|
||
{ Funci¢: comen‡a a tocar un midi }
|
||
procedure KeepMidi;
|
||
{ Funci¢: Mantin el midi en marxa }
|
||
procedure EndMidi;
|
||
{ Funci¢: Allibera la memoria del midi }
|
||
|
||
function LoadMidi (FileName : String) : Boolean;
|
||
procedure UnloadMIDI;
|
||
procedure PlayMIDI;
|
||
procedure StopMIDI;
|
||
procedure SetVol (NewVol : Byte);
|
||
function SetFM : Boolean;
|
||
function SetGM : Boolean;
|
||
function Playing : Boolean;
|
||
|
||
implementation
|
||
|
||
uses DOS, Crt;
|
||
|
||
const
|
||
{At compile time, allow for 64 tracks, increase if necessary (this requires
|
||
more memory)}
|
||
MaxTracks = 64;
|
||
{Used to distinguish between General MIDI devices and FM synthesizers}
|
||
None = 0; FM = 1; GM = 2;
|
||
{Used to activate tremolo and vibrato amplification}
|
||
AM = 1; VIB = 0; ByteBD : Byte = AM shl 7 or VIB shl 6 or $20;
|
||
|
||
type
|
||
{Almost 64K of memory to hold the data for each individual track}
|
||
SixtyFour = Array [0..65534] of Byte;
|
||
|
||
{The MIDI File's header}
|
||
FileHeaderType = record
|
||
MTHd : LongInt; {6468544Dh = "MTHd"}
|
||
HeaderSize : LongInt;
|
||
FileFormat, NumberOfTracks, TicksPerQNote : Word;
|
||
end;
|
||
|
||
{The header of a track}
|
||
TrackHeaderType = record
|
||
MTrk : LongInt; {6468544Dh = "MTrd"}
|
||
TrackSize : LongInt;
|
||
end;
|
||
|
||
{Variables for reading the MIDI file}
|
||
var
|
||
|
||
{How many tracks are there in the file}
|
||
NumberOfTracks : Byte;
|
||
{This is used to determine whether a track needs attention}
|
||
WaitingFor : Array [1..MaxTracks] of LongInt;
|
||
{Stores the actual MIDI data}
|
||
TrackData : Array [1..MaxTracks] of ^SixtyFour;
|
||
{Stores the byte length of each track}
|
||
TrackSize : Array [1..MaxTracks] of Word;
|
||
{Which byte is to be read next}
|
||
NextBytePtr : Array [1..MaxTracks] of Word;
|
||
{Stores the last MIDI command sent, this is necessary for "running" mode}
|
||
LastCommand : Array [1..MaxTracks] of Byte;
|
||
|
||
{This stores a pointer to the original timer handler}
|
||
BIOSTimerHandler : procedure;
|
||
{This is used for counting the clock ticks}
|
||
TicksPerQNote : LongInt;
|
||
ClockTicks, TickCounter, MIDICounter : LongInt;
|
||
{This is used in case Windows is active}
|
||
WinTick : LongInt;
|
||
Windows : Boolean;
|
||
|
||
{Variables and constants necessary for playing the MIDI file through an FM
|
||
based sound card such as Sound Blaster}
|
||
const
|
||
{Addresses of the operators used to form voice data}
|
||
OpAdr : Array [0..8] of Byte = (0, 1, 2, 8, 9, 10, 16, 17, 18);
|
||
{F numbers - to form a specific note}
|
||
FNr : Array [0..127] of Word = (86,91,96,102,108,114,121,128,136,144,
|
||
153,162,172,182,192,204,108,114,121,
|
||
128,136,144,153,162,172,182,192,204,
|
||
216,229,242,257,136,144,153,162,172,
|
||
182,192,204,216,229,242,257,272,288,
|
||
306,324,172,182,192,204,216,229,242,
|
||
257,272,288,306,324,343,363,385,408,
|
||
216,229,242,257,272,288,306,324,343,
|
||
363,385,408,432,458,485,514,272,288,
|
||
306,324,343,363,385,408,432,458,485,
|
||
514,544,577,611,647,343,363,385,408,
|
||
432,458,485,514,544,577,611,647,686,
|
||
726,770,816,432,458,485,514,544,577,
|
||
611,647,686,726,770,816,864,916,970,1023);
|
||
{Some operators are reserved for percussion. They are at the end of the
|
||
SB's operators which means they're in the middle of the SB Pro's. The main
|
||
program doesn't take this into account so this is used to convert from
|
||
virtual voice number to real voice number}
|
||
RealVoice : Array [0..14] of Byte = (0, 1, 2, 3, 4, 5, 9, 10,
|
||
11, 12, 13, 14, 15, 16, 17);
|
||
|
||
var
|
||
{There is a total of 15 melodic channels available of the SB Pro, hence the 14}
|
||
InUse : Array [0..14] of Boolean;
|
||
Activated : Array [0..17] of LongInt;
|
||
MIDILink,
|
||
NoteNumber,
|
||
NoteVelocity : Array [0..14] of Byte;
|
||
NoteOffData : Array [0..17, 0..1] of Byte;
|
||
{This stores which instrument is currently in use on a MIDI channel}
|
||
Instrument : Array [0..15] of Byte;
|
||
{This stores the FM instrument definitions}
|
||
M2, M4, M6, M8, ME, MC, C2, C4, C6, C8, CE : Array [0..127] of Byte;
|
||
|
||
var
|
||
{This indicates whether the file should be played through a General MIDI
|
||
device or through an FM synthesizer, such as the Sound Blaster}
|
||
Device : Byte;
|
||
{This indicates whether we have a Sound Blaster (6 voices) or an SB Pro or
|
||
better (15 voices) - the 5 drums are always available}
|
||
Voices : Byte;
|
||
{This stores the Base address of the Sound Blaster and GM device}
|
||
FMBase, GMBase : Word;
|
||
{The master volume. Normal volume is 128.}
|
||
MasterVolume : LongInt;
|
||
|
||
{This procedure compensates a given volume for the master volume}
|
||
function DoVolume (Before : Byte) : Byte;
|
||
var
|
||
After : LongInt;
|
||
|
||
begin
|
||
After := Before;
|
||
After := After * MasterVolume;
|
||
After := After shr 7;
|
||
if After > 127 then After := 127;
|
||
DoVolume := After and $FF;
|
||
end;
|
||
|
||
{This procedure changes the speed of the timer to adjust the tempo of a song
|
||
NewSpeed gives the amount of microseconds per quarter note}
|
||
procedure ChangeSpeed (NewSpeed : LongInt);
|
||
var
|
||
QuarterNotesPerSecond : Real;
|
||
Divisor : Real;
|
||
|
||
begin
|
||
{Calculate the amount of quarter notes in a second}
|
||
QuarterNotesPerSecond := (1000000 / NewSpeed);
|
||
{For every quarternote, we have TicksPerQNote ticks}
|
||
Divisor := QuarterNotesPerSecond * TicksPerQNote;
|
||
{If Windows is present, the timer frequency must remain below 1000}
|
||
if Windows then begin
|
||
if Divisor > 1000 then begin
|
||
WinTick := 1 + trunc (Divisor / 1000);
|
||
Divisor := Divisor / WinTick;
|
||
end
|
||
end else WinTick := 1;
|
||
{Set the appropriate values for the timer interrupt}
|
||
TickCounter := trunc ($1234DD / Divisor);
|
||
Port[$43] := $34;
|
||
Port[$40] := lo (TickCounter);
|
||
Port[$40] := hi (TickCounter);
|
||
end;
|
||
|
||
{Writes a value to a specified index register on the FM card}
|
||
procedure WriteFM (Chip, Register, Value : Byte);
|
||
var
|
||
Counter, Temp : Byte;
|
||
Address : Word;
|
||
|
||
begin
|
||
case Chip of
|
||
0 : Address := FMBase;
|
||
1 : Address := FMBase + 2;
|
||
end;
|
||
{Select register}
|
||
Port [Address] := Register;
|
||
{Wait for card to accept value}
|
||
for Counter := 1 to 25 do Temp := Port [Address];
|
||
{Send value}
|
||
Port [Address + 1] := Value;
|
||
{Wait for card to accept value}
|
||
for Counter := 1 to 100 do Temp := Port [Address];
|
||
end;
|
||
|
||
{Sets a channel on the FM synthesizer to a specific instrument}
|
||
procedure SetInstr (Voice, I, Volume : Byte);
|
||
|
||
var
|
||
Chip, Value : LongInt;
|
||
|
||
begin
|
||
if Voice > 8 then begin
|
||
Chip := 1;
|
||
dec (Voice, 9);
|
||
end else Chip := 0;
|
||
{Correction for volume}
|
||
Value := 63 - (M4 [I] and 63);
|
||
Value := Value * Volume div 127;
|
||
if Value > 63 then Value := 0 else Value := 63 - Value;
|
||
Value := (M4 [I] and $C0) or Value;
|
||
{Set up voice modulator}
|
||
WriteFM (Chip, $20 + OpAdr [Voice], M2 [I]);
|
||
WriteFM (Chip, $40 + OpAdr [Voice], Value);
|
||
WriteFM (Chip, $60 + OpAdr [Voice], M6 [I]);
|
||
WriteFM (Chip, $80 + OpAdr [Voice], M8 [I]);
|
||
WriteFM (Chip, $E0 + OpAdr [Voice], ME [I]);
|
||
{The "or 3 shl 4" is enables the voice on the OPL3}
|
||
WriteFM (Chip, $C0 + OpAdr [Voice], MC [I] or 3 shl 4);
|
||
|
||
{Correction for volume}
|
||
Value := 63 - (C4 [I] and 63);
|
||
Value := Value * Volume div 127;
|
||
if Value > 63 then Value := 0 else Value := 63 - Value;
|
||
Value := (C4 [I] and $C0) or Value;
|
||
{Set up voice carrier}
|
||
WriteFM (Chip, $23 + OpAdr [Voice], C2 [I]);
|
||
WriteFM (Chip, $43 + OpAdr [Voice], Value);
|
||
WriteFM (Chip, $63 + OpAdr [Voice], C6 [I]);
|
||
WriteFM (Chip, $83 + OpAdr [Voice], C8 [I]);
|
||
WriteFM (Chip, $E3 + OpAdr [Voice], CE [I]);
|
||
end;
|
||
|
||
{Sets up a drum channel, in much the same way as a normal voice}
|
||
procedure SetDrum (Operator, O2, O4, O6, O8, OE, OC : Byte);
|
||
begin
|
||
WriteFM (0, $20 + Operator, O2);
|
||
WriteFM (0, $40 + Operator, O4);
|
||
WriteFM (0, $60 + Operator, O6);
|
||
WriteFM (0, $80 + Operator, O8);
|
||
WriteFM (0, $E0 + Operator, OE);
|
||
WriteFM (0, $C0 + Operator, OC);
|
||
end;
|
||
|
||
{Enables a note on the FM synthesizer}
|
||
procedure EnableNote (Voice, Number : Byte);
|
||
var
|
||
Chip, Note, Block : Byte;
|
||
{For simulating high octaves}
|
||
FNumber : Word;
|
||
|
||
begin
|
||
{Calculate which part of the OPL3 chip should receive the data}
|
||
if Voice > 8 then begin
|
||
Chip := 1;
|
||
dec (Voice, 9);
|
||
end else Chip := 0;
|
||
{Calculate appropriate data for FM synthesizer}
|
||
FNumber := FNr [Number];
|
||
Block := Number shr 4;
|
||
{Store data to disable the note when necessary}
|
||
NoteOffData [Voice, 0] := lo(FNumber);
|
||
NoteOffData [Voice, 1] := hi(FNumber) + (Block shl 2);
|
||
{Write data to FM synthesizer}
|
||
WriteFM (Chip, $A0+Voice, lo(FNumber));
|
||
WriteFM (Chip, $B0+Voice, hi(FNumber) + (Block shl 2) + 32);
|
||
end;
|
||
|
||
{Disables a note on the FM synthesizer}
|
||
procedure DisableNote (Voice : Byte);
|
||
var
|
||
Chip : Byte;
|
||
|
||
begin
|
||
{Calculate which part of the OPL3 chip should receive the data}
|
||
if Voice > 8 then begin
|
||
Chip := 1;
|
||
dec (Voice, 9);
|
||
end else Chip := 0;
|
||
{Write data to FM synthesizer}
|
||
WriteFM (Chip, $A0+Voice, NoteOffData [Voice, 0]);
|
||
WriteFM (Chip, $B0+Voice, NoteOffData [Voice, 1]);
|
||
end;
|
||
|
||
{Cuts a note on the FM synthesizer immediately}
|
||
procedure CutNote (Voice : Byte);
|
||
var
|
||
Chip : Byte;
|
||
|
||
begin
|
||
{Calculate which part of the OPL3 chip should receive the data}
|
||
if Voice > 8 then begin
|
||
Chip := 1
|
||
end else Chip := 0;
|
||
{Set decay rate to fast - to avoid "plink" sound}
|
||
WriteFM (Chip, $80 + OpAdr [Voice mod 9], $F);
|
||
WriteFM (Chip, $83 + OpAdr [Voice mod 9], $F);
|
||
{Disable the note}
|
||
DisableNote (Voice);
|
||
end;
|
||
|
||
{Processes a "NoteOff" event for the FM synthesizer}
|
||
procedure NoteOff (MIDIChannel, Number, Velocity : Byte);
|
||
var
|
||
FoundChannel, FMChannel : Byte;
|
||
|
||
begin
|
||
{Assume the note can't be found}
|
||
FoundChannel := 255;
|
||
{Scan for note on FM channels}
|
||
for FMchannel := 0 to Voices do begin
|
||
if InUse[FMChannel] = true then begin
|
||
{Is this the correct channel?}
|
||
if (MIDILink [FMChannel] = MIDIChannel)
|
||
and (NoteNumber [FMChannel] = Number) then begin
|
||
{If the correct channel has been found then report that}
|
||
FoundChannel := FMChannel;
|
||
Break;
|
||
end;
|
||
end;
|
||
end;
|
||
if FoundChannel <> 255 then begin
|
||
{Disable the note}
|
||
DisableNote (RealVoice [FoundChannel]);
|
||
{Store appropriate information}
|
||
InUse [FoundChannel] := false; {InUse flag}
|
||
end;
|
||
end;
|
||
|
||
{Processes a "NoteOn" event for the FM synthesizer}
|
||
procedure NoteOn (MIDIChannel, Number, Velocity : Byte);
|
||
var
|
||
FreeChannel, FMChannel : Byte;
|
||
Oldest : LongInt;
|
||
|
||
begin
|
||
{Velocity of zero means note off}
|
||
if Velocity = 0 then begin
|
||
NoteOff (MIDIChannel, Number, Velocity);
|
||
Exit;
|
||
end;
|
||
{Assume no free channel}
|
||
FreeChannel := 255;
|
||
{Scan for free channel}
|
||
for FMchannel := 0 to Voices do begin
|
||
if InUse[FMChannel] = false then begin
|
||
{If a free channel has been found then report that}
|
||
FreeChannel := FMChannel;
|
||
break;
|
||
end;
|
||
end;
|
||
{If there was no free channel, the SB's 6/15 voice polyphony
|
||
has been exceeded and the "oldest" note must be deactivated}
|
||
if FreeChannel = 255 then begin
|
||
Oldest := MaxLongInt;
|
||
{Scan for the oldest note}
|
||
for FMChannel := 0 to Voices do begin
|
||
if Activated [FMChannel] < Oldest then begin
|
||
FreeChannel := FMChannel;
|
||
Oldest := Activated [FMChannel];
|
||
end;
|
||
end;
|
||
{Disable the note currently playing}
|
||
CutNote (RealVoice [FreeChannel]);
|
||
end;
|
||
{Change the instrument settings for the FM channel chosen}
|
||
SetInstr (RealVoice [FreeChannel], Instrument [MIDIChannel], Velocity);
|
||
{Start playing the note}
|
||
EnableNote (RealVoice [FreeChannel], Number);
|
||
{Store appropriate information}
|
||
InUse [FreeChannel] := true; {InUse flag}
|
||
Activated [FreeChannel] := MIDICounter; {Activation time}
|
||
MIDILink [FreeChannel] := MIDIChannel; {Link FM channel to MIDI channel}
|
||
NoteNumber [FreeChannel] := Number; {Note number (which note is being played)}
|
||
NoteVelocity [FreeChannel] := Velocity; {Velocity (=volume)}
|
||
end;
|
||
|
||
{Plays a drum note}
|
||
procedure DrumOn (MIDIChannel, Number, Velocity : Byte);
|
||
begin
|
||
{If velocity is 0, note is turned off, this is ignored}
|
||
if Velocity = 0 then Exit;
|
||
{Convert velocity to "level" needed by SB and reduce the volume slightly}
|
||
Velocity := word(Velocity shl 3) div 10;
|
||
Velocity := 63 - (Velocity shr 1);
|
||
{Bass drum}
|
||
if Number in [35, 36, 41, 43] then begin
|
||
{Set channel 6 to bass, allowing for volume}
|
||
SetDrum (16, 0, 13, 248, 102, 0, 48);
|
||
SetDrum (19, 0, Velocity, 246, 87, 0, 16);
|
||
{Enable bass and immediately deactivate}
|
||
WriteFM (0, $BD, ByteBD or 16);
|
||
WriteFM (0, $BD, ByteBD);
|
||
end;
|
||
{HiHat}
|
||
if Number in [37, 39, 42, 44, 46, 56, 62, 69, 70, 71, 72, 78] then begin
|
||
{Set channel 7 to hihat, allowing for volume}
|
||
SetDrum (17, 0, Velocity, 240, 6, 0, 16);
|
||
{Enable hihat and immediately deactivate}
|
||
WriteFM (0, $BD, ByteBD or 1);
|
||
WriteFM (0, $BD, ByteBD);
|
||
end;
|
||
{Snare drum}
|
||
if Number in [38, 40] then begin
|
||
{Set channel 7 to snare drum, allowing for volume}
|
||
SetDrum (20, 0, Velocity, 240, 7, 2, 16);
|
||
{Enable hihat and immediately deactivate}
|
||
WriteFM (0, $BD, ByteBD or 8);
|
||
WriteFM (0, $BD, ByteBD);
|
||
end;
|
||
{TomTom}
|
||
if Number in [45, 47, 48, 50, 60, 61, 63, 64, 65, 66, 67, 68, 73, 74, 75, 76, 77] then begin
|
||
{Set channel 8 to tomtom, allowing for volume}
|
||
SetDrum (18, 2, Velocity, 240, 6, 0, 16);
|
||
{Enable tomtom and immediately deactivate}
|
||
WriteFM (0, $BD, ByteBD or 4);
|
||
WriteFM (0, $BD, ByteBD);
|
||
end;
|
||
{Cymbal}
|
||
if Number in [49, 51, 52, 53, 54, 55, 57, 58, 59, 79, 80, 81] then begin
|
||
{Set channel 8 to cymbal, allowing for volume}
|
||
SetDrum (21, 4, Velocity, 240, 6, 0, 16);
|
||
{Enable cymbal and immediately deactivate}
|
||
WriteFM (0, $BD, ByteBD or 2);
|
||
WriteFM (0, $BD, ByteBD);
|
||
end;
|
||
end;
|
||
|
||
{Disables a drum note, well, it actually does nothing since drum notes
|
||
do not need to be disabled}
|
||
procedure DrumOff (MIDIChannel, Number, Velocity : Byte);
|
||
begin
|
||
end;
|
||
|
||
{Sends a GM command to the GM device}
|
||
procedure SendGM (c : Byte);
|
||
var
|
||
Value : Byte;
|
||
|
||
begin
|
||
repeat until ((Port [GMBase + 1] and $40) = 0);
|
||
Port [GMBase] := c;
|
||
end;
|
||
|
||
{This function reads a byte from a specific track}
|
||
function ReadByte (TrackNumber : Byte) : Byte;
|
||
begin
|
||
if WaitingFor [TrackNumber] < $FFFFFF then begin
|
||
ReadByte := TrackData [TrackNumber]^[NextBytePtr [TrackNumber]];
|
||
inc (NextBytePtr [TrackNumber]);
|
||
end else ReadByte := 0;
|
||
end;
|
||
|
||
{This function reads a Variable Length Encoded (VLE) number from the track}
|
||
function GetVLE (TrackNumber : Byte) : LongInt;
|
||
var
|
||
ByteRead : Byte;
|
||
Result : LongInt;
|
||
|
||
begin
|
||
{Assume zero}
|
||
Result := 0;
|
||
repeat
|
||
{Read first byte}
|
||
ByteRead := ReadByte (TrackNumber);
|
||
{Store 7bit part}
|
||
Result := (Result shl 7) or (ByteRead and $7F);
|
||
until (ByteRead and $80) = 0;
|
||
GetVLE := Result;
|
||
end;
|
||
|
||
{This procedure stores the time for the next event}
|
||
procedure GetDeltaTime (TrackNumber : Byte);
|
||
begin
|
||
inc (WaitingFor [TrackNumber], GetVLE (TrackNumber));
|
||
end;
|
||
|
||
{This procedure handles the MIDI events}
|
||
procedure DoEvent (TrackNumber : Byte);
|
||
var
|
||
MIDICommand : Byte;
|
||
MetaEvent : Byte;
|
||
DataLength : LongInt;
|
||
Data : LongInt;
|
||
Counter : Byte;
|
||
P1, P2 : Byte;
|
||
|
||
begin
|
||
{Get the MIDI event command from the track}
|
||
MIDICommand := ReadByte (TrackNumber);
|
||
{If this is not a command, we are in "running" mode and the last
|
||
command issued on the track is assumed}
|
||
if MIDICommand and $80 = 0 then begin
|
||
MIDICommand := LastCommand [TrackNumber];
|
||
dec (NextBytePtr [TrackNumber]);
|
||
end;
|
||
{Store the command for running mode}
|
||
LastCommand [TrackNumber] := MIDICommand;
|
||
{
|
||
META-EVENTS
|
||
===========
|
||
Special commands controlling timing etc.
|
||
}
|
||
if MIDICommand = $FF then begin
|
||
MetaEvent := ReadByte (TrackNumber);
|
||
DataLength := GetVLE (TrackNumber);
|
||
case MetaEvent of
|
||
$2F : begin {End of track}
|
||
WaitingFor [TrackNumber] := $FFFFFF;
|
||
end;
|
||
$51 : begin {Tempo change}
|
||
Data := ReadByte (TrackNumber);
|
||
Data := (Data shl 8) or ReadByte (TrackNumber);
|
||
Data := (Data shl 8) or ReadByte (TrackNumber);
|
||
ChangeSpeed (Data);
|
||
end;
|
||
else begin {Others (text events, track sequence numbers etc. - ignore}
|
||
for Counter := 1 to DataLength do ReadByte (TrackNumber);
|
||
end;
|
||
end;
|
||
end;
|
||
{
|
||
CHANNEL COMMANDS
|
||
================
|
||
Upper nibble contains command, lower contains channel
|
||
}
|
||
case (MIDICommand shr 4) of
|
||
$8 : begin {Note off}
|
||
{This allows the use of a wavetable General Midi instrument (such
|
||
as the Roland SCC1 (or an emulation thereof) or the FM synthesizer}
|
||
P1 := ReadByte (TrackNumber);
|
||
P2 := DoVolume (ReadByte (TrackNumber));
|
||
case Device of
|
||
{FM - Sound Blaster or AdLib}
|
||
FM : begin
|
||
case MIDICommand and $F of
|
||
9, 15 : DrumOff (MIDICommand and $F, P1, P2);
|
||
else NoteOff (MIDICommand and $F, P1, P2);
|
||
end;
|
||
end;
|
||
{GM - General MIDI device}
|
||
GM : begin
|
||
SendGM (MIDICommand); SendGM (P1); SendGM (P2);
|
||
end;
|
||
end;
|
||
end;
|
||
$9 : begin {Note on}
|
||
P1 := ReadByte (TrackNumber);
|
||
P2 := DoVolume (ReadByte (TrackNumber));
|
||
case Device of
|
||
FM : begin
|
||
case MIDICommand and $F of
|
||
9, 15 : DrumOn (MIDICommand and $F, P1, P2);
|
||
else NoteOn (MIDICommand and $F, P1, P2);
|
||
end;
|
||
end;
|
||
GM : begin
|
||
SendGM (MIDICommand); SendGM (P1); SendGM (P2);
|
||
end;
|
||
end;
|
||
end;
|
||
$A : begin {Key Aftertouch - only supported for GM device}
|
||
P1 := ReadByte (TrackNumber);
|
||
P2 := DoVolume (ReadByte (TrackNumber));
|
||
if Device = GM then begin
|
||
SendGM (MIDICommand); SendGM (P1); SendGM (P2);
|
||
end;
|
||
end;
|
||
$B : begin {Control change - only supported for GM device}
|
||
case Device of
|
||
FM : begin
|
||
ReadByte (TrackNumber); ReadByte (TrackNumber);
|
||
end;
|
||
GM : begin
|
||
SendGM (MIDICommand); SendGM (ReadByte (TrackNumber)); SendGM (ReadByte (TrackNumber));
|
||
end;
|
||
end;
|
||
end;
|
||
$C : begin {Patch change - this changes the instrument on a channel}
|
||
case Device of
|
||
FM : begin
|
||
Instrument [MIDICommand and $F] := ReadByte (TrackNumber);
|
||
end;
|
||
GM : begin
|
||
SendGM (MIDICommand); SendGM (ReadByte (TrackNumber));
|
||
end;
|
||
end;
|
||
end;
|
||
$D : begin {Channel aftertouch - only supported on GM device}
|
||
case Device of
|
||
FM : begin
|
||
ReadByte (TrackNumber);
|
||
end;
|
||
GM : begin
|
||
SendGM (MIDICommand); SendGM (ReadByte (TrackNumber));
|
||
end;
|
||
end;
|
||
end;
|
||
$E : begin {Pitch wheel change - only supported on GM device}
|
||
case Device of
|
||
FM : begin
|
||
ReadByte (TrackNumber); ReadByte (TrackNumber);
|
||
end;
|
||
GM : begin
|
||
SendGM (MIDICommand); SendGM (ReadByte (TrackNumber)); SendGM (ReadByte (TrackNumber));
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
{
|
||
SYSTEM COMMANDS
|
||
===============
|
||
These are ignored.
|
||
}
|
||
if (MIDICommand shr 4 = $F) then begin
|
||
case MIDICommand of
|
||
$F0 : repeat until ReadByte (TrackNumber) = $F7; {System Exclusive}
|
||
$F2 : begin ReadByte (TrackNumber); ReadByte (TrackNumber); end; {Song Position Pointer}
|
||
$F3 : ReadByte (TrackNumber); {Song Select}
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
{Returns TRUE if the MIDI file is still playing. FALSE if it has stopped}
|
||
function Playing : Boolean;
|
||
var
|
||
CurrentTrack : Byte;
|
||
Result : Boolean;
|
||
|
||
begin
|
||
{Assume it has stopped}
|
||
Result := false;
|
||
{Check for at least one track still playing}
|
||
for CurrentTrack := 1 to NumberOfTracks do
|
||
Result := Result or (WaitingFor [CurrentTrack] < $FFFFFF);
|
||
Playing := Result;
|
||
end;
|
||
|
||
{This is the new timer interrupt handler}
|
||
{$F+}
|
||
procedure TimerHandler; interrupt;
|
||
var
|
||
CurrentTrack : Byte;
|
||
|
||
begin
|
||
{Increase MIDI counter, compensating for Windows if necessary}
|
||
inc (MIDICounter, WinTick);
|
||
{Check all the channels for MIDI events}
|
||
for CurrentTrack := 1 to NumberOfTracks do begin
|
||
{If it is time to handle an event, do so}
|
||
if NextBytePtr [CurrentTrack] < TrackSize [CurrentTrack] then
|
||
while MIDICounter >= WaitingFor [CurrentTrack] do begin
|
||
{Call the event handler}
|
||
DoEvent (CurrentTrack);
|
||
{Store the time for the next event}
|
||
GetDeltaTime (CurrentTrack);
|
||
end;
|
||
end;
|
||
{Check whether we need to call the original timer handler}
|
||
ClockTicks := ClockTicks + TickCounter;
|
||
{Do so if required}
|
||
if ClockTicks > 65535 then begin
|
||
dec (ClockTicks, 65536);
|
||
asm pushf end;
|
||
BIOSTimerHandler;
|
||
end else
|
||
Port [$20] := $20;
|
||
end;
|
||
{$F-}
|
||
|
||
{Installs the MIDI timer handler}
|
||
procedure InstallTimer;
|
||
begin
|
||
TickCounter := 0;
|
||
{Assume tempo 120 according to MIDI spec}
|
||
ChangeSpeed (TicksPerQNote * 25000 div 3);
|
||
{Install new timer handler}
|
||
SetIntVec(8, Addr(TimerHandler));
|
||
end;
|
||
|
||
{Restores the BIOS timer handler}
|
||
procedure RestoreTimer;
|
||
begin
|
||
{Return to 18.2 times a second}
|
||
Port[$43] := $34;
|
||
Port[$40] := 0;
|
||
Port[$40] := 0;
|
||
{Install old timer handler}
|
||
SetIntVec(8, @BIOSTimerHandler);
|
||
end;
|
||
|
||
{This converts a 32bit number from little-endian (Motorola) to big-endian
|
||
(Intel) format}
|
||
function L2B32 (L : LongInt) : LongInt;
|
||
var
|
||
B : LongInt;
|
||
T : Byte;
|
||
|
||
begin
|
||
for T := 0 to 3 do begin
|
||
B := (B shl 8) or (L and $FF);
|
||
L := L shr 8;
|
||
end;
|
||
L2B32 := B;
|
||
end;
|
||
|
||
{This converts a 16bit number from little-endian (Motorola) to big-endian
|
||
(Intel) format}
|
||
function L2B16 (L : Word) : Word;
|
||
begin
|
||
L2B16 := lo (L) shl 8 + hi (L);
|
||
end;
|
||
|
||
{This loads the MIDI file into memory}
|
||
function LoadMidi (FileName : String) : Boolean;
|
||
var
|
||
{To access the file itself}
|
||
MIDIFile : File;
|
||
MIDIHeader : FileHeaderType;
|
||
TrackHeader : TrackHeaderType;
|
||
{For loading the tracks}
|
||
CurrentTrack,t : Byte;
|
||
|
||
begin
|
||
{Assume failure}
|
||
LoadMIDI := false;
|
||
|
||
{Open the file}
|
||
Assign (MIDIFile, FileName);
|
||
Reset (MIDIFile, 1);
|
||
|
||
{Read in the header}
|
||
BlockRead (MIDIFile, MIDIHeader, SizeOf (MIDIHeader));
|
||
{If the first four bytes do not constiture "MTHd", this is not a MIDI file}
|
||
if MIDIHeader.MTHd = $6468544D then begin
|
||
{If the header size is other than 6, this is an unknown
|
||
type of MIDI file}
|
||
if L2B32(MIDIHeader.HeaderSize) = 6 then begin
|
||
{Convert file format identifier}
|
||
MIDIHeader.FileFormat := L2B16(MIDIHeader.FileFormat);
|
||
{If it is an asynchronous file (type 2), I don't know how to play it}
|
||
if MIDIHeader.FileFormat <> 2 then begin
|
||
{Store the tempo of the file}
|
||
TicksPerQNote := L2B16(MIDIHeader.TicksPerQNote);
|
||
{Store the number of tracks in the file}
|
||
NumberOfTracks := L2B16(MIDIHeader.NumberOfTracks);
|
||
if MIDIHeader.FileFormat = 0 then NumberOfTracks := 1;
|
||
{When we reach this, we can start loading}
|
||
for CurrentTrack := 1 to NumberOfTracks do begin
|
||
{Load track header}
|
||
BlockRead (MIDIFIle, TrackHeader, SizeOf (TrackHeader));
|
||
{If the first 4 bytes do not form "MTrk", the track is invalid}
|
||
if TrackHeader.MTrk <> $6B72544D then Exit;
|
||
{We need to convert little-endian to big endian}
|
||
TrackHeader.TrackSize := L2B32 (TrackHeader.TrackSize);
|
||
{If it's too big, we can't load it}
|
||
if TrackHeader.TrackSize > 65534 then Exit;
|
||
TrackSize [CurrentTrack] := TrackHeader.TrackSize;
|
||
{Assign memory for the track}
|
||
GetMem(TrackData [CurrentTrack], TrackSize [CurrentTrack]);
|
||
BlockRead (MIDIFile, TrackData [CurrentTrack]^, TrackSize [CurrentTrack]);
|
||
end;
|
||
LoadMIDI := true;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
{Close it}
|
||
Close (MIDIFile);
|
||
end;
|
||
|
||
{This unloads the MIDI file from memory}
|
||
procedure UnLoadMidi;
|
||
var
|
||
CurrentTrack : Byte;
|
||
|
||
begin
|
||
StopMIDI;
|
||
for CurrentTrack := 1 to NumberOfTracks do
|
||
if TrackSize [CurrentTrack] <> 0 then begin
|
||
FreeMem(TrackData [CurrentTrack], TrackSize [CurrentTrack]);
|
||
TrackSize [CurrentTrack] := 0;
|
||
end;
|
||
end;
|
||
|
||
{This resets the drums}
|
||
procedure EnableDrums;
|
||
begin
|
||
{Enable waveform select}
|
||
WriteFM (0, 1, $20);
|
||
{Enable percussion mode, amplify AM & VIB}
|
||
WriteFM (0, $BD, ByteBD);
|
||
{Set drums frequencies}
|
||
WriteFM (0, $A6, lo(400));
|
||
WriteFM (0, $B6, hi(400) + (2 shl 2));
|
||
WriteFM (0, $A7, lo(500));
|
||
WriteFM (0, $B7, hi(500) + (2 shl 2));
|
||
WriteFM (0, $A8, lo(650));
|
||
WriteFM (0, $B8, hi(650) + (2 shl 2));
|
||
end;
|
||
|
||
{This starts playing the MIDI file}
|
||
procedure PlayMIDI;
|
||
var
|
||
CurrentTrack : Byte;
|
||
begin
|
||
{MIDI might already be playing, so stop it first}
|
||
StopMIDI;
|
||
{Clear read pointers for every track}
|
||
for CurrentTrack := 1 to NumberOfTracks do begin
|
||
NextBytePtr [CurrentTrack] := 0;
|
||
WaitingFor [CurrentTrack] := 0;
|
||
LastCommand [CurrentTrack] := $FF;
|
||
GetDeltaTime (CurrentTrack);
|
||
end;
|
||
MIDICounter := 0;
|
||
WinTick := 1;
|
||
EnableDrums;
|
||
InstallTimer;
|
||
end;
|
||
|
||
{Guess!!}
|
||
procedure StopMIDI;
|
||
var
|
||
CurrentChannel : Byte;
|
||
begin
|
||
RestoreTimer;
|
||
{Send "All notes off" to each channel}
|
||
case Device of
|
||
FM : for CurrentChannel := 0 to 14 do begin
|
||
if InUse [CurrentChannel] then DisableNote (CurrentChannel);
|
||
end;
|
||
GM : for CurrentChannel := 0 to 15 do begin
|
||
SendGM ($B0 or CurrentChannel);
|
||
SendGM (123);
|
||
SendGM (0);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
{Set the playback volume}
|
||
procedure SetVol (NewVol : Byte);
|
||
begin
|
||
MasterVolume := NewVol;
|
||
end;
|
||
|
||
{Check for the existence of an OPL2/3 chip}
|
||
function TestOPL (Test : Word) : Byte;
|
||
var
|
||
A, B : Byte;
|
||
|
||
begin
|
||
{Assume no OPL was found}
|
||
TestOPL := 0;
|
||
|
||
{Find it}
|
||
Port [Test] := 0; Delay (1); Port [Test + 1] := 0; Delay (1);
|
||
Port [Test] := 4; Delay (1); Port [Test + 1] := $60; Delay (1);
|
||
Port [Test] := 4; Delay (1); Port [Test + 1] := $60; Delay (1);
|
||
A := Port [Test];
|
||
Port [Test] := 2; Delay (1); Port [Test + 1] := $FF; Delay (1);
|
||
Port [Test] := 4; Delay (1); Port [Test + 1] := $21; Delay (1);
|
||
B := Port [Test];
|
||
Port [Test] := 4; Delay (1); Port [Test + 1] := $60; Delay (1);
|
||
Port [Test] := 4; Delay (1); Port [Test + 1] := $60; Delay (1);
|
||
|
||
if ((A and $E0)=0) and ((B and $E0)=$C0) then
|
||
{This might be an OPL2}
|
||
TestOPL := 2
|
||
else
|
||
{There's nothing here, so stop looking}
|
||
Exit;
|
||
|
||
{Check for OPL3}
|
||
if Port [Test] and $06 = 0 then TestOPL := 3;
|
||
end;
|
||
|
||
{This function returns true if a GM device is detected at the specified port}
|
||
function TestGM (Base : Word) : Boolean;
|
||
begin
|
||
TestGM := false;
|
||
Delay (10);
|
||
if ((Port [Base + 1] and $40) = 0) then begin
|
||
Port [Base] := $F8;
|
||
Delay (10);
|
||
if ((Port [Base + 1] and $40) = 0) then TestGM := true;
|
||
Port [Base] := $FF;
|
||
Delay (10);
|
||
Port [Base+1] := $3F;
|
||
end;
|
||
end;
|
||
|
||
{This function reports whether Windows is present. Windows interferes with
|
||
the timer interrupt and measures have to be taken.}
|
||
function MSWindows : Boolean; assembler;
|
||
asm
|
||
mov ax, $1600
|
||
int $2F
|
||
end;
|
||
|
||
{Initialize FM driver}
|
||
function SetFM : Boolean;
|
||
var
|
||
Bnk : File;
|
||
|
||
begin
|
||
{Assume a standard SB or AdLib: 6 melodic voices, 5 percussion voices}
|
||
Voices := 5;
|
||
{Check for FM card}
|
||
if TestOPL ($388) > 0 then FMBase := $388;
|
||
{Check for OPL3 at $220 and $240}
|
||
case TestOPL ($240) of
|
||
2 : FMBase := $240;
|
||
3 : begin FMBase := $240; Voices := 14; end;
|
||
end;
|
||
case TestOPL ($220) of
|
||
2 : FMBase := $220;
|
||
3 : begin FMBase := $220; Voices := 14; end;
|
||
end;
|
||
if FMBase <> 0 then begin
|
||
{Enable OPL3 if present}
|
||
if Voices <> 5 then begin
|
||
WriteFM (1, 5, 1);
|
||
WriteFM (1, 4, 0);
|
||
end;
|
||
{Load FM instrument definitions}
|
||
Assign (Bnk, 'FM.DAT');
|
||
Reset (Bnk, 1);
|
||
BlockRead (Bnk, M2, SizeOf (M2));
|
||
BlockRead (Bnk, M4, SizeOf (M4));
|
||
BlockRead (Bnk, M6, SizeOf (M6));
|
||
BlockRead (Bnk, M8, SizeOf (M8));
|
||
BlockRead (Bnk, ME, SizeOf (ME));
|
||
BlockRead (Bnk, MC, SizeOf (MC));
|
||
BlockRead (Bnk, C2, SizeOf (C2));
|
||
BlockRead (Bnk, C4, SizeOf (C4));
|
||
BlockRead (Bnk, C6, SizeOf (C6));
|
||
BlockRead (Bnk, C8, SizeOf (C8));
|
||
BlockRead (Bnk, CE, SizeOf (CE));
|
||
Close (Bnk);
|
||
Device := FM;
|
||
end;
|
||
SetFM := Device = FM;
|
||
end;
|
||
|
||
{Initialize GM driver}
|
||
function SetGM : Boolean;
|
||
begin
|
||
{Try detecting a GM device}
|
||
GMBase := 0;
|
||
if TestGM ($300) then GMBase := $300;
|
||
if TestGM ($330) then GMBase := $330;
|
||
{If it is detected, use it}
|
||
if GMBase <> 0 then Device := GM;
|
||
SetGM := Device = GM;
|
||
end;
|
||
|
||
{###########################################################################}
|
||
{### L E S M E U E S F U N C I O N S ###}
|
||
{###########################################################################}
|
||
procedure IniMidi;
|
||
{ Funci¢: Prepara el General Midi }
|
||
begin
|
||
if midiOK then
|
||
begin
|
||
repeat until SetGM;
|
||
SetVol(255);
|
||
end;
|
||
end;
|
||
{###########################################################################}
|
||
procedure StartMidi(nom : string);
|
||
{ Funci¢: comen‡a a tocar un midi }
|
||
begin
|
||
if midiOK then
|
||
begin
|
||
midi := nom;
|
||
if midiMEM then UnloadMidi;
|
||
LoadMidi(midi);
|
||
midiMEM := TRUE;
|
||
PlayMidi;
|
||
end;
|
||
end;
|
||
{###########################################################################}
|
||
procedure KeepMidi;
|
||
{ Funci¢: Mantin el midi en marxa }
|
||
begin
|
||
if midiOK then
|
||
begin
|
||
if not(playing) then
|
||
begin
|
||
StartMidi(midi);
|
||
PlayMidi;
|
||
end;
|
||
end;
|
||
end;
|
||
{###########################################################################}
|
||
procedure EndMidi;
|
||
{ Funci¢: Allibera la memoria del midi }
|
||
begin
|
||
if midiOK then
|
||
begin
|
||
if midiMEM then UnloadMidi;
|
||
midiMEM := FALSE;
|
||
end;
|
||
end;
|
||
{###########################################################################}
|
||
|
||
begin
|
||
{No device found yet}
|
||
Device := None;
|
||
{Start at normal volume}
|
||
SetVol (128);
|
||
{Check whether Windows is present}
|
||
Windows := MSWindows;
|
||
{Save old timer handler}
|
||
GetIntVec(8, @BIOSTimerHandler);
|
||
end. |