Code: Select all
EnableExplicit
;> ---------------------- <
;- MidiParser : Constants
;> ---------------------- <
#MIDI_Chunk_Header = 'dhTM' ;"MThd"
#MIDI_Chunk_Track = 'krTM' ;"MTrk"
Enumeration ;MIDI track types
#MIDI_Track_Single
#MIDI_Track_Synchronous
#MIDI_Track_Asynchronous
EndEnumeration
;> ----------------------- <
;- MidiParser : Structures
;> ----------------------- <
Structure MIDICHUNK
dwType.l
dwSize.l ;remaining size
EndStructure
Structure MIDIHEADER
wTrack.w ;track type
wCount.w ;number of tracks
wDelta.w ;delta time
EndStructure
Macro LoNibble(x)
(x & $0F)
EndMacro
Macro HiNibble(x)
(x >> 4)
EndMacro
Structure Bytes
b.b[4]
EndStructure
;> ---------------------------------- <
;- MidiParser : Variable-Length Value
;> ---------------------------------- <
#MIDI_VarLen_Max = $0FFFFFFF ;4 reserved Bytes
#MIDI_VarLen_Error = $FFFFFFFF ;impossible VarLen or Num value
Procedure.l NumToVarLen(Num.l)
Protected VarLen.l, i.l
Protected *VarLen.Bytes
If Num & ~#MIDI_VarLen_Max
VarLen = #MIDI_VarLen_Error
Else
*VarLen = @VarLen
*VarLen\b[0] = (Num >> 0) & $7F
*VarLen\b[1] = (Num >> 7) & $7F
*VarLen\b[2] = (Num >> 14) & $7F
*VarLen\b[3] = (Num >> 21) & $7F
i = 3
While i > 0 And Not *VarLen\b[i]
i - 1
Wend
While i > 0
*VarLen\b[i] | $80
i - 1
Wend
EndIf
ProcedureReturn VarLen
EndProcedure
Procedure.l VarLenToNum(VarLen.l)
Protected Num.l, i.l
Protected *VarLen.Bytes
*VarLen = @VarLen
Num | (*VarLen\b[0] & $7F) << 0
Num | (*VarLen\b[1] & $7F) << 7
Num | (*VarLen\b[2] & $7F) << 14
Num | (*VarLen\b[3] & $7F) << 21
If VarLen <> NumToVarLen(Num)
Num = #MIDI_VarLen_Error
EndIf
ProcedureReturn Num
EndProcedure
Procedure.l WriteVarLen(File.l, Num.l)
Protected Write.l, VarLen.l, i.l
Protected *VarLen.Bytes
VarLen = NumToVarLen(Num)
If IsFile(File) And VarLen <> #MIDI_VarLen_Error
*VarLen = @VarLen
i = 3
While Not *VarLen\b[i]
i - 1
Wend
While i >= 0
Write + WriteByte(File, *VarLen\b[i])
i - 1
Wend
EndIf
ProcedureReturn Write
EndProcedure
Procedure.l ReadVarLen(File.l)
Protected VarLen.l, len.l
If IsFile(File)
Repeat
VarLen = (VarLen << 8) | (ReadByte(File) & $FF)
len + 1
Until Not VarLen & $80
If len > 4
VarLen = #MIDI_VarLen_Error
EndIf
Else
VarLen = #MIDI_VarLen_Error
EndIf
ProcedureReturn VarLenToNum(VarLen)
EndProcedure
Procedure.l VarLenSize(Value.l, IsVarLen.l = #False)
Protected Size.l
If IsVarLen
Value = VarLenToNum(Value)
EndIf
If Value < 0
Size = #MIDI_VarLen_Error
ElseIf Value < (1 << 7)
Size = 1
ElseIf Value < (1 << 14)
Size = 2
ElseIf Value < (1 << 21)
Size = 3
ElseIf Value < (1 << 28)
Size = 4
Else
Size = #MIDI_VarLen_Error
EndIf
ProcedureReturn Size
EndProcedure
;> ---------------------- <
;- MidiParser : BigEndian
;> ---------------------- <
ProcedureDLL.w PeekBigEndianW(*MemoryBuffer)
!MOV eax, dword [p.p_MemoryBuffer]
!MOV ax, word [eax]
!BSWAP eax
!SHR eax, 16
ProcedureReturn
EndProcedure
ProcedureDLL.l PeekBigEndianL(*MemoryBuffer)
!MOV eax, dword [p.p_MemoryBuffer]
!MOV eax, dword [eax]
!BSWAP eax
ProcedureReturn
EndProcedure
ProcedureDLL.q PeekBigEndianQ(*MemoryBuffer)
!MOV eax, dword [p.p_MemoryBuffer]
!MOV edx, dword [eax+0]
!MOV eax, dword [eax+4]
!BSWAP eax
!BSWAP edx
ProcedureReturn
EndProcedure
ProcedureDLL.q PeekBigEndianN(*MemoryBuffer.Bytes, Size.l)
Protected Result.q, i.l
While i < Size
Result << 8
Result | (*MemoryBuffer\b[i] & $FF)
i + 1
Wend
ProcedureReturn Result
EndProcedure
ProcedureDLL.w ReadBigEndianW(File)
ReadWord(File)
!BSWAP eax
!SHR eax, 16
ProcedureReturn
EndProcedure
ProcedureDLL.l ReadBigEndianL(File)
ReadLong(File)
!BSWAP eax
ProcedureReturn
EndProcedure
ProcedureDLL.q ReadBigEndianQ(File)
ReadQuad(File)
!XOR eax, edx
!XOR edx, eax
!XOR eax, edx
!BSWAP eax
!BSWAP edx
ProcedureReturn
EndProcedure
;> --------------------------- <
;- MidiParser : Event handlers
;> --------------------------- <
Enumeration ;Event types
#MidiParser_Event_Header ;header chunk handler
#MidiParser_Event_Track ;track chunk handler
#MidiParser_Event_Command ;channel event handler
#MidiParser_Event_SysEx ;system exclusive handler
#MidiParser_Event_System ;system event handler
#MidiParser_Event_Meta ;meta event handler
#MidiParser_Event_Chunk ;non track chunks handler
#MidiParser_Event_Error ;error handler
EndEnumeration
Enumeration ;Error codes
#MidiParser_Error_File
#MidiParser_Error_Header
#MidiParser_Error_EOF
#MidiParser_Error_Time
#MidiParser_Error_Command
#MidiParser_Error_SysEx
#MidiParser_Error_System
#MidiParser_Error_Meta
#MidiParser_Error_Track
EndEnumeration
Enumeration ;Event handlers return value
#MidiParser_Stop
#MidiParser_Continue
EndEnumeration
Prototype.l HeaderHandler(Track.w, Count.w, Delta.w)
Prototype.l TrackHandler()
Prototype.l CommandHandler(Time.l, Event.l, channel.l, Param1.l, Param2.l)
Prototype.l SysExHandler(Time.l, Event.l, Size.l, *Buffer)
Prototype.l SystemHandler(Time.l, Event.l, Param.l)
Prototype.l MetaHandler(Time.l, Event.l, Size.l, *Buffer)
Prototype.l ChunkHandler(type.l, Size.l, *Buffer)
Global Dim EventHandlers.l(#MidiParser_Event_Error)
;> -------------------- <
;- MidiParser : Private
;> -------------------- <
Procedure.l RaiseMidiError(ErrorCode.l)
;if the user wants to catch it
If EventHandlers(#MidiParser_Event_Error)
;then lets give him
CallFunctionFast(EventHandlers(#MidiParser_Event_Error), ErrorCode)
EndIf
ProcedureReturn #MidiParser_Stop
EndProcedure
Procedure.l ParseMidiHeader(File.l, *Header.MIDIHEADER)
Protected Result.l
Protected Handler.HeaderHandler
Protected Chunk.MIDICHUNK
Chunk\dwType = ReadLong(File)
Chunk\dwSize = ReadBigEndianL(File)
If Chunk\dwType = #MIDI_Chunk_Header And Chunk\dwSize = SizeOf(MIDIHEADER)
*Header\wTrack = ReadBigEndianW(File)
*Header\wCount = ReadBigEndianW(File)
*Header\wDelta = ReadBigEndianW(File)
If *Header\wTrack >= #MIDI_Track_Single And *Header\wTrack <= #MIDI_Track_Asynchronous
;the header is valid so parsing continues
Result = #MidiParser_Continue
Handler = EventHandlers(#MidiParser_Event_Header)
;except if the user doesn't agree
If Handler
Result = Handler(*Header\wTrack, *Header\wCount, *Header\wDelta)
EndIf
Else
;this is not a valid midi header
Result = RaiseMidiError(#MidiParser_Error_Header)
EndIf
Else
;this is not a midi header
Result = RaiseMidiError(#MidiParser_Error_Header)
EndIf
ProcedureReturn Result
EndProcedure
Procedure.l ParseMidiTrack()
Protected Result.l
Protected Handler.TrackHandler
Result = #MidiParser_Continue
Handler = EventHandlers(#MidiParser_Event_Track)
If Handler
Result = Handler()
EndIf
ProcedureReturn Result
EndProcedure
Procedure.l ParseMidiCommand(File.l, Time.l, Event.l)
Protected Result.l, channel.l
Protected Param1.l, Param2.l
Protected Handler.CommandHandler
channel = LoNibble(Event)
Event = HiNibble(Event)
Param1 = ReadByte(File) & $FF
;Program and After-touch messages
;only have a single param
If Event <> $C And Event <> $D
Param2 = ReadByte(File) & $FF
EndIf
If Param1 & $80 Or Param2 & $80
;the MSB is set to 1 for events
RaiseMidiError(#MidiParser_Error_Command)
Else
;the command is valid so parsing continues
Result = #MidiParser_Continue
Handler = EventHandlers(#MidiParser_Event_Command)
If Handler
Result = Handler(Time, Event, channel, Param1, Param2)
EndIf
EndIf
ProcedureReturn Result
EndProcedure
Procedure.l ParseMidiSysEx(File.l, Time.l, Event.l)
Protected Result.l, Size.l, *Buffer
Protected Handler.SysExHandler
Size = ReadVarLen(File)
If Size = #MIDI_VarLen_Error
RaiseMidiError(#MidiParser_Error_SysEx)
Else
*Buffer = AllocateMemory(Size)
EndIf
If *Buffer
ReadData(File, *Buffer, Size)
Result = #MidiParser_Continue
Handler = EventHandlers(#MidiParser_Event_SysEx)
If Handler
Result = Handler(Time, Event, Size, *Buffer)
EndIf
FreeMemory(*Buffer)
Else
FileSeek(File, Loc(File) + Size)
Result = #MidiParser_Continue
EndIf
ProcedureReturn Result
EndProcedure
Procedure.l ParseMidiSystem(File.l, Time.l, Event.l)
Protected Result.l, Param.l
Protected Handler.SystemHandler
Select Event
Case $F1, $F3
Param = ReadByte(File) & $FF
If Param & $80
;the MSB is set to 1 for events
RaiseMidiError(#MidiParser_Error_System)
Param = $FFFFFFFF
EndIf
Case $F2
Param = ReadVarLen(File)
If VarLenSize(Param) <> 2
;this event param takes two bytes
RaiseMidiError(#MidiParser_Error_System)
Param = $FFFFFFFF
EndIf
Case $F4
;???
Case $F5
;???
EndSelect
Handler = EventHandlers(#MidiParser_Event_System)
If Param >= 0 And Handler
Result = Handler(Time, Event, Param)
EndIf
ProcedureReturn Result
EndProcedure
Procedure.l ParseMidiMeta(File.l, Time.l, MetaEvent.l)
Protected Result.l, Size.l, *Buffer
Protected Handler.MetaHandler
Size = ReadVarLen(File)
If Size = #MIDI_VarLen_Error
RaiseMidiError(#MidiParser_Error_Meta)
Else
;if size = 0, force memory allocation
*Buffer = AllocateMemory(Size + 1)
EndIf
If *Buffer
ReadData(File, *Buffer, Size)
Result = #MidiParser_Continue
Handler = EventHandlers(#MidiParser_Event_Meta)
If Handler
Result = Handler(Time, MetaEvent, Size, *Buffer)
EndIf
FreeMemory(*Buffer)
Else
FileSeek(File, Loc(File) + Size)
Result = #MidiParser_Continue
EndIf
ProcedureReturn Result
EndProcedure
Procedure.l ParseMidiChunk(File.l, *Chunk.MIDICHUNK)
Protected Result.l, *Buffer
Protected Handler.ChunkHandler
If *Chunk\dwSize
*Buffer = AllocateMemory(*Chunk\dwSize)
EndIf
If *Buffer
ReadData(File, *Buffer, *Chunk\dwSize)
Result = #MidiParser_Continue
Handler = EventHandlers(#MidiParser_Event_Chunk)
If Handler
Result = Handler(*Chunk\dwType, *Chunk\dwSize, *Buffer)
EndIf
FreeMemory(*Buffer)
Else
FileSeek(File, Loc(File) + *Chunk\dwSize)
Result = #MidiParser_Continue
EndIf
ProcedureReturn Result
EndProcedure
;> ------------------- <
;- MidiParser : Public
;> ------------------- <
ProcedureDLL.l SetMidiEventHandler(EventType.l, Callback.l)
Protected Set.l
;If Callback is Null then the EventType is not catched (default behavior)
If EventType >= #MidiParser_Event_Header And EventType <= #MidiParser_Event_Error
EventHandlers(EventType) = Callback
Set = #True
EndIf
ProcedureReturn Set
EndProcedure
ProcedureDLL.l ParseMidiFile(Filename.s)
Protected Parsed.l, File.l, KeepParsing.l
Protected nTracks.l, Event.l, MetaEvent.l
Protected DeltaTime.l, Time.l, Old.l, Loc.l
Protected Chunk.MIDICHUNK
Protected Header.MIDIHEADER
File = ReadFile(#PB_Any, Filename)
If File
KeepParsing = ParseMidiHeader(File, Header)
;
; Chunk loop (catch all chunks till the end of file)
;
While KeepParsing And Not Eof(File)
;if not EOF then there must be another chunk
If Lof(File) - Loc(File) < SizeOf(MIDICHUNK)
KeepParsing = RaiseMidiError(#MidiParser_Error_EOF)
Else
Chunk\dwType = ReadLong(File)
Chunk\dwSize = ReadBigEndianL(File)
EndIf
;if remaining size is enough, identify the chunk
If KeepParsing And Lof(File) - Loc(File) < Chunk\dwSize
KeepParsing = RaiseMidiError(#MidiParser_Error_EOF)
ElseIf KeepParsing
Select Chunk\dwType
Case #MIDI_Chunk_Track
;inform the user that a new track is about to be parsed
KeepParsing = ParseMidiTrack()
nTracks + 1 ;internal track counter
Case #MIDI_Chunk_Header
;this chunk only append at the begining of the file
KeepParsing = RaiseMidiError(#MidiParser_Error_Header)
Default
;we don't know this chunk...
KeepParsing = ParseMidiChunk(File, Chunk)
EndSelect
EndIf
;
; Track parser (catch all events till the end of the track)
;
If KeepParsing And Chunk\dwType = #MIDI_Chunk_Track
;exprected file location at the end of the track
Loc = Loc(File) + Chunk\dwSize
;reset values
Time = 0
MetaEvent = 0
While Not (Event = $FF And MetaEvent = $2F) ;While Not EndOfTrack
DeltaTime = ReadVarLen(File)
Time + DeltaTime
If DeltaTime = #MIDI_VarLen_Error
RaiseMidiError(#MidiParser_Error_Time)
Break
EndIf
Old = Event
Event = ReadByte(File) & $FF
;Events have MSB set to 1 (ie >= $80)
;If not, it's a param for the next event
;the next event is the same as the previous
If Event < $80
FileSeek(File, Loc(File)-1)
Event = Old
EndIf
Select Event
Case $80 To $EF
KeepParsing = ParseMidiCommand(File, Time, Event)
Case $F0, $F7
KeepParsing = ParseMidiSysEx(File, Time, Event)
Case $FF
MetaEvent = ReadByte(File) & $FF
If MetaEvent & $80
;the MSB is set to 1 for events
KeepParsing = RaiseMidiError(#MidiParser_Error_Meta)
Else
KeepParsing = ParseMidiMeta(File, Time, MetaEvent)
EndIf
Default
KeepParsing = ParseMidiSystem(File, Time, Event)
EndSelect
;the user doesn't want to continue ?
;an error has occured ?
If Not KeepParsing
;whatever... just stop parsing
Break
EndIf
Wend ;While Not EndOfTrack
;the chunk size is not the specified size
If Loc <> Loc(File)
KeepParsing = RaiseMidiError(#MidiParser_Error_Track)
EndIf
EndIf ;Track parser
Wend ;Chunk loop
;the number of tracks is not valid
If nTracks <> Header\wCount
KeepParsing = RaiseMidiError(#MidiParser_Error_Track)
EndIf
;it's finally over ^_^
If KeepParsing
Parsed = #True
EndIf
CloseFile(File)
Else
RaiseMidiError(#MidiParser_Error_File)
EndIf
ProcedureReturn Parsed
EndProcedure
;> ---------------- <
;- MidiParser : EOF
;> ---------------- <
Code: Select all
IncludeFile "lib_midi.pb"
DisableExplicit
Procedure ShowMidiError(code)
Select code
Case #MidiParser_Error_File
Debug "Error : Cannot open the file"
Case #MidiParser_Error_Header
Debug "Error : Header Error"
Case #MidiParser_Error_EOF
Debug "Error : Unexpected EOF"
Case #MidiParser_Error_Time
Debug "Error : Invalid Delta-Time"
Case #MidiParser_Error_Command
Debug "Error : Command param"
Case #MidiParser_Error_SysEx
Debug "Error : System Exclusive Event"
Case #MidiParser_Error_System
Debug "Error : System Event param"
Case #MidiParser_Error_Meta
Debug "Error : Meta-event error"
EndSelect
EndProcedure
Procedure ShowMidiHeader(type, Count, Delta)
Debug "FormatType : " + Str(type)
Debug "NumberOfTracks : " + Str(Count)
Debug "DeltaTimeIncrement (BPM ?) : " + StrD(6E4 / Delta)
Debug "---"
ProcedureReturn #MidiParser_Continue
EndProcedure
Procedure ShowMidiTrack()
Debug "TrackChunk"
ProcedureReturn #MidiParser_Continue
EndProcedure
Procedure ShowMidiChunk(type, Size, *Buffer)
Debug "Unknown chunk : " + PeekS(@type, 4)
ProcedureReturn #MidiParser_Continue
EndProcedure
Procedure ShowMidiCommand(Time, Event, channel, Param1, Param2)
Select Event
Case $8
Debug Str(Time) + " -> Channel : " + Str(channel) + " Note Off : " + Str(Param1) + " Velocity : " + Str(Param2)
Case $9
Debug Str(Time) + " -> Channel : " + Str(channel) + " Note On : " + Str(Param1) + " Velocity : " + Str(Param2)
EndSelect
ProcedureReturn #MidiParser_Continue
EndProcedure
Procedure ShowMidiMeta(Time, meta, Size, *Buffer)
Select meta
Case $51
tempo = PeekBigEndianN(*Buffer, Size)
Debug Str(Time) + " -> Set Tempo (BPM) : " + StrD(6E7 / tempo)
Case $2F
Debug "EndOfTrack"
Debug "---"
EndSelect
ProcedureReturn #MidiParser_Continue
EndProcedure
SetMidiEventHandler(#MidiParser_Event_Error, @ShowMidiError() )
SetMidiEventHandler(#MidiParser_Event_Header, @ShowMidiHeader() )
SetMidiEventHandler(#MidiParser_Event_Track, @ShowMidiTrack() )
SetMidiEventHandler(#MidiParser_Event_Command, @ShowMidiCommand())
SetMidiEventHandler(#MidiParser_Event_Meta, @ShowMidiMeta() )
MidiFileName$ = OpenFileRequester("Open midi file", "", "Midi|*.mid;*.midi", 0)
If ParseMidiFile(MidiFileName$)
Debug GetFilePart(MidiFileName$) + " parsing is over"
Else
Debug "An error as occured while parsing " + GetFilePart(MidiFileName$)
EndIf
)
