'===========================================================================
' Subject: SCAN MIDI FILE STRUCTURES          Date: 01-06-96 (01:27)       
'  Author: Joe Shay                           Code: QB, QBasic, PDS        
'  Origin: FidoNet QUIK_BAS Echo            Packet: SOUND.ABC
'===========================================================================
'MIDI001.BAS  By Joe Shay
'Released to the Public Domain, January 1996
'(presently intended)
'A program ^ to - scan the MIDI file structure.
'               - identify  MIDI Format, Tempo, Key,
'                     Track name, instrument name
'               - generally display file contents
'
'Note: I have directed the program to examine a
'      .MID file included with Windows.
'
' This code is 'AS IS' so if anyone can improve my
'methods to accomplish the above stated I would
'appreciate it. My thanx to Chad Beck for directing me
'towards  the correct ball park.
'

DEFINT A-Z
DECLARE FUNCTION Int2Hex$ (Dec%)
DECLARE FUNCTION KeeOTune$ (sfnum$, minum%)

TYPE midi
 headchunk AS STRING * 4
  headsize AS STRING * 4
     f4mat AS STRING * 2
    totrax AS STRING * 2
  deltatix AS STRING * 2
END TYPE

TYPE midigutz
  trakchunx AS STRING * 4
   chunklen AS STRING * 4
END TYPE

DIM midfylhead AS midi
DIM miditrax(1 TO 100) AS midigutz

WIDTH 80, 50
CLS

OPEN "c:\sb16\playmidi\minuet.mid" FOR BINARY AS #1
GET 1, , midfylhead
  IF midfylhead.headchunk <> "MThd" THEN
   CLOSE
    PRINT "Non .MID file or corrupted file"
   END
  END IF
 COLOR 0, 2
  PRINT " File Format = "; ASC(RIGHT$(midfylhead.f4mat, 1));
  IF ASC(RIGHT$(midfylhead.f4mat, 1)) > 0 THEN PRINT "[Multi Trax]" ELSE PRINT "[Single Trax]"

 COLOR 0, 3
    ttrx = ASC(LEFT$(midfylhead.totrax, 1)) + ASC(RIGHT$(midfylhead.totrax, 1))
  PRINT " Total Tracks = "; ttrx - 1;
'PRINT " Delta Ticks / PPQ = "; ASC(RIGHT$(midfylhead.deltatix, 1));
  PRINT
 COLOR 3, 0
 Tempo$ = SPACE$(8)
 timsig$ = SPACE$(5)
 keysig$ = SPACE$(3)
 a$ = SPACE$(1)
 B$ = SPACE$(1)

DO UNTIL EOF(1)
  GET 1, , a$
    SELECT CASE a$
     CASE CHR$(255) '&HFF meta event marker
       GET 1, , B$
        bb$ = HEX$(ASC(B$))
         IF LEN(bb$) < 2 THEN bb$ = "0" + bb$
            SELECT CASE bb$
             CASE "01", "02", "03", "04", "05", "06", "07"
               GET 1, , B$
                tot = ASC(B$)
                GOSUB grabyte
             CASE "20"
              cc$ = "MIDI Ch. Prefix.."
             CASE "2F"
              cc$ = "-=End Trk=-" + CHR$(13)
             CASE "51"
              cc$ = "Set tempo"
              GET 1, , Tempo$
               Byte1 = VAL(HEX$(ASC(MID$(Tempo$, 3, 2))))
               Byte2 = VAL(HEX$(ASC(MID$(Tempo$, 5, 2))))
               Byte3 = VAL(HEX$(ASC(MID$(Tempo$, 7, 2))))
              Tempo& = Byte1 + (Byte2 * 256&) + (Byte3 * 65537)
              PRINT Tempo&
             CASE "58"
              cc$ = "Time Sig.."
              GET 1, , timsig$
                num = ASC(MID$(timsig$, 2, 1))
                den = ASC(MID$(timsig$, 3, 1))
                den = 2 ^ den
                COLOR 15, 3
               LOCATE 1, 42: PRINT num; "/"; den
             CASE "59"
              cc$ = "Key Sig.."
               GET 1, , keysig$
               sf = ASC(MID$(keysig$, 2, 1))
               mi = ASC(MID$(keysig$, 3, 1))

                 IF sf > 7 THEN     '='='convert to negative
                   sf = sf - 256
                 END IF
                 sf$ = LTRIM$(RTRIM$(STR$(sf)))

               ' PRINT sf   'temp for tests
               COLOR 15, 3
                LOCATE 1, 65: PRINT KeeOTune$(sf$, mi)

             CASE ELSE
              cc$ = "===="
              END SELECT
             PRINT bb$; " "; cc$
     CASE ELSE
     END SELECT
 LOOP
  CLOSE
   END

grabyte:
COLOR 1, 15
FOR i = 1 TO tot
  a$ = INPUT$(1, #1)
  IF a$ <> CHR$(0) OR a$ <> CHR$(12) THEN
   PRINT a$;
  END IF
  NEXT
 COLOR 3, 0
RETURN

DEFSNG A-Z
FUNCTION Int2Hex$ (Dec%)
 IF Dec% = 0 THEN
  t2Hex$ = "00"
 ELSE
  t2Hex$ = HEX$(Dec%)
  IF LEN(t2Hex$) < 2 THEN t2Hex$ = "0" + t2Hex$
 END IF
 Int2Hex$ = t2Hex$
END FUNCTION

DEFINT A-Z
'
 FUNCTION KeeOTune$ (sfnum$, minum%)
  keyz$ = "Bb-5DbF -4AbC -3EbG -2BbD -1F A 0 C E +1G B +2D F#+3A C#+4E G#+5B D#+6F#"
 scan1 = INSTR(keyz$, sfnum$)
 IF minum% = 0 THEN
  scan1 = scan1 + 2
  mm$ = " Major"
 ELSE
  scan1 = scan1 - 2
  mm$ = " Minor"
 END IF

 tunekee$ = MID$(keyz$, scan1, 2)
 KeeOTune$ = tunekee$ + mm$

 END FUNCTION