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

    {
    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.

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