{
From: colin.buckley@canrem.com (Colin Buckley)

>> Does anyone have some good Pascal code for 1) real-time MIDI performance
>> on a standard (Roland MPU-401) card; or 2) reading of MIDI data files.

>Nope.  Nobody has any of this, nor does any exist anywhere on the
>Internet, I can guarantee you this.  I have been asking for this for over
>a year now and it just does *not* exist anywhere.

Which question are you answering?

MIDI is very simple stuff.  Playing or reading and writing the files.
Playing just involves tossing the midi messages out a port.  To read or
write, all you need are the MIDI specs, and you shouldn't have any problem
finding those.  But I don't have FTP so I wouldn't really know.

I have "pascal code" for question 1, but it's actually assembler.  I write
all my low level stuff in assembler, then I wrote a pascal shell around it
when someone in the Fido pascal conference wanted to play MIDI.  It should
be in SWAG, never looked though.  I'll include it at the end of this message.
Just a little while ago I saw a pure Turbo Pascal version.

As for question 2, I'll post the pascal code to my MIDI file convertor as it
can read in *certain* MIDI files.  I've only tested it on files created with
ROL2MIDI, which means there single track and only certain events appear.
It converts to a simple format I use in my games.

Look for the source code disk from the Official Sound Blaster Book (I think
that's the title).  It uses nothing but Creative Lab drivers, but it does
have code to read MOD and MIDI files.  I have the MIDI Unit (MIDUNIT), but
I didn't write it, so I won't post it or email it.  It supports more midi
messages then my routines do, but it's also single track.
}
Program MDI2MUS;

Uses
  CRT,Fast,FM,GM;
  { It's obivously not going to compile.  FAST is just my unit of little
    routines, like screen writes, string routines, etc.

    FM and GM have the same functions and procedures for playing sounds
    on those devices as the purpose of the program is to convert a MDI
    composed on an Adlib to something I can play on Adlib or General Midi.
    The PickGMInstrument, lets me pick a GM instrument by hearing both.

    Comment out the sound stuff, and supply your own generic routines.
  }


Const
  MUSID=245;
  MUSTempo=72.8;
  MUSOverflow=0 SHL 4;
  MUSInstrument=1 SHL 4;
  MUSVolume=2 SHL 4;
  MUSNoteOn=3 SHL 4;
  MUSNoteOff=4 SHL 4;
  MUSPitch=5 SHL 4;
  MUSMarker=14 SHL 4;
  MUSEnd=15 SHL 4;

Type
  MUSHeaderRec=Record
    ID:Byte;
    Title:MStr;
  End;

  MUSInsRec=Record
    GMIns:Byte;
    FMIns:FMInstrument;
  End;

  MDIHeaderRec=Record
    ID:Array[0..3] of Char;
    Length:LongInt;
    Format:Word;
    NumTracks:Word;
    Division:Word;
  End;

  MDITrackRec=Record
    ID:Array[0..3] Of Char;
    Length:LongInt;
  End;

