PROGRAM MIDI_File_Info
! Programmer: Benjamin R. Tubb
! Date:       November, December 1988 & January 1989
! Amended:    1/2/90 & 6/8/92, minor editing 
! Revised:    11/10/07
!   Added GUI elements for Input selection and 
!   more Output options
! Language:   True BASIC version 3.01
! Language:   updated for True BASIC 5.10 (1997)
! System:     IBM PC & compatibles (upto WinXP)
! === INITIALIZATION ===
LIBRARY "\TBV5\TBLIBS\TrueDial.trc"
SET MODE "80"
SET MARGIN 85
SET ZONEWIDTH 25
LET frmt$ = Repeat$("##  ",17)
LET MetaEventFlag$= Chr$(255)
LET SequenceNumber$ = Chr$(0) & Chr$(2)
LET TextEvent$ = Chr$(1)
LET CopyrightNotice$ =  Chr$(2)
LET SequenceTrackName$ = Chr$(3)
LET InstrumentName$ =  Chr$(4)
LET Lyric$ = Chr$(5)
LET Marker$ = Chr$(6)
LET CuePoint$ = Chr$(7)
LET MIDIChannelPrefix$ = Chr$(32) & Chr$(0)
LET EndOfTrack$ = Chr$(47) & Chr$(0)
LET SetTempo$ = Chr$(5*16+1) & Chr$(3)
LET SMPTEOffset$ = Chr$(5*16+4) & Chr$(5)
LET Port$ = Chr$(2*16+1) ! added by the GML2 Spec.
LET TimeSignature$ = Chr$(5*16+8) & Chr$(4)
LET KeySignature$ = Chr$(5*16+9) & Chr$(2)
LET SequencerSpecific$ = Chr$(127)
DO ! MAIN #1
  CLEAR
  PRINT "MIDI File Info"
  PRINT "written January 9, 1989; modified 10 November 2007"
  PRINT "by Benjamin Robert Tubb"
  PRINT
  PRINT "This program is primarily meant to summarize the META event types"
  PRINT "for any MIDI File Format Type 1 file."
  PRINT "The info may be output to either the screen, printer or" 
  PRINT "a text file but with the .TXT extension added."
  LET choice = 0
  DO until choice > 0 AND choice < 4
    PRINT "Do you want the output sent to either"
    INPUT PROMPT "your (1) screen, (2) printer, or (3) a text file? ": choice
    LET choice = abs(int(choice))
  LOOP
! MAIN #2
  LET extension$ = "mid"
  LET changedir=0
! to allow access to the True Dials library routings for GUI input/output
  CALL TD_GetFile (extension$, file$, changedir)
  IF Ucase$(file1$[Len(file1$)-2:Len(file1$)]) = "MID" THEN
    LET file1$[Len(file1$)-2:Len(file1$)] = "TXT"
  ELSE
    LET file1$ = file1$ & ".TXT"
  END IF
  OPEN #1: NAME file$, CREATE "OLD", ACCESS "INPUT", ORGANIZATION "BYTE"
SELECT CASE choice
  CASE 1
     OPEN #2: SCREEN 0,1,0,1
  CASE 2
    OPEN #2: PRINTER
  CASE 3
    OPEN #2: NAME file1$, ACCESS "OUTPUT", CREATE "NEW", ORGANIZATION "TEXT"
