Program Midi_Line_Analyzer;
{
*****************************************************************************
Programmed by: J. Sloan
               AlphaOmega Computer Services
               Box 1052
               Devon, AB.
               Canada, T0C-1E0
               Compuserve 71310,2267
               August 28, 1989
*****************************************************************************
This program is based on two articles that appeared in Electronic
Musician Magazine, 'Handling MPU-401 Interrupts in with Turbo Pascal' ,
William Millar, EMM, May 1989, and tables of midi values that appeared in
the EMM Feb. 1988 issue.
The program is designed to buffer up to 512 midi bytes in a buffer,
then print the bytes surrounded by brackets ie. (F6)= followed by
an English description of what the byte does.  The first byte is in Hex
format whereas the following 1 or 2 bytes are in decimal.  If a Sys Ex
dump is taking place all subsequent bytes are in HEX.

The program requires the Unit MPU-401 in order to operate
*****************************************************************************
}

Uses CRT,MPU401;

Const
     Hexdigits:String[16] = '0123456789ABCDEF';
     spc           = ' ';
     esc           = #27;

Type
     Hexbytestring = String[2];

Var
   Hinib,Lonib:Byte;

Function Byte2Hex(N:Byte):HexbyteString;

{** Convert the passed variable N to Hexadecimal **}

Begin
   Hinib := (n and $F0) shr 4;
   Lonib := n and $0F;
   Byte2Hex:=HexDigits[Hinib + 1] + hexdigits[Lonib + 1]
end;

Procedure WriteByte(S2:HexByteString);

{** Write the byte S2 to the screen **}

Begin
     Write(Spc,S2,Spc);
End;

Procedure Main_screen;
{
****************************************************************************
This is the main loop.  The sequence of events are as follows:

     Install MPU-401 Interrupt system
     Write sign on message
     Open screen window
     Repeat
     If a byte is available from the MPU-401
        then
          If it is the 1st byte display byte and description
          If it is the 2nd byte display byte and description
          If there is a third byte display byte and description
     Until User presses ESC key
     Uninstall MPU-401 Interrupt
     Exit to DOS
*****************************************************************************
}
Type
    FirstByteHiNibble = Array[8..14] of String[22];
    FirstByteLoNibble = Array[0..15] of String[11];
    SysexByte         = Array[$F0..$FF] of String[40];
    Bytetwo           = Array[0..22] of String[36];
    ByteThree         = Array[0..3] of String[19];
    Notes             = Array[0..11] of String[2];
    String4           = String[4];
Var
   SecondMidiByte,ByteCount,Midibyte,HiByte,LowByte:byte;
   Ch:Char;
   First:Boolean;

Const
   StatNibble:FirstbyteHiNibble = ('Note Off,',
                                   'Note On,',
                                   'PolyPhonic Aftertch,',
                                   'Control Mode Change,',
                                   'Program Change,',
                                   'Channel Aftertch,',
                                   'Pitch Wheel Rnge,');

   ChannelNibble:FirstByteLoNibble = ('Chan. 1,',
                                      'Chan. 2,',
                                      'Chan. 3,',
                                      'Chan. 4,',
                                      'Chan. 5,',
                                      'Chan. 6,',
                                      'Chan. 7,',
                                      'Chan. 8,',
                                      'Chan. 9,',
                                      'Chan. 10,',
                                      'Chan. 11,',
                                      'Chan. 12,',
                                      'Chan. 13,',
                                      'Chan. 14,',
                                      'Chan. 15,',
                                      'Chan. 16,');

   Sysex:SysexByte = ('System Exclusive Data Dump=',
                      'Sys Common Undefined',
                      'Sys Common Song Position Pointer',
                      'Sys Common Song Select',
                      'Sys Common Undefined',
                      'Sys Common Undefined',
                      'Sys Common Tune Request',
                      'Sys Common end of System Exclusive (EOX)',
                      'Sys Real Time Timing Clock',
                      'Sys Real Time Undefined',
                      'Sys Real Time Start',
                      'Sys Real Time Continue',
                      'Sys Real Time Stop',
                      'Sys Real Time Undefined',
                      'Sys Real Time Active Sensing',
                      'Sys Real Time Reset');

   DataByteTwo:ByteTwo = ('Continuous Controller #0',
                          'Modulation Wheel',
                          'Breath Control',
                          'Continuous Controller #3',
                          'Foot Controller',
                          'Portamento Time',
                          'Data Entry',
                          'Main Volume',
                          'Continuous Controller #',
                          'Note Number',
                          'Program #',
                          'AfterTouch Pressure',
                          'PitchWheel LSB',
                          'Sustain Pedal on/off',
                          'Portamento on/off',
                          'Sustenuto on/off',
                          'Soft Pedal on/off',
                          'Local control on/off',
                          'All Notes off',
                          'Omni mode off',
                          'Omni mode on',
                          'Mono Mode On',
                          'Poly mode on');

    DataByteThree:ByteThree = ('Note Velocity',
                               'AfterTch Pressure',
                               'Pitch Wheel MSB',
                               'Value');
    MidiNote:Notes = ('C',
                      'C#',
                      'D',
                      'D#',
                      'E',
                      'F',
                      'F#',
                      'G',
                      'G#',
                      'A',
                      'A#',
                      'B');