Var
  MUS:File;
  MUSHeader:MUSHeaderRec;
  MDI:File;
  MDIHeader:MDIHeaderRec;
  MDITrack:MDITrackRec;
  EndOfTrack:Boolean;
  Next:Byte;
  NewTempo:Real;
  Tempo:LongInt;
  Time:Word;
  Channel:Byte;
  Command:Byte;
  Note:Byte;
  Volume:Byte;
  VolumeArray:Array[0..15] of Byte;
  Pitch:Word;
  FMIns:Instrument;
  MUSIns:MUSInsRec;

  Procedure Error(Msg:String);
  Begin
    Writeln('* '+Msg);
    Halt;
  End;

  Procedure PickGMInstrument(Voice:Byte);
  Var
    Patch:Byte;
    Key:Char;
    FMOn:Boolean;

    Procedure InitMUS;
    Begin
      FM.InitFM;
      GM.InitGM;
    End;

    Procedure ResetMUS;
    Begin
      FM.ResetFM;
      GM.ResetGM;
    End;

    Procedure SetNoteOn(Voice,Note:Byte);
    Begin
      If FMOn then
        FM.SetNoteOn(Voice,Note)
      Else
        GM.GMSetNoteOn(Voice,Note)
    End;

    Procedure SetNoteOff(Voice:Byte);
    Begin
      If FMOn then
        FM.SetNoteOff(Voice)
      Else
        GM.GMSetNoteOn(Voice,Note)
    End;

    Procedure SetVolume(Voice,Volume:Byte);
    Begin
      FM.SetVolume(Voice,Volume);
      GM.GMSetVolume(Voice,Volume);
    End;

  Begin
    FMOn:=True;
    Writeln('Encountered FM Instrument on Channel ',Voice);
    Writeln;
    Writeln('Instructions:');
    Writeln('C     = Middle C Note');
    Writeln('1..0  = Note Scale');
    Writeln('SPACE = Toggle Device');
    Writeln('P     = Change Patch');
    Writeln;
    InitMUS;
    FM.SetInstrument(Voice,@MUSIns.FMIns);
    GMSetInstrument(Voice,MUSIns.GMIns);
    SetVolume(Voice,127);
    Repeat
      Write('Patch: ',MUSIns.GMIns);ClrEol;
      GotoXY(1,WhereY);
      Key:=Upcase(BIOSKey);
      Case Key of
        '1'..'9':Begin
                   SetNoteOn(Voice,54+(Ord(Key)-48));
                   Delay(175);
                   SetNoteOff(Voice);
                 End;
        '0':     Begin
                   SetNoteOn(Voice,65);
                   Delay(175);
                   SetNoteOff(Voice);
                 End;
         SPACEKey:FMOn:=Not FMOn;
         'P':    Begin
                   Writeln;
                   Write('New Patch [0-127]: ');
                   Readln(MUSIns.GMIns);
                   GotoXY(1,WhereY-1);
                   ClrEol;
                   GotoXY(1,WhereY-1);
                   ClrEol;
                   GMSetInstrument(Voice,MUSIns.GMIns);
                 End;
      End;
    Until (Key=ESCKey) or (Key=ENTERKey);
    ResetMUS;
  End;

  Procedure WriteMUS(Time:Byte; Command,Channel:Byte; Var Data; DataSize:Byte);
  Var
    Combined:Byte;
    T:Byte;
  Begin
    { Set Delta Time }
    BlockWrite(MUS,Time,SizeOf(Time));
    ASM
      MOV  AL,[Command]
      AND  AL,11110000b
      MOV  AH,[Channel]
      AND  AH,00001111b
      ADD  AL,AH
      MOV  [Combined],AL
    End;
    { Set Command/Channel Combined Byte }
    BlockWrite(MUS,Combined,SizeOf(Combined));
    { Set Command Data }
    If DataSize>=1 then
      BlockWrite(MUS,Data,DataSize);
  End;

  Function IntelLong(Motorolla:LongInt):LongInt; Assembler;
  ASM
    MOV  AX,[WORD PTR Motorolla]
    MOV  DX,[WORD PTR Motorolla+2]
    XCHG AL,AH
    XCHG DL,DH
    XCHG AX,DX
  End;

  Function IntelWord(Motorolla:Word):Word; Assembler;
  ASM
    MOV  AX,[Motorolla]
    XCHG AL,AH
  End;

  Procedure ReadMDI(MDIFile:LStr);
  Begin
    Assign(MDI,MDIFile);
    Reset(MDI,1);
    If IOResult<>0 then
      Error(MDIFile+' Not Found!');
    BlockRead(MDI,MDIHeader,SizeOf(MDIHeader));
    BlockRead(MDI,MDITrack,SizeOf(MDITrack));
    With MDIHeader do
    Begin
      Length:=IntelLong(Length);
      Format:=IntelWord(Format);
      NumTracks:=IntelWord(NumTracks);
      Division:=IntelWord(Division);
    End;
    With MDITrack do
      Length:=IntelLong(Length);
    If (MDIHeader.ID<>'MThd') or (MDIHeader.Format<>0) or (MDITrack.ID<>'MTrk')
      Error('Invalid Type 0 .MDI File: '+MDIFile);
  End;

  Procedure CreateMUS(MUSFile:LStr);
  Var
    Temp:Byte;
  Begin
    FillChar(MUSHeader,SizeOf(MUSHeader),0);
    MUSHeader.ID:=MUSID;
    Write('Enter Title: ');
    Readln(MUSHeader.Title);
    Assign(MUS,MUSFile);
    Rewrite(MUS,1);
    BlockWrite(MUS,MUSHeader,SizeOf(MUSHeader));
  End;

  Procedure ConvertMDI;

    Procedure DoDeltaTime;
    Var
      VarLength:LongInt;
    Begin
      BlockRead(MDI,Next,1);
      VarLength:=Next;
      If (Next And $80)=$80 then
      Begin
        VarLength:=VarLength And $7F;
        Repeat
          BlockRead(MDI,Next,1);
          VarLength:=(VarLength Shl 7) + (Next And $7F)
        Until (Next And $80)<>$80;
      End;
      Time:=Trunc(VarLength*NewTempo);
      If Time>255 then
      Begin
        WriteMUS(0,MUSOverflow,0,Time,SizeOf(Time));
        Time:=0;
      End;
    End;

    Procedure DoSysExEvent;
    Begin

    End;

    Procedure DoMIDIEvent;
    Begin
      Channel:=Command And $F;
      Command:=Command And $F0;
      Case Command of
        { Note Off }
        $80:Begin
              BlockRead(MDI,Note,1);
              BlockRead(MDI,Volume,1);
              WriteMUS(Time,MUSNoteOff,Channel,Note,0);
            End;
        { Note On }
        $90:Begin
              BlockRead(MDI,Note,1);
              BlockRead(MDI,Volume,1);
              { If Volume=0 it's the same as a NoteOff }
              If Volume=0 then
                WriteMUS(Time,MUSNoteOff,Channel,Note,0)
              Else
              Begin
                { Update Volume if different then previous }
                If VolumeArray[Channel]<>Volume then
                Begin
                  VolumeArray[Channel]:=Volume;
                  WriteMUS(Time,MUSVolume,Channel,Volume,SizeOf(Volume));
                  Time:=0;
                End;
                WriteMUS(Time,MUSNoteOn,Channel,Note,SizeOf(Note));
              End;
            End;
        { Volume Change / Channel Pressure / After Touch }
        $D0:Begin
              BlockRead(MDI,Volume,1);
            End;
        { Pitch Change }
        $E0:Begin
              BlockRead(MDI,Pitch,2);
              Pitch:=IntelWord(Pitch);
              WriteMUS(Time,MUSPitch,Channel,Pitch,SizeOf(Pitch));
            End;
        Else
          Writeln('Unknown MIDI event!');
      End;
    End;

    Procedure DoMetaEvent;
    Var
      Length:Byte;
      FPos:LongInt;
      ID:Array[0..4] of Byte;
    Begin
      BlockRead(MDI,Command,1);
      BlockRead(MDI,Length,1);
      FPos:=FilePos(MDI);
      Case Command of
        $2F:Begin
              EndOfTrack:=True;
              WriteMUS(0,MUSEnd,0,Note,0);
            End;
        { Tempo }
        $51:Begin
              BlockRead(MDI,Next,1);
              Tempo:=Next*65536;
              BlockRead(MDI,Next,1);
              Inc(Tempo,Word(Next*256));
              BlockRead(MDI,Next,1);
              Inc(Tempo,Next);
              NewTempo:=MUSTempo/(MDIHeader.Division*(1000000/Tempo));
            End;
        { Sequencer Specific }
        $7F:Begin
              BlockRead(MDI,ID,SizeOf(ID));
              { Adlib ID }
              If (ID[0]=$00) And (ID[1]=$00) And (ID[2]=$3F) then
                Case Ord(ID[4]) of
                  { Instrument }
                  1:Begin
                      BlockRead(MDI,Channel,1);
                      BlockRead(MDI,FMIns,SizeOf(FMIns));
                      ConvertInstrument(FMIns,MUSIns.FMIns);
                      PickGMInstrument(Channel);
                      WriteMUS(Time,MUSInstrument,Channel,MUSIns
SizeOf(MUSIns))
                    End;
                  { Melodic or Percussion Mode }
                  2:BlockRead(MDI,Next,1);
                  { Waveforms }
                  3:BlockRead(MDI,Next,1);
                End;
            End;
      End;
      Seek(MDI,FPos+Length);
    End;

  Begin
    EndOfTrack:=False;
    Time:=0;
    NewTempo:=500000;
    FillChar(VolumeArray,SizeOf(VolumeArray),0);
    While Not (EOF(MDI) And EndOfTrack) do
    Begin
      { Get Time of Event }
      DoDeltaTime;
      { Get Event from Midi Stream }
      BlockRead(MDI,Command,1);
      Case Command of
        $80..$EF:DoMidiEvent;
        {
        $F0,$F7: DoSysExEvent;
        }
        $FF:     DoMetaEvent;
      Else
        Writeln('Unknown Event in MIDI Stream!');
      End;
    End;
    Close(MDI);
    Close(MUS);
  End;

Begin
  Writeln('+-----------------------  +++++-++|+++++ +++++++++-----------------
  Writeln('|                         ++++-++++++++- +++++++++-
  Writeln('|
  Writeln('|                              Music Conversion
  Writeln('|
  Writeln('|              Copyright 1992 by Absolute Magic, Inc and Colin Buckle
  Writeln('+--------------------------------------------------------------------
  Writeln;
  If ParamCount<2 then
  Begin
    Writeln;
    Writeln('USAGE: MUS <MDIFile> <MUSFile>');
    Writeln;
    Writeln('<MDIFile> is created by converting a .ROL with ROL2MIDI.EXE');
    Writeln;
    Exit;
  End;
  ReadMDI(ParamStr(1));
  CreateMUS(ParamStr(2));
  ConvertMDI;
  Writeln;
  If Not EndOfTrack then
    Writeln('* Unsuccessful Conversion.  End Of Track Not Encountered.')
  Else
    Writeln('* Successful Conversion');
End.





-----------------------------------------------------------------------------

Program GMTest;

{
Public domain.  Do whatever you want with it.
Colin Buckley.
}

Const
  GMPort        = $331;
  Send          = $80;
  Receive       = $40;

{ AL:=Command; }
Procedure WriteGMCommand; Assembler;
ASM
    MOV   DX,GMPort                   {;DX:=GMStatusPort;                 }
    PUSH  AX                          {;Save AX                           }
    XOR   AX,AX                       {;AH:=TimeOutValue;                 }
@@WaitLoop:
    { ;Prevent Infinite Loop with Timeout }
    DEC   AH                          {; |If TimeOutCount=0 then          }
    JZ    @@TimeOut                   {;/   TimeOut;                      }
    {; Wait until GM is ready }
    IN    AL,DX                       {; |If Not Ready then               }
    AND   AL,Receive                  {; |  WaitLoop;                     }
    JNZ   @@WaitLoop                  {;/                                 }
@@TimeOut:
    POP   AX                          {;Restore AX                        }

    OUT   DX,AL                       {;Send Data                         }
End;

{ ; AL:=Data }
Procedure WriteGM; Assembler;
ASM
    MOV   DX,GMPort                   {;DX:=GMStatusPort;                 }
    PUSH  AX                          {;Save AX                           }
    XOR   AX,AX                       {;AH:=TimeOutValue;                 }
@@WaitLoop:
    { ; Prevent Infinite Loop with Timeout }
    DEC   AH                          {; |If TimeOutCount=0 then          }
    JZ    @@TimeOut                   {;/   TimeOut;                      }
    { ; Wait until GM is ready }
    IN    AL,DX                       {; |If Not Ready then               }
    AND   AL,Receive                  {; |  WaitLoop;                     }
    JNZ   @@WaitLoop                  {;/                                 }
@@TimeOut:
    POP   AX                          {;Restore AX                        }

    DEC   DX                          {;DX:=DataPort                     }
    OUT   DX,AL                       {;Send Data                        }
End;

{ ;Returns Data }
Function ReadGM:Byte; Assembler;
ASM
    MOV   DX,GMPort                   {;DX:=GMStatusPort;                 }
    PUSH  AX                          {;Save AX                           }
    XOR   AX,AX                       {;AH:=TimeOutValue;                 }
@@WaitLoop:
    { ; Prevent Infinite Loop with Timeout }
    DEC   AH                          {; |If TimeOutCount=0 then          }
    JZ    @@TimeOut                   {;/   TimeOut;                      }
    { ; Wait until GM is ready }
    IN    AL,DX                       {; |If Not Ready then               }
    AND   AL,Send                     {; |  WaitLoop;                     }
    JNZ   @@WaitLoop                  {;/                                 }
@@TimeOut:
    POP   AX                          {;Restore AX                        }

    DEC   DX                          {;DX:=DataPort                      }
    IN    AL,DX                       {;Receive Data                      }
End;

Procedure ResetGM; Assembler;
ASM
    { ;Reset GM }
    MOV   DX,GMPort
    MOV   AL,0FFh
    OUT   DX,AL
    {; Get ACK }
    CALL  ReadGM
    {; UART Mode }
    MOV   AL,03Fh
    CALL  WriteGMCommand
End;

Procedure SetNoteOn(Channel,Note,Volume:Byte); Assembler;
ASM
    MOV   AL,[Channel]
    ADD   AL,90h
    Call  WriteGM
    MOV   AL,[Note]
    CALL  WriteGM
    MOV   AL,[Volume]
    CALL  WriteGM
End;

Procedure SetNoteOff(Channel,Note,Volume:Byte); Assembler;
ASM
    MOV   AL,[Channel]
    ADD   AL,80h
    Call  WriteGM
    MOV   AL,[Note]
    CALL  WriteGM
    MOV   AL,[Volume]
    CALL  WriteGM
End;

Begin
  ResetGM;
  SetNoteOn(0,64,127);
  ASM
    { ;Wait for Key }
    XOR   AX,AX
    INT   16h
  End;
  SetNoteOff(0,64,127);
  ResetGM;
End.