END SELECT
  SET #2: MARGIN 85
  SET #2: ZONEWIDTH 25
  PRINT #2: "File name              = "; file$
  ASK #1: FILESIZE fz
  PRINT #2,USING"File size              = ###,### bytes.": fz

  ! read and print info from file header
  READ #1, BYTES 4: header$
  IF header$ <> "MThd" THEN 
    PRINT "Not a MIDI file!"
    PRINT "Done!"
    CLOSE #1
    CLOSE #2
    EXIT DO
  END IF
  READ #1, BYTES 4: cl$
  LET cl = 256^3 * Ord(cl$[1:1]) + 256^2 * Ord(cl$[2:2]) + 256 * Ord(cl$[3:3]) + Ord(cl$[4:4])
  READ #1, BYTES 2: fmt$
  LET fmt = 256 * Ord(fmt$[1:1]) + Ord(fmt$[2:2]) ! only 0, 1, or 2
  READ #1, BYTES 2: tracks$
  LET tracks = 256 * Ord(tracks$[1:1]) + Ord(tracks$[2:2])
  DIM SequenceNumber(48),TextEvent(48),CopyrightNotice(48),SequenceTrackName(48),InstrumentName(48),Lyric(48),Marker(48),CuePoint(48),MIDIChannelPrefix(48),EndOfTrack(48),SetTempo(48),SMPTEOffset(48),Port(48),TimeSignature(48),KeySignature(48),SequencerSpecific(48)
  READ #1, BYTES 2: StepsPerQuarter$
  LET StepsPerQuarter = 256 * Ord(StepsPerQuarter$[1:1]) + Ord(StepsPerQuarter$[2:2])
  PRINT #2: "Header                 = "; header$
  PRINT #2,USING"Chunk length           = ###,###": cl
  PRINT #2,USING"MIDI File format       =       #": fmt
  PRINT #2,USING"Number of tracks       =     ###": tracks
  PRINT #2,USING"Steps per Quarter Note =    ####": StepsPerQuarter
  LET track = 1
  DO while more #1 ! MAIN #3
    PRINT #2: Repeat$("-",65)
    READ #1, BYTES 4: header$
    READ #1, BYTES 4: cl$
    LET cl = 256^3 * Ord(cl$[1:1]) + 256^2 * Ord(cl$[2:2]) + 256 * Ord(cl$[3:3]) + Ord(cl$[4:4])
    PRINT #2,USING"Track ### length is ###,###": track, cl
    READ #1, BYTES cl: cl$
    LET MetaEventFlag = 0
    LET SequenceNumber(track) = 0
    LET TextEvent(track) = 0
    LET CopyrightNotice(track) = 0
    LET SequenceTrackName(track) = 0
    LET InstrumentName(track) = 0
    LET Lyric(track) = 0
    LET Marker(track) = 0
    LET CuePoint(track) = 0
    LET MIDIChannelPrefix(track) = 0
    LET EndOfTrack(track) = 0
    LET SetTempo(track) = 0
    LET SMPTEOffset(track) = 0
    LET Port(track) = 0
    LET TimeSignature(track) = 0
    LET KeySignature(track) = 0
    LET SequencerSpecific(track) = 0
    FOR a = 1 to cl
      IF cl$[a:a] = MetaEventflag$ THEN
        IF SequenceNumber$ = cl$[a+1:Len(SequenceNumber$)+a] THEN
          LET SequenceNumber(track) = SequenceNumber(track) + 1
          LET a = a + Len(SequenceNumber$) + Ord(cl$[a+1:a+1])
        ELSEIF TextEvent$ = cl$[a+1:Len(TextEvent$)+a] THEN
          LET TextEvent(track) = TextEvent(track) + 1
          LET a = Len(TextEvent$)+a+1
          LET start = a + 1
          LET end =  Ord(cl$[a:a]) - 1
          PRINT #2,USING"TextEvent ## = ":TextEvent(track);
          PRINT #2: cl$[start : (start + end)]
        ELSEIF CopyrightNotice$ = cl$[a+1:Len(CopyrightNotice$)+a] THEN
          LET CopyrightNotice(track)= CopyrightNotice(track) + 1
          LET a = Len(CopyrightNotice$)+a+1
          LET start = a + 1
          LET end =  Ord(cl$[a:a]) - 1
          PRINT #2,USING"CopyrightNotice ## = ":CopyrightNotice(track);
          PRINT #2: cl$[start : (start + end)]
        ELSEIF SequenceTrackName$ = cl$[a+1:Len(SequenceTrackName$)+a] THEN
          LET SequenceTrackName(track) = SequenceTrackName(track) + 1
          LET a = Len(SequenceTrackName$)+a+1
          LET start = a + 1
          LET end =  Ord(cl$[a:a]) - 1
          PRINT #2,USING"SequenceTrackName ## = ":SequenceTrackName(track);
          PRINT #2: cl$[start : (start + end)]
        ELSEIF InstrumentName$ = cl$[a+1:Len(InstrumentName$)+a] THEN
          LET InstrumentName(track) = InstrumentName(track) + 1
          LET a = Len(InstrumentName$)+a+1
          LET start = a + 1
          LET end =  Ord(cl$[a:a]) - 1
          PRINT #2,USING"InstrumentName ## = ":InstrumentName(track);
          PRINT #2: cl$[start : (start + end)]
        ELSEIF Lyric$ = cl$[a+1:Len(Lyric$)+a] THEN
          LET Lyric(track) = Lyric(track) + 1
          LET a = Len(Lyric$)+a+1
          LET start = a + 1
          LET end =  Ord(cl$[a:a]) - 1
          PRINT #2,USING"Lyric ## = ":Lyric(track);
          PRINT #2: cl$[start : (start + end)]
        ELSEIF Marker$ = cl$[a+1:Len(Marker$)+a] THEN
          LET Marker(track) = Marker(track) + 1
          LET a = Len(Marker$)+a+1
        ELSEIF CuePoint$ = cl$[a+1:Len(CuePoint$)+a] THEN
          LET CuePoint(track) = CuePoint(track) + 1
          LET a = Len(CuePoint$)+a+1
        ELSEIF MIDIChannelPrefix$ = cl$[a+1:Len(MIDIChannelPrefix$)+a] THEN
          LET MIDIChannelPrefix(track)= MIDIChannelPrefix(track) + 1
          LET a = Len(MIDIChannelPrefix$)+a+1
        ELSEIF EndOfTrack$ = cl$[a+1:Len(EndOfTrack$)+a] THEN
          LET EndOfTrack(track) = EndOfTrack(track) + 1
          LET a = Len(EndOfTrack$)+a+1
        ELSEIF SetTempo$ = cl$[a+1:Len(SetTempo$)+a] THEN
          LET SetTempo(track) = SetTempo(track) + 1
          LET a = Len(SetTempo$)+a+4
          LET start = a - 3
          PRINT #2,USING"SetTempo ## = ":SetTempo(track);
          LET usec = 256^2 * Ord(cl$[start:start]) + 256*Ord(cl$[start+1:start+1]) + Ord(cl$[start+2:start+2])
          PRINT #2,USING"#,###,### usecPQN = ###.## BPM":usec,60000000/usec
        ELSEIF SMPTEOffset$ = cl$[a+1:Len(SMPTEOffset$)+a] THEN
          LET SMPTEOffset(track) = SMPTEOffset(track)+ 1
          LET a = Len(SMPTEOffset$)+a+1
        ELSEIF Port$ = cl$[a+1:Len(Port$)+a] AND Ord(cl$[a+2:a+2])=1 THEN
          LET Port(track) = Port(track) + 1
          LET a = Len(Port$)+a+2
        ELSEIF TimeSignature$ = cl$[a+1:Len(TimeSignature$)+a] THEN
          LET TimeSignature(track) = TimeSignature(track) + 1
          LET a = Len(TimeSignature$)+a+5
          LET start = a - 4
          PRINT #2,USING"TimeSig ## = ":TimeSignature(track);
          LET ts$ = str$(Ord(cl$[start:start])) & "/" & str$(2^(Ord(cl$[start+1:start+1])))
          LET MIDIclocksPerMetronomeClick = Ord(cl$[start+3:start+3])
          LET ThirtySecondNotes = Ord(cl$[start+4:start+4])
          PRINT #2,USING"##### | ### MIDIclocks/MetronomeClick | ### ThirtySecondNotes": ts$,MIDIclocksPerMetronomeClick,ThirtySecondNotes
        ELSEIF KeySignature$ = cl$[a+1:Len(KeySignature$)+a] THEN
          LET KeySignature(track) = KeySignature(track) + 1
          LET a = Len(KeySignature$)+a+1
        ELSEIF SequencerSpecific$ = cl$[a+1:Len(SequencerSpecific$)+a] THEN
          LET SequencerSpecific(track) = SequencerSpecific(track) + 1
          LET a = Len(SequencerSpecific$)+a+1
        END IF
      END IF
    NEXT a
    LET track = track + 1
    IF track > tracks THEN EXIT DO
  LOOP
  IF ErrFlag$<>"T" THEN
    IF choice = 1 THEN CLEAR ! show summary only for screen
    PRINT #2: Repeat$("-",65)
    PRINT #2:"A Track Summary of Meta Event Types used:"
    PRINT #2:"--  SN  TE  CN  SE  IN  Ly  Ma  CP  MC  ET  ST  SO  PT  TS  KS  SS"
    FOR a = 1 to tracks
      PRINT #2,USING frmt$:a,SequenceNumber(a),TextEvent(a),CopyrightNotice(a),SequenceTrackName(a),InstrumentName(a),Lyric(a),Marker(a),CuePoint(a),MIDIChannelPrefix(a),EndOfTrack(a),SetTempo(a),SMPTEOffset(a),Port(a),TimeSignature(a),KeySignature(a),SequencerSpecific(a)
    NEXT a 
    PRINT #2: Repeat$("-",17*4)
    PRINT #2: "Valid Meta Event Types are:"
    PRINT #2: "SN = SequenceNumber","TE = TextEvent","CN = CopyRightNotice"
    PRINT #2: "SE = SequenceTrackName","IN = InstrumentName","Ly = Lyric"
    PRINT #2: "Ma = Marker","CP = CuePoint","MC = MIDIChannelPrefix"
    PRINT #2: "ET = EndOfTrack","ST = SetTempo","SO = SMPTEOffset"
    PRINT #2: "TS = TimeSignature","KS = KeySignature","SS = SequencerSpecific"
    PRINT #2: "PT = Port assignment [0-15]"
  END IF
  CLOSE #1
    PRINT "Done!"
  LET YN$=""
  DO UNTIL YN$="Y" OR YN$="N"
    INPUT PROMPT "Again (Y/N)? ": YN$
    LET YN$ = Ucase$(YN$)
  LOOP
  IF Ucase$(YN$)="N" THEN EXIT DO
  CLOSE #2
LOOP
If ErrFlag$ = "T" THEN
  PRINT "Done!"
END IF
END