Function ConvertToNote(Note:Byte):String4;

{** Convert the midinote # to a standard note name including the Octave **}

Var
   NoteName:Notes;
   Octave,NoteNumber:Byte;
   NoteNumberString:String[3];

Begin
    Octave:=Note Div 12;
    NoteNumber:=Octave - 1;
    Str(NoteNumber:2,NotenumberString);
    ConvertToNote:=MidiNote[Note mod 12]+NoteNumberString;
End;

Begin
     Clrscr;
     Writeln('MIDI Line Analyzer -- ','Version 1.0');
     Writeln('Press Esc to Exit.');
     Writeln;
     Writeln('Waiting for MIDI Data ...');
     Writeln('_____________________','_____________________',
              '_____________________','________________');

     Send_Command_to_MPU(MPU_UART_MODE);
     ByteCount:=0;
     First:=true;
     Repeat
           If (Get_Data_From_MPU(MidiByte)) then
           Begin
           If First then
              Begin
                 GotoXY(1,4);Writeln('Receiving Midi Data ...');
                 First:=false;
                 Window(1,6,80,25)
              end;
           ByteCount:=ByteCount+1;
           Case ByteCount of
                 1:Begin
                    Hibyte:=(Midibyte And $F0)SHR 4;
                    LowByte:=(Midibyte And $0F);
                    Case HiByte of
                    1..$E:Begin
                             Write('(',Byte2Hex(MidiByte),')=',StatNibble[Hibyte],' ');
                             Write(ChannelNibble[Lowbyte],' ');
                           end;
                       $F:Begin
                            Write('(',Byte2Hex(Midibyte),')=',Sysex[Midibyte],' ');
                            Case Lowbyte of
                                6..$F:Begin
                                         Writeln;
                                         ByteCount:=0;
                                       end;
                            end;{case lowbyte}
                        end;{F}
                     end; {Hibyte}
                   end;{case1}
               2:Begin
                  SecondMidibyte:=Midibyte;
                    Case Hibyte of
                      8..$A:Begin
                               Write('(',Midibyte,')=','MidiNote #,',' Note is ',
                                 ConvertToNote(MidiByte),', ');
                            End;
                      $B   :Case Midibyte of
                                     00..7:Write('(',Midibyte,')=',DataByteTwo[MidiByte],
                                                        ' ');
                                     8..31:Write('(',Midibyte,')=','Continuous Controller #',
                                                   ' ');
                                     20..27:Write('(',Midibyte,')=',DataByteTwo[(MidiByte And $F0)],
                                                        ' ');
                                     28..63:Write('(',Midibyte,')=','Continuous Controller #',
                                                  ' ');
                                     64..67:Write('(',Midibyte,')=',DataByteTwo[Midibyte-51],' ');
                                     68..95:Write('(',Midibyte,')=','Undefined On/Off ');
                                         96:Write('(',Midibyte,')=','Data Entry +1 ');
                                         97:Write('(',Midibyte,')=','Data Entry -1 ');
                                    98..121:Write('(',Midibyte,')=','Undefined ');
                                   122..127:Write('(',Midibyte,')=',DataByteTwo[Midibyte-105],' ');
                            end;{Case}
                       $C   :Begin
                                Write('(',Midibyte,')=','Program # , ');
                                Writeln;
                                ByteCount:=0;
                             end;
                       $D   :Begin
                               Write('(',Midibyte,')=','LSB Pressure, ');
                               Writeln;
                               ByteCount:=0;
                             end;
                       $E   :Write('(',Midibyte,')=','LSB Range, ');
                       $F   :Case Lowbyte of
                                  0:Begin
                                        Writebyte(Byte2Hex(Midibyte));
                                        Repeat
                                            If Get_data_from_MPU(midibyte) then
                                            WriteByte(byte2hex(midibyte));
                                        Until Midibyte = 247;
                                        writeln('<= EOX');
                                        ByteCount:=0;
                                    End;
                                  1:Begin
                                         Write('(',Midibyte,')=','??, ');
                                    end;
                                  2:Write('(',Midibyte,')=','LSB, ');
                                  3:Begin
                                       Write('(',Midibyte,')=','Song #');
                                       Writeln;
                                       ByteCount:=0;
                                    end;
                                4,5:Begin
                                         Write('(',Midibyte,')=','??, ');
                                    end;
                       end;{F}
                    end;{case}
                 end;{2}
               3:Case Hibyte of
                       8..9:Begin
                               Write('(',MidiByte,')=','Note Velocity');
                               Writeln;
                               ByteCount:=0;
                            end;
                         $A:Begin
                               Write('(',MidiByte,')=','MSB Pressure ');
                               Writeln;
                               Bytecount:=0;
                            end;
                          $B:Begin
                               Case SecondMidibyte of
                                  0..31:Begin
                                        Write('(',midibyte,')=','MSB');
                                        Writeln;
                                        end;
                                 32..63:Begin
                                        Write('(',Midibyte,')=','LSB');
                                        Writeln;
                                        end;
                             64..95,122:Case MidiByte of
                                                0:begin
                                                       Write('(',Midibyte,')=','Off');
                                                       Writeln;
                                                  end;
                                              127:Begin
                                                       Write('(',Midibyte,')=','On');
                                                       Writeln;
                                                  end;
                                        end;{Case}
                                  96,97:Begin
                                          Write('(',Midibyte,')');
                                          Writeln;
                                        end;
                                98..121:Begin
                                           Write('??');
                                           Writeln;
                                         end;
                           123..125,127:Begin
                                           Write('(',Midibyte,')=','0');
                                           Writeln;
                                        end;
                                    126:Begin
                                           Write('(',Midibyte,')=','0 or # of channels');
                                           Writeln;
                                         end;
                               end;{Case Midibyte}
                             ByteCount:=0;
                             end;{B}
                       $E   :Begin
                                Write('(',Midibyte,')=','MSB Range');
                                Writeln;
                                ByteCount:=0;
                             End;
                       $F   :Case LowByte of
                               1,4,5:Begin
                                      Write('(',Midibyte,')=','??');
                                      Writeln;
                                      ByteCount:=0;
                                    end;
                                  2:Begin
                                      Write('(',Midibyte,')=','MSB');
                                      Writeln;
                                      ByteCount:=0;
                                    end;
                             end;{Case Lowbyte}
                  end;{3}

               End;{ByteCount}

            End;{Then Begin}

           If (Keypressed) then
              Ch:=Readkey;
     Until (Ch = esc);
     Send_Command_To_MPU(MPU_Reset);
     Window(1,1,80,25);
     clrscr;
end;

Begin
Main_Screen
End.

