minimy, I made a midi file player starting with your code. It has been a long and much more difficult journey that I expected or should be. It opens and plays files and includes adjustable tempo. The problem is it only plays MIDI type 0 files. These are not common and it makes the whole thing pretty futile. If you wish to convert a file to type 0 you can use this tool
The bpm adjustment only works while the song is paused or before it starts.
If it's a type 1 file it plays a scale.
Code: Select all
; Midi File Player - WINDOWS only
; By CD Xbow and CP.
; MIDIGUIPlayer2.pb
; WARNING Only plays MIDI type 0 files
; Started with code by minimy - https://www.purebasic.fr/english/viewtopic.php?p=613600&hilit=midi#p613600
EnableExplicit
Global salidaMIDI, midiFileName.s = ""
Global playing = #False
Global paused = #False
Global stopped = #True
Global bpm = 120
Global playThread
Global noteIndex = 0
Global midiFileLoaded = #False
Global midiData$ = ""
Global midiPos = 0
Global midiTicksPerQuarter = 480 ; default, will be set from file
Global midiEventsCount = 0
Global Dim midiEvents.l(0)
Global midiEventIndex = 0
Global midiFileType = 0
Enumeration
#Win
#BtnOpen
#BtnPlay
#BtnPause
#BtnStop
#LblFile
#TrackTempo
#LblBPM
EndEnumeration
Procedure startMidi()
If midiOutOpen_(@salidaMIDI, 0, 0, 0, 0) = #MMSYSERR_NOERROR
; OK
Else
MessageRequester("ERROR","No MIDI device found.")
End
EndIf
EndProcedure
Procedure setMidiInstrument(canal=0, instrumento=0)
Protected chain = ($C0 | canal) | (instrumento << 8)
midiOutShortMsg_(salidaMIDI, chain)
EndProcedure
Procedure SendMidiEvent(ev.l)
midiOutShortMsg_(salidaMIDI, ev)
EndProcedure
Procedure PlayMidiNote(canal=0, nota=60, volume=127, duracion=300)
Protected note = ($90 | canal) | (nota << 8) | (volume << 16)
midiOutShortMsg_(salidaMIDI, note)
Delay(duracion)
; Note Off (Note On with velocity 0)
note = ($90 | canal) | (nota << 8)
midiOutShortMsg_(salidaMIDI, note)
EndProcedure
Procedure.i ReadIntLE(*buf)
; Read 4 bytes, big endian to little endian
Protected b1 = PeekA(*buf)
Protected b2 = PeekA(*buf+1)
Protected b3 = PeekA(*buf+2)
Protected b4 = PeekA(*buf+3)
ProcedureReturn (b1<<24) | (b2<<16) | (b3<<8) | b4
EndProcedure
Procedure.i ReadWordBE(*buf)
; Read 2 bytes, big endian
ProcedureReturn (PeekA(*buf)<<8) | PeekA(*buf+1)
EndProcedure
Procedure.i ReadVarLen(*buf, *len.Integer)
Protected val = 0
Protected c, cnt = 0
Repeat
c = PeekA(*buf+cnt)
val << 7
val | (c & $7F)
cnt + 1
Until (c & $80) = 0
*len\i = cnt
ProcedureReturn val
EndProcedure
; --- Minimal MIDI file parser for Type 0 (single track) ---
Procedure ParseMidiFile(filename$)
Protected filelen = FileSize(filename$)
If filelen < 16 : ProcedureReturn 0 : EndIf
Dim midiEvents.l(10000) ; Up to 10k events
midiEventsCount = 0
midiTicksPerQuarter = 480
midiEventIndex = 0
midiFileType = 0
If ReadFile(0, filename$)
Protected *buf = AllocateMemory(filelen)
If *buf
ReadData(0, *buf, filelen)
CloseFile(0)
; Check header
If PeekS(*buf, 4, #PB_Ascii) <> "MThd"
FreeMemory(*buf)
ProcedureReturn 0
EndIf
midiFileType = ReadWordBE(*buf+8)
midiTicksPerQuarter = ReadWordBE(*buf+12)
; Only handle type 0 for now
If midiFileType <> 0
FreeMemory(*buf)
ProcedureReturn 0
EndIf
; Find track
Protected trkpos = 14
While trkpos < filelen-8
If PeekS(*buf+trkpos, 4, #PB_Ascii) = "MTrk"
Protected trackLen = ReadIntLE(*buf+trkpos+4)
Protected p = trkpos + 8
Protected trackEnd = p + trackLen
Protected delta, status, dat1, dat2, ev, vlen, len, runningStatus=0
Protected absTick = 0
While p < trackEnd
delta = ReadVarLen(*buf+p, @vlen)
p + vlen
absTick + delta
status = PeekA(*buf+p)
If status & $80
runningStatus = status
p + 1
Else
status = runningStatus
EndIf
If (status & $F0) = $90 ; Note On
dat1 = PeekA(*buf+p)
dat2 = PeekA(*buf+p+1)
p + 2
If dat2 > 0
; Pack: absTick (high word), status|dat1|dat2 (low word)
midiEvents(midiEventsCount) = (absTick<<16) | (status<<8) | (dat1) | (dat2<<16)
midiEventsCount + 1
EndIf
ElseIf (status & $F0) = $80 ; Note Off
dat1 = PeekA(*buf+p)
dat2 = PeekA(*buf+p+1)
p + 2
; Treat as Note On with velocity 0
midiEvents(midiEventsCount) = (absTick<<16) | ($90<<8) | (dat1)
midiEventsCount + 1
ElseIf (status & $F0) = $C0 ; Program Change
dat1 = PeekA(*buf+p)
p + 1
; Optional: handle instrument
ElseIf status = $FF ; Meta event
dat1 = PeekA(*buf+p)
p + 1
len = ReadVarLen(*buf+p, @vlen)
p + vlen + len
Else
; Skip unknowns (could be CC, etc)
p + 2
EndIf
If midiEventsCount >= ArraySize(midiEvents())-2
Break
EndIf
Wend
Break ; Only first track
EndIf
trkpos + 1
Wend
FreeMemory(*buf)
ReDim midiEvents(midiEventsCount)
If midiEventsCount > 0
ProcedureReturn 1
EndIf
EndIf
CloseFile(0)
EndIf
ProcedureReturn 0
EndProcedure
Procedure PlayMidiThread(*dummy)
Protected lastTick = 0, absTick, status, dat1, dat2, delay, i, interval
Protected qn_ms = 60000/bpm
While playing
If paused Or stopped
Delay(10)
Continue
EndIf
If midiFileLoaded And midiEventsCount > 0
; Real MIDI file play
For i = midiEventIndex To midiEventsCount-1
absTick = midiEvents(i)>>16
status = (midiEvents(i)>>8) & $FF
dat1 = midiEvents(i) & $FF
dat2 = (midiEvents(i)>>16) & $7F
delay = (absTick - lastTick) * qn_ms / midiTicksPerQuarter
If delay > 0 : Delay(delay) : EndIf
If (status & $F0) = $90 ; Note On
Protected msg = ($90 | (status & $0F)) | (dat1<<8) | (dat2<<16)
midiOutShortMsg_(salidaMIDI, msg)
; For simplicity, send Note Off after fixed time
Delay(qn_ms/4)
msg = ($90 | (status & $0F)) | (dat1<<8)
midiOutShortMsg_(salidaMIDI, msg)
EndIf
lastTick = absTick
If paused Or stopped : Break : EndIf
Next
playing = #False
stopped = #True
Else
; Dummy notes
interval = Int(60000 / bpm)
PlayMidiNote(0, 60, 127, interval-20)
PlayMidiNote(0, 64, 127, interval-20)
PlayMidiNote(0, 67, 127, interval-20)
PlayMidiNote(0, 72, 127, interval-20)
EndIf
Wend
EndProcedure
Procedure OpenMIDI()
Protected file.s = OpenFileRequester("Select MIDI File", "", "MIDI files (*.mid)|*.mid", 0)
If file
midiFileName = file
SetGadgetText(#LblFile, GetFilePart(file))
midiFileLoaded = ParseMidiFile(file)
midiEventIndex = 0
stopped = #True
paused = #False
playing = #False
SetGadgetText(#BtnPlay, "Play")
EndIf
EndProcedure
Procedure Play()
If Not playing
playing = #True
paused = #False
stopped = #False
SetGadgetText(#BtnPlay, "Playing...")
playThread = CreateThread(@PlayMidiThread(), 0)
ElseIf paused
paused = #False
SetGadgetText(#BtnPlay, "Playing...")
EndIf
EndProcedure
Procedure Pause()
If playing
paused = #True
SetGadgetText(#BtnPlay, "Play")
EndIf
EndProcedure
Procedure Stop()
If playing
stopped = #True
paused = #False
playing = #False
midiEventIndex = 0
SetGadgetText(#BtnPlay, "Play")
Delay(50)
If playThread
KillThread(playThread)
playThread = 0
EndIf
midiOutReset_(salidaMIDI)
EndIf
EndProcedure
Procedure ChangeTempo()
bpm = GetGadgetState(#TrackTempo)
SetGadgetText(#LblBPM, "BPM: " + Str(bpm))
EndProcedure
; --- MAIN ---
OpenWindow(#Win, 0, 0, 350, 180, "MIDI GUI Player", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ButtonGadget(#BtnOpen, 10, 10, 80, 28, "Open MIDI")
TextGadget(#LblFile, 100, 16, 230, 24, "[No file selected]")
ButtonGadget(#BtnPlay, 10, 50, 60, 28, "Play")
ButtonGadget(#BtnPause, 80, 50, 60, 28, "Pause")
ButtonGadget(#BtnStop, 150, 50, 60, 28, "Stop")
TextGadget(#LblBPM, 230, 60, 80, 24, "BPM: 120")
TrackBarGadget(#TrackTempo, 10, 100, 320, 25, 40, 240)
SetGadgetState(#TrackTempo, 120)
startMidi()
setMidiInstrument(0,0) ; Piano
Repeat
Select WaitWindowEvent(10)
Case #PB_Event_CloseWindow
Stop()
Break
Case #PB_Event_Gadget
Select EventGadget()
Case #BtnOpen
OpenMIDI()
Case #BtnPlay
Play()
Case #BtnPause
Pause()
Case #BtnStop
Stop()
Case #TrackTempo
ChangeTempo()
EndSelect
EndSelect
ForEver
Stop()
midiOutClose_(salidaMIDI)
A good learning experience or a painful waste of time. I'm still deciding.
I wanted to try portmidi which handles type 1 midi files and allows much more control. Unfortunately the only 'alleged' 64 bit DLL I could find was from
I am always filled with dread when I have to use a DLL of uncertain provenance. The only alternative is to compile a 64bit DLL. Me and C often don't agree, so I haven't decided what to do yet.
when i answer 
