Proog FBMIDI Library - play MIDI Files

External libraries (GTK, GSL, SDL, Allegro, OpenGL, etc) questions.
oog
Posts: 124
Joined: Jul 08, 2011 20:34

Proog FBMIDI Library - play MIDI Files

Postby oog » May 27, 2018 8:54

Load and play MIDI Files

License is LGPL V3
http://www.gnu.org/licenses/lgpl-3.0.en.html

This library can be use to load and playback MIDI files from within a FreeBASIC Program. The library is an advanced version of the MIDI functions from the FreeBASIC MIDI / Karaoke Player (see https://freebasic.net/forum/viewtopic.php?f=8&t=25312).

During playback you can enable/disable single tracks. This can be used to switch between different versions of a melody. It can be useful if you use it for playing background music in a game. You can have a slower melody version (1/2 and 1/4 notes) in one track and a faster version (1/8 and 1/16 notes) in another track and switch to the fast version, if the game has more action.

There are some demo programs included to show how it works.

    fbmidi.bi FBMIDI Library - will be included in the demo programs
    demo01file.bas Analyze MIDI File - hex-dump
    demo02chunk.bas Analyze MIDI File - chunks
    demo03tracks.bas Analyze MIDI File - information about tracks
    demo04events.bas Analyze MIDI File - all MIDI-events in a track
    demo05lyrics.bas Analyze MIDI File - lyrics from KARAOKE MIDI file
    demo06play.bas Play MIDI File - simple player
    demo07play.bas Play MIDI File - more complex player

This version of FBMIDI actually supports only Windows.
oog
Posts: 124
Joined: Jul 08, 2011 20:34

Re: Proog FBMIDI Library - play MIDI Files

Postby oog » May 27, 2018 8:55

The library "fbmidi.bi"

Code: Select all

' FBMIDI - MIDI Library for FreeBASIC by oog / Proog.de
'
' A FreeBASIC MIDI Player Library
' load / analyse / playmidi files
' copyright by oog/proog.de 2013-2018
'
' License: LGPL V3
'
'This program is free software: you can redistribute it and/or modify
'    it under the terms of the GNU Lesser Public License as published by
'    the Free Software Foundation, either version 3 of the License, Or
'    (at your option) any later version.
'
'    This program is distributed in the hope that it will be useful,
'    but WITHOUT ANY WARRANTY; without even the implied warranty of
'    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'    GNU Lesser Public License for more details.
'
'    You should have received a copy of the GNU Lesser Public License
'    along with this program.  If not, see <http://www.gnu.org/licenses/>.
   
   
'first version in 2018 -> 1801
#define FBMIDIVERSION 1801


'---------- play MIDI ----------
'Thanks to Mysoft who explained, how to use MIDI on Windows
'Link : http://www.freebasic.net/forum/viewtopic.php?t=12995
'Title: QB like PLAY plus more...



#if defined(__FB_WIN32__) Or defined(__FB_WIN64__)

#include once "windows.bi"
#include once "win\mmsystem.bi"

#else

#error "Sorry, FBMIDI actually supports Windows only."

#endif


type MidiMessage field=1
  Number as UByte
  ParmA as UByte
  ParmB as UByte
  Reserved as UByte
end Type


#define MidiSendMessage(MSGVAR) midiOutShortMsg(MYPLAYDEVICE, *cptr(integer ptr,@MSGVAR))


Type thdChunk
  startAddr    As Integer
  chunkID      As String
  chunkSize    As UInteger
  formatType   As Integer
  numOfTracks  As Integer
  timeDivision As Integer
End Type


Type ttrChunk
  startAddr   As Integer
  chunkID     As String
  chunkSize   As UInteger
End Type


Type ttrInfo
  'track info / analyse
  enabled     As Integer    'if 0, track will not be played
  'string events of the same type will be concatenated, separated by const stringSeparator
  Copyright   As String     'copyright information.
  stName      As String     'Sequence/Track Name
  instrument  As String     'Instrument Name
  lastTicks   As Integer    'ticks counter of last event (~track length)
  seqNumber   As Integer    'Sequence Number, pattern number of a Type 2 MIDI file
                            'or the number of a sequence in a Type 0
                            'or Type 1 MIDI file
  loNote      As Integer    'lowest note of track (to scale graphics)
  hiNote      As Integer    'highest note of track (to scale graphics)
  numEvents   As Integer    'count number of all events
  noteEvents  As Integer    'count number of note events
  useChannels As Integer    'bit0 = channel 0, bit15 = channel 15
  textEvents  As Integer    'meta FF01, track notes, comments, etc., usually ASCII
  lyrics      As Integer    'meta FF05, Karaoke, usually a syllable or group of works per quarter note.
  marker      As Integer    'Marker
  cuePoint    As Integer    'Cue Point
  prefix      As Integer    'MIDI Channel Prefix
  port        As Integer    'MIDI Port Select
  endOT       As Integer    'End Of Track
  tempo       As Integer    'Set Tempo
  sOffset     As Integer    'SMPTE Offset
  timeSig     As Integer    'Time Signature
  keySig      As Integer    'Key Signature
  seqSpec     As Integer    'Sequencer Specific
  sysEx       As Integer    'SysEx Event
  unknown     As Integer    'unkwown event
End Type


Enum ParameterType
  noParameter             ' 0: no Parameter
  channel_Para1           ' 1: EvPara1
  channel_Para1_Para2     ' 2: EvPara1, EvPara2
  vString                 ' 3: variable String on heap, evPara1=Heap Pointer
                          '    first byte is counter
  vData                   ' 4: variable data on heap, evPara1=Heap Pointer
                          '    first byte is counter
  bit7FlagData            ' 5: variable data on heap, evPara1=Heap Pointer
                          '    last byte has bit7=1
  vUndefined              ' 6: event code is undefined, so paraType is also
End Enum

Type tEvent
  evDTime As Integer      'time source (relative ticks / Quarternote)
  evTicks As Integer      'sum of ticks from start (absolute)
  evCode As Integer       '0x80-0xFF / 0xFF00-0xFFFF
  evAddr As Integer       'address of event in MIDI file (when load from file)
  setTempo As Integer     'Microseconds/Quarter-Note or 0
  pType As ParameterType  'see enum ParameterType
  evPara1 As Integer      '0x00-0x7F / Heap Pointer
  evPara2 As Integer      '0x00-0x7F / Data Index
  pNext As tEvent Ptr     'chain pointer
  pPrev As tEvent Ptr     'chain pointer
End Type

Type tSequence
  pEvent As tEvent Ptr    'MIDI event
  playTime As Double      'playtime in seconds
  trackIdx As Integer     'track index number (0 = Track 1...)
  pNext As tSequence Ptr  'chain pointer
End Type


Type tEventInfo
  paraType As ParameterType   'see enum ParameterType
  paraName As String          'Parameter Code Name
End Type


'---------- set global tempo ----------
'Set Tempo to default value 120 beats per minute.
'The value is set in Microseconds/Quarter-Note.
'---- Sonic Spot: ----
'The following formula's can be used to translate
'the tempo from microseconds per quarter-note to
'beats per minute and back.
'
'MICROSECONDS_PER_MINUTE = 60000000
'BPM = MICROSECONDS_PER_MINUTE / MPQN
'MPQN = MICROSECONDS_PER_MINUTE / BPM
'
#macro setGlobalTempo()
  globalTempo=60000000/120
#endmacro

'---------- Calculate MIDI song tempo ----------
'Global Definition (Header Chunk):
'globalDivision = n Ticks / qnote (for example 192)
'
'Tempo changes (MIDI event)
'Set Tempo = n µs/MIDI quarter-note (for example 500000)
'
'Count Ticks (dTime) of the MIDI events
'actual qNote position = actualTick / globalDivision
'actual time = actual qNote position * Tempo / 1E6


Type FBMIDI

  Public:
 
  '---------- global declarations ----------
  Const maxCounter=&H100000 'read max 1 MB file size
  Const maxEvents=999999
  Const maxTracks=999
  Const maskEventType       = &Hf0  'hi nibble=event type, lo nibble=channel
  Const evNoteOff           = &H80    'note number    velocity
  Const evNoteOn            = &H90    'note number    velocity
  Const evNoteAftertouch    = &HA0    'note number    aftertouch value
  Const evController        = &HB0    'controller number    controller value
  Const evProgramChange     = &HC0    'program number    not used
  Const evChannelAftertouch = &HD0    'aftertouch value    not used
  Const evPitchBend         = &HE0  'pitch value (LSB)    pitch value (MSB)
  Const maskChannel         = &H0f  'hi nibble=event type, lo nibble=channel
  Const cDrumtrack          = 9     'DrumTrack is channel 9 of 0..15 (or 10 of 1..16)
  Const stringSeparator = "|"
 
  '---------- global variables ----------
  As MidiMessage MidiMsg
  As HMIDIOUT MYPLAYDEVICE     '// MIDI device interface for sending MIDI output
  As String infile, outfile
  As UByte midiDat(maxCounter)
  As Integer addressCounter, filesize, outf
  As UInteger globalNumOfTracks
  As Integer globalFormatType
  As longint globalDivision
  As longint globalTempo
  As Double globalPlaytime
  Const heapMax=999999
  As Integer heap(heapMax)
  As Integer heapPtr
  Const textinfoMax=9999
  As String  textinfo(textinfoMax)
  As Integer textinfoPtr
  As tEvent Ptr track(maxTracks)
  As ttrInfo tInf(maxTracks)
  As tEvent Ptr playEvent(maxTracks)  'cursor to next event of this track
  As Integer trackPtr=1
  As Integer transpose

  '---------- Informations, used by playMidi() ----------
  As String globalInfInfo
  As String globalInfTitle

  '---------- Lyrics string array ----------
  Const maxLyrics=999
  As String lyrics(maxLyrics)
  As tSequence Ptr lyricsStartEvent(maxLyrics)
  As Integer lyricsCount

  ' variables for analyseKaraoke()
  As Integer globalKaraokeWordsTrack
  As Integer globalKaraokeTypeTrack
  As Integer globalKaraokeType
  As Integer globalLyricsTrack
  As Integer globalTextIsLyrics
  ' variables for playMidiEvent()
  As Integer cursX, cursY
  ' variables for playMidi()
  As tSequence Ptr nextSeq
  As Integer nextEvent
  As tEvent Ptr thisEvent
  As Double startTime
  As Double lastTime
  As tSequence Ptr seq
  '
  Declare Function setup() As Integer
  Declare Sub loadFile(fName As String)
  Declare Function intLeft(n As Integer, size As Integer) As String
  Declare Sub pr(s As String="")
  Declare Function nextByte() As UInteger
  Declare Function headerStr() As String
  Declare Function getTime() As String
  Declare Function num4() As UInteger
  Declare Function num2() As UInteger
  Declare Function getTrackChunk() As ttrChunk
  Declare Function getHeaderChunk() As thdChunk
  Declare Function vNum() As UInteger
  Declare Function eventInfo(eventCode As Integer) As tEventInfo
  Declare Sub readEventData(event As tEvent Ptr)
  Declare Function getEvPara(event As tEvent Ptr) As String
  Declare Function getEvString(event As tEvent Ptr) As String
  Declare Function isPlayable(eventCode As Integer) As Integer
  Declare Sub readTrackEvents(trkNum As Integer, trk As tEvent Ptr, startPos As Integer, endPos As Integer)
  Declare Sub readTrackChunk(trk As Integer)
  Declare Sub readHeaderChunk()
  Declare Function readMidi() As Integer
  Declare Sub retimeTrack()
  Declare Sub analyseLyrics()
  Declare Function isEndOfTrack(ev As tEvent Ptr) As Integer
  Declare Sub buildSequence()
  Declare Sub initLoop(songposition As Double)
  Declare Sub AllNotesOff()
  Declare Function getLyricsElement(nextSeq As tSequence Ptr, setGlob As Integer) As String
  Declare Sub readLyrics()
  Declare Sub saveEnergy()
  Declare Sub playMidiEvent(nextSeq As tSequence Ptr)
  Declare Function isEndOfMusic() As Integer
  Declare Sub windTo(songposition As Double)
  Declare Sub playLoop()
  Declare Sub deleteOldSong()
  Private:
End Type


'---------- load file into midiDat() array ----------
'
Sub FBMIDI.loadFile(fName As String)
  var filenum = FreeFile()
  If Open(fName For Binary Access Read As #filenum )=0 Then
    While Not EOF(filenum)
      Get #filenum, , midiDat(filesize)
      filesize += 1
      If filesize>maxCounter Then
        Print "File too long error."
        End
      EndIf
    Wend
    Close #filenum
  EndIf
End Sub


'---------- setup MIDI interface ----------
'
Function FBMIDI.setup() As Integer
  Return midiOutOpen(@MYPLAYDEVICE, MIDI_MAPPER, 0, 0, null)
End Function


'---------- string function - intLeft ----------
'format decimal number, add spaces to reach 'size'
Function FBMIDI.intLeft(n As Integer, size As Integer) As String
Dim As String r
  r=Str(n)
  If Len(r) < size Then
    r=Left(r+Space(size),size)
  EndIf
  Return r
End Function


'---------- get next byte ----------
Function FBMIDI.nextByte() As UInteger
Dim As UByte d
  d=midiDat(addressCounter)
  addressCounter+=1
  Return d
End Function


'---------- get next 4 character string ----------
' chunk ID
Function FBMIDI.headerStr() As String
Dim As String r
  For i As Integer= 1 To 4
    r += Chr(nextByte)
  Next i
  Return r
End Function


'---------- get next n byte v_time value ----------
' add lower 7 bits in a loop
' last byte ist marked with bit7=0
' maximum possible value is signed 16 bit
'
Function FBMIDI.getTime() As String
Dim As UInteger t, d
Dim As String s
  d=nextByte
  s=Hex(d,2)
  t+=d And 127
  While (d And 128) > 0
    t=t Shl 7
    d=nextByte
    s+=" "+Hex(d,2)
    t+=d And 127
  Wend
  Return s+" = "+Str(t)+" Ticks"
End Function


'---------- get next 4 byte number ----------
Function FBMIDI.num4() As UInteger
  Return (nextByte Shl 24) _
       + (nextByte Shl 16) _
       + (nextByte Shl 8) _
       + (nextByte)
End Function


'---------- get next 2 byte number ----------
Function FBMIDI.num2() As UInteger
  Return (nextByte Shl 8) _
       + (nextByte)
End Function


'---------- get next track chunk ----------
Function FBMIDI.getTrackChunk() As ttrChunk
Dim As ttrChunk trChunk
  trChunk.startAddr    =addressCounter
  trChunk.chunkID      =headerStr
  trChunk.chunkSize    =num4
  addressCounter=trChunk.startAddr+trChunk.chunkSize+8
  Return trChunk
End Function


'---------- get next header chunk ----------
' a header chunk is the first chunk in the MIDI file
' set global variables:
'   UInteger chunkNumOfTracks
'   Integer chunkDivision
Function FBMIDI.getHeaderChunk() As thdChunk
Dim As thdChunk hdChunk
  hdChunk.startAddr    =addressCounter
  hdChunk.chunkID      =headerStr
  hdChunk.chunkSize    =num4
  hdChunk.formatType   =num2
  hdChunk.numOfTracks  =num2
  hdChunk.timeDivision =num2
  Return hdChunk
End Function


'---------- sequencer ----------

'---------- get next variable size number (vtime) ----------
Function FBMIDI.vNum() As UInteger
Dim As UInteger n, d
  d=nextByte
  n+=(d And 127)
  While (d And 128) = 128
    n=n Shl 7
    d=nextByte
    n+=(d And 127)
  Wend
  Return n
End Function


'---------- get infos about a MIDI event ----------
'
Function FBMIDI.eventInfo(eventCode As Integer) As tEventInfo
Dim As tEventInfo r
  '1 - define parameter type (pType)
  Select Case eventCode
    Case &H80 to &H8F:  'Note Off
      'r.paraName="Note Off"
      r.paraName="NoteOff"
      r.paraType = channel_Para1_Para2
    Case &H90 to &H9F:  'Note On
      'r.paraName="Note On"
      r.paraName="NoteOn"
      r.paraType = channel_Para1_Para2
    Case &HA0 to &HAF:  'Polyphonic Key Pressure (Aftertouch)
      'r.paraName="Polyphonic Key Pressure (Aftertouch)"
      r.paraName="PolyPress"
      r.paraType = channel_Para1_Para2
    Case &HB0 to &HBF:  'Controller / Channel Mode Messages
      'r.paraName="Controller / Channel Mode Messages"
      r.paraName="Controller"
      r.paraType = channel_Para1_Para2
    Case &HC0 to &HCF:  'Program Change
      'r.paraName="Program Change"
      r.paraName="ProgChange"
      r.paraType = channel_Para1
    Case &HD0 to &HDF:  'Channel Pressure (Aftertouch)
      'r.paraName="Channel Pressure (Aftertouch)"
      r.paraName="ChanPress"
      r.paraType = channel_Para1
    Case &HE0 to &HEF:  'Pitch Bend
      'r.paraName="Pitch Bend"
      r.paraName="PitchBend"
      r.paraType = channel_Para1_Para2
    'System Common Messages
    Case &HF0:      'System Exclusive
      'r.paraName="System Exclusive"
      r.paraName="SysEx"
      r.paraType = vData
    Case &HF1:      'MIDI Time Code Quarter Frame (0nnndddd )
      'r.paraName="MIDI Time Code Quarter Frame"
      r.paraName="TCQF"
      r.paraType = channel_Para1
    Case &HF2:      'Song Position Pointer
      'r.paraName="Song Position Pointer"
      r.paraName="SongPosPt"
      r.paraType = channel_Para1_Para2
    Case &HF3:      'Song Select (0.127)
      'r.paraName="Song Select"
      r.paraName="SongSelect"
      r.paraType = channel_Para1
    Case &HF6:      'Tune Request
      'r.paraName="Tune Request"
      r.paraName="TuneReqest"
      r.paraType = noParameter
    Case &HF7:      'End of System Exclusive (EOX)
      'r.paraName="End of System Exclusive (EOX)"
      r.paraName="EOX"
      r.paraType = noParameter
    'System Real Time Messages - Don't expect in a MIDI file
    Case &HF8:      'Timing Clock
      'r.paraName="Timing Clock"
      r.paraName="TimingClock"
      r.paraType = noParameter
    Case &HFA:      'Start
      'r.paraName="Start"
      r.paraName="Start"
      r.paraType = noParameter
    Case &HFB:      'Continue
      'r.paraName="Continue"
      r.paraName="Continue"
      r.paraType = noParameter
    Case &HFC:      'Stop
      'r.paraName="Stop"
      r.paraName="Stop"
      r.paraType = noParameter
    Case &HFE:      'Active Sensing
      'r.paraName="Active Sensing"
      r.paraName="ActiveSens"
      r.paraType = noParameter
    Case &HFF:      'System Reset
      'r.paraName="System Reset"
      r.paraName="SystemReset"
      r.paraType = noParameter
    'Meta Events
    Case &HFF00:    'Sequence Number
      'Sequence Number - pattern number of a Type 2 MIDI file
      'or the number of a sequence in a Type 0 or Type 1 MIDI file
      'r.paraName="Sequence Number"
      r.paraName="SeqNumber"
      r.paraType = channel_Para1_Para2
    Case &HFF01:    'Text Event
      'r.paraName="Text Event"
      r.paraName="Text"
      r.paraType = vString
    Case &HFF02:    'Copyright Notice
      'r.paraName="Copyright Notice"
      r.paraName="Copyright"
      r.paraType = vString
    Case &HFF03:    'Sequence/Track Name
      'r.paraName="Sequence/Track Name"
      r.paraName="Trackname"
      r.paraType = vString
    Case &HFF04:    'Instrument Name
      'r.paraName="Instrument Name"
      r.paraName="Instrument"
      r.paraType = vString
    Case &HFF05:    'Lyrics
      'r.paraName="Lyrics"
      r.paraName="Lyrics"
      r.paraType = vString
    Case &HFF06:    'Marker
      'r.paraName="Marker"
      r.paraName="Marker"
      r.paraType = vString
    Case &HFF07:    'Cue Point
      'r.paraName="Cue Point"
      r.paraName="CuePoint"
      r.paraType = vString
    Case &HFF20:    'MIDI Channel Prefix - associate channel with next meta events
      'r.paraName="MIDI Channel Prefix (obsolete)"
      r.paraName="ChannelPrefix"
      r.paraType = vData
    Case &HFF21:    'MIDI Port
      'r.paraName="MIDI Port (obsolete)"
      r.paraName="MIDIPort"
      r.paraType = vData
    Case &HFF2F:    'End Of Track
      'r.paraName="End Of Track"
      r.paraName="EndOfTrack"
      r.paraType = vData
    Case &HFF51:    'Set Tempo
      'r.paraName="Set Tempo"
      r.paraName="SetTempo"
      r.paraType = vData
    Case &HFF54:    '
      'r.paraName="SMPTE Offset"
      r.paraName="SMPTEOffset"
      r.paraType = vData
    Case &HFF58:    '
      'r.paraName="Time Signature"
      r.paraName="TimeSignature"
      r.paraType = vData
    Case &HFF59:    '
      'r.paraName="Key Signature"
      r.paraName="KeySignature"
      r.paraType = vData
    Case &HFF7F:    '
      'r.paraName="Sequencer Specific"
      r.paraName="Sequencer"
      r.paraType = vData
    Case Else:    '
      'r.paraName="Undefined"
      r.paraName="Undefined"
      r.paraType = vUndefined
  End Select
  Return r
End Function


'---------- read event data ----------
'
Sub FBMIDI.readEventData(event As tEvent Ptr)
Dim As UByte b
Dim As Integer d
  '1 - define parameter type (pType)
  event->pType = eventInfo(event->evCode).paraType
  '2 - read parameters
  Select Case event->pType
    Case noParameter:
      'no Parameter
      '- nothing to do
    Case channel_Para1:
      'EvPara1
      event->evPara1=nextByte
    Case channel_Para1_Para2:
      'EvPara1, EvPara2
      event->evPara1=nextByte
      event->evPara2=nextByte
    Case vString:
      'variable String on heap, evPara1=Heap Pointer
      'first byte is counter
      d=nextByte
      event->evPara2=textinfoPtr
      For i As Integer=1 To d
        textinfo(textinfoPtr)+=Chr(nextByte)
      Next i
      textinfoPtr+=1
    Case vData:
      'variable data on heap, evPara1=Heap Pointer
      'first byte is counter
      d=nextByte
      event->evPara2=heapPtr
      heap(heapPtr)=d       'size counter byte
      heapPtr+=1
      For i As Integer=1 To d
        heap(heapPtr)=nextByte
        heapPtr+=1
      Next i
      'if event is "Set Tempo" then store tempo change
      If event->evCode = &HFF51 Then
        event->setTempo=(heap(heapPtr-3)Shl 16)_
          +(heap(heapPtr-2)Shl 8)+heap(heapPtr-1)
      EndIf
    Case bit7FlagData:
      'variable data on heap, evPara1=Heap Pointer
      'last byte has bit7=1
      event->evPara2=heapPtr
      Do
        b=nextByte
        heap(heapPtr)=b
        heapPtr+=1
      Loop Until ((b And 128) = 128)
  End Select
End Sub


'---------- get event parameter as string ----------
'
Function FBMIDI.getEvPara(event As tEvent Ptr) As String
Dim As UByte b
Dim As Integer d
Dim As String s
  Select Case event->pType
    Case noParameter:
      'no Parameter
      '- nothing to do
      s="--"
    Case channel_Para1:
      'EvPara1
      s=Hex(event->evCode,1)+" "+Hex(event->evPara1,2)
    Case channel_Para1_Para2:
      'EvPara1, EvPara2
      s=Hex(event->evCode,1)+" "+Hex(event->evPara1,2)+" "+Hex(event->evPara2,2)
    Case vString:
      'variable String on heap, evPara1=Heap Pointer
      'first byte is counter
      s=Chr(34)+textinfo(event->evPara2)+Chr(34)
    Case vData:
      'variable data on heap, evPara1=Heap Pointer
      'first byte is counter
      d=event->evPara2
      s="["+Hex(heap(d))+"]"
      For i As Integer=1 To heap(d)
        s+=" "+Hex(heap(event->evPara2+i),2)
      Next i
    Case bit7FlagData:
      'variable data on heap, evPara1=Heap Pointer
      'last byte has bit7=1
      d=event->evPara2
      Do
        b=heap(d)
        d+=1
        s+=Hex(b,2)+" "
      Loop Until ((b And 128) = 128)
  End Select
  Return s
End Function


'---------- get event string-parameter without string delimiters "" ----------
'
Function FBMIDI.getEvString(event As tEvent Ptr) As String
Dim As UByte b
Dim As Integer d
Dim As String s
  s=""
  Select Case event->pType
    Case vString:
      'variable String on heap, evPara1=Heap Pointer
      'first byte is counter
      s=textinfo(event->evPara2)
  End Select
  Return s
End Function


'---------- MIDI event is playable (note on, off...) ----------
'
Function FBMIDI.isPlayable(eventCode As Integer) As Integer
Dim r As Integer = 0
  '1 - define parameter type (pType)
  Select Case eventCode
    Case &H80 to &HEF:
      r=-1
  End Select
  Return r
End Function


'---------- read all events in a chunk ----------
'
Sub FBMIDI.readTrackEvents(trkNum As Integer, trk As tEvent Ptr, startPos As Integer, endPos As Integer)
Dim As tEvent Ptr actEvent
Dim As tEvent Ptr newEvent
Dim As UInteger eventDTime
Dim As UInteger eventCode, runningStatus
Dim As Integer eventAddress
Dim As String s
  addressCounter=startPos
  actEvent=trk
  While addressCounter<endPos
    eventDTime=vNum
    eventAddress=addressCounter
    eventCode=nextByte
    If eventCode=&HFF Then eventCode=&HFF00 Or nextByte
    'Running Status is a data-thinning technique.
    'It allows for the omision of status bytes if the current
    'message to be transmitted has the same status byte
    '(ie the same command and MIDI channel) as the previous
    'message. It thus only applies to Channel (Voice and Mode)
    'messages (0x8n - 0xEn).
    'allow "runnung status" repeat codes
    If (eventCode And &HFF80)=0 Then
      addressCounter-=1
      If runningStatus<>0 Then
        eventCode=runningStatus       'save the running status
      Else
        Print
        Print("ERROR: Running Status is zero at @"+Hex(addressCounter))
      EndIf
    EndIf
    newEvent=new tEvent
    newEvent->pNext=0
    newEvent->pPrev=actEvent
    actEvent->pNext=newEvent
    actEvent=newEvent
    newEvent->evDTime=eventDTime
    newEvent->evCode=eventCode
    newEvent->evAddr=eventAddress
    readEventData(newEvent)
    tInf(trackPtr).enabled=1      'track is enabled by default
    'track info / analyse
    If isPlayable(eventCode) Then
      runningStatus=eventCode       'save the running status
      tInf(trackPtr).noteEvents += 1    'count number of note events
      var ch=1 Shl(eventCode And maskChannel) 'bit0 = channel 0, bit15 = channel 15
      tInf(trackPtr).useChannels = tInf(trackPtr).useChannels Or ch
      If (eventCode And maskEventType) = evNoteOn Then
        'store first note as lowest and highest note
        If tInf(trackPtr).hiNote<0 Then
          tInf(trackPtr).loNote=newEvent->evPara1
          tInf(trackPtr).hiNote=newEvent->evPara1
        Else
          If newEvent->evPara1 < tInf(trackPtr).loNote Then
            tInf(trackPtr).loNote=newEvent->evPara1
          ElseIf newEvent->evPara1 > tInf(trackPtr).hiNote Then
            tInf(trackPtr).hiNote=newEvent->evPara1
          EndIf
        EndIf
      EndIf
    Else
      Select Case eventCode
        Case &H00F0:    'SysEx Event
          tInf(trackPtr).sysEx+=1       'count events
          runningStatus=0               'clear the running status
        Case &H00F0 To &H00F7: 'System Common and System Exclusive messages
          runningStatus=0               'clear the running status
        Case &HFF00:    'Sequence Number
          tInf(trackPtr).seqNumber=newEvent->evPara1 Shl 8 + newEvent->evPara2
        Case &HFF01:    'Text Event: track notes, comments...
          tInf(trackPtr).textEvents+=1  'count events
        Case &HFF02:    'Copyright Notice
          If tInf(trackPtr).Copyright<>"" Then tInf(trackPtr).Copyright += stringSeparator
          tInf(trackPtr).Copyright+=textinfo(newEvent->evPara2)
        Case &HFF03:    'Sequence/Track Name
          If tInf(trackPtr).stName<>"" Then tInf(trackPtr).stName += stringSeparator
          tInf(trackPtr).stName+=textinfo(newEvent->evPara2)
        Case &HFF04:    'Instrument Name
          If tInf(trackPtr).instrument<>"" Then tInf(trackPtr).instrument += stringSeparator
          tInf(trackPtr).instrument+=textinfo(newEvent->evPara2)
        Case &HFF05:    'Karaoke, usually a syllable or group of works per quarter note.
          tInf(trackPtr).lyrics+=1    'count events
        Case &HFF06:    'Marker
          tInf(trackPtr).marker+=1    'count events
        Case &HFF07:    'Cue Point
          tInf(trackPtr).cuePoint+=1  'count events
        Case &HFF20:    'MIDI Channel Prefix
          tInf(trackPtr).prefix+=1    'count events
        Case &HFF21:    'MIDI Port
          tInf(trackPtr).port+=1      'count events
        Case &HFF2F:    'End Of Track
          tInf(trackPtr).endOT+=1     'count events
        Case &HFF51:    'Set Tempo
          tInf(trackPtr).tempo+=1     'count events
        Case &HFF54:    'SMPTE Offset
          tInf(trackPtr).sOffset+=1   'count events
        Case &HFF58:    'Time Signature
          tInf(trackPtr).timeSig+=1   'count events
        Case &HFF59:    'Key Signature
          tInf(trackPtr).keySig+=1    'count events
        Case &HFF7F:    'Sequencer Specific
          tInf(trackPtr).seqSpec+=1   'count events
        Case Else:
          tInf(trackPtr).unknown+=1   'count events
      End Select
    EndIf
    tInf(trackPtr).numEvents += 1       'count number of all events
  Wend
End Sub


'---------- track chunk ----------
Sub FBMIDI.readTrackChunk(trk As Integer)
Dim As tEvent Ptr newEvent
Dim As ttrChunk trChunk
  trChunk=getTrackChunk
  If (trChunk.chunkID <> "MTrk") Then
    Print ("ERROR - invalid Track Chunk "+Str(trk)+":"+trChunk.chunkID)
    'End
  EndIf
  newEvent=new tEvent
  track(trackPtr)=newEvent
  If trackPtr>maxTracks Then
    Print "ERROR: Too much tracks"
    Sleep
    End
  EndIf
  newEvent->pPrev=0
  newEvent->pNext=0
  newEvent->evCode=-1   'track start
  readTrackEvents(trk, newEvent, trChunk.startAddr+8, trChunk.startAddr+trChunk.chunkSize+7)
  trackPtr+=1
End Sub


'---------- header chunk ----------
Sub FBMIDI.readHeaderChunk()
Dim As thdChunk hdChunk
  hdChunk=getHeaderChunk
  globalFormatType=hdChunk.formatType
  globalNumOfTracks=hdChunk.numOfTracks
  globalDivision=hdChunk.timeDivision
  If (globalDivision And &H8000) <> 0 Then
    Print
    Print ("time division="+Str(globalDivision And &H7FFF)+" frames per second")
    Print ("ERROR - Format not supported")
  EndIf
  If (hdChunk.chunkID <> "MThd") OrElse (hdChunk.formatType>2) Then
    Print
    Print ("ERROR - invalid Header Chunk")
    'End
  EndIf
End Sub


'---------- read file from midiDat() array into sequencer ----------
'
Function FBMIDI.readMidi() As Integer
  addressCounter=0
  readHeaderChunk()
  For t As Integer=1 To globalNumOfTracks
    readTrackChunk(t)
  Next t
  'prepare midi sequence for playing
  If trackPtr>1 Then
    retimeTrack()
    initLoop(0)
  EndIf
  Return trackPtr
End Function


'---------- retime midi tracks ----------
'
'calculate absolute tick counter for every event
'from the relative counter dTime
'Call this Sub
' - after song loading and
' - after track-editing
'
Sub FBMIDI.retimeTrack()
Dim As Integer ticksCounter
Dim As tEvent Ptr thisEvent
Dim As String s
  For t As Integer=1 To trackPtr-1
    ticksCounter=0
    thisEvent=track(t)
    While thisEvent<>0
      ticksCounter+=thisEvent->evDTime
      thisEvent->evTicks=ticksCounter
      thisEvent = thisEvent->pNext
    Wend
    'store track lenght (ticksCounter of last event)
    tInf(t).lastTicks=ticksCounter
  Next t
End Sub


'---------- Find out if midi file contains karaoke lyrics ----------
' set globalKaraokeType to 1/2 if format 1/2 has been detected
' set globalKaraokeTypeTrack to the track number with lyrics
' Detect 2 formats
' Format 1: Soft karaoke / WinKaraoke Creator
' Format 2: KarMaker
'
Sub FBMIDI.analyseLyrics()
Dim As tEvent Ptr thisEvent
Dim As String s
  For t As Integer=1 To trackPtr-1
    'Find "Words" Track
    if (tInf(t).stName = "Words") Then globalKaraokeWordsTrack=t
    'Find Track with most lyrics events
    If tInf(t).lyrics>0 Then
      If globalLyricsTrack=0 Then
        globalLyricsTrack=t
        globalTextIsLyrics=(1=1)
      Else
        If tInf(globalLyricsTrack).lyrics < tInf(t).lyrics Then
          globalLyricsTrack=t
        EndIf
      EndIf
    EndIf
    'Karaoke Format 1: Soft karaoke / WinKaraoke Creator
    If (LCase(tInf(t).stName) = "soft karaoke") Then
      globalKaraokeTypeTrack=t
      globalKaraokeType=1
    EndIf
    'Karaoke Format 2: KarMaker
    If (LCase(Left(tInf(t).stName,12)) = "(c) karmaker") Then
      globalKaraokeTypeTrack=t
      globalKaraokeType=2
    EndIf
  Next t
End Sub


'---------- detect end of track by event code or zero pointer ----------
'
Function FBMIDI.isEndOfTrack(ev As tEvent Ptr) As Integer
  If (ev=0) OrElse (ev->evCode=&hFF2F) Then
    Return -1
  Else
    Return 0
  EndIf
End Function


'---------- build sequence "seq" ----------
'
Sub FBMIDI.buildSequence()
Dim As Integer nextEvent
Dim As tEvent Ptr thisEvent
Dim As tSequence Ptr nextSeq
Dim As Double playTime
Dim As Double lastTime
Dim As Integer lastTicks
  setGlobalTempo()  ' set to default value
  While seq<>0
    var cleanup=seq
    seq=seq->pnext
    DELETE cleanup
  Wend
  seq=new tSequence
  nextSeq=seq
  'set playCursors to track start (get first event with pNext)
  For t As Integer=1 To trackPtr-1
    playEvent(t)=track(t)->pNext  '->pNext, because first element is dummy
  Next t
  playTime=0
  lastTime=0
  lastTicks=0
  Do
    'search all tracks for next to play event (time)
    For t As Integer=1 To trackPtr-1
      '1) set nextEvent to a valid track
      If isEndOfTrack(playEvent(nextEvent))_
      AndAlso Not(isEndOfTrack(playEvent(t))) Then
        nextEvent=t
      EndIf
      '2) set what track has the next event in time
      '   but ignore "end of track" event
      If (playEvent(t)<>0)_
      AndAlso (playEvent(t)->evCode <>&HFF2F) _
      AndAlso (playEvent(t)->evTicks <= playEvent(nextEvent)->evTicks) Then
        nextEvent=t
      EndIf
    Next t
    'store next event in sequence
    nextSeq->trackIdx = nextEvent
    nextSeq->pEvent   = playEvent(nextEvent)
    nextSeq->pnext    = new tSequence
    'calculate playtime of actual MIDI event
    playTime=lastTime+(nextSeq->pEvent->evTicks-lastTicks)*globalTempo _
            /globalDivision /1e6
    nextSeq->playTime = playTime
    If playTime>globalPlaytime Then globalPlaytime=playTime
    'if tempo changes -> set new tempo
    If nextSeq->pEvent->setTempo>0 Then
      'MICROSECONDS_PER_MINUTE = 60000000
      'BPM = MICROSECONDS_PER_MINUTE / MPQN
      'MPQN = MICROSECONDS_PER_MINUTE / BPM
      globalTempo=nextSeq->pEvent->setTempo
      lastTicks=nextSeq->pEvent->evTicks
      lastTime=playTime
    EndIf
'    var qNote=nextSeq->pEvent->evTicks / globalDivision
    nextSeq=nextSeq->pnext
    If playEvent(nextEvent)<>0 Then playEvent(nextEvent)=playEvent(nextEvent)->pNext
  Loop Until playEvent(nextEvent)=0
End Sub


'---------- init sequence, prepare for playing loop ----------
'
Sub FBMIDI.initLoop(songposition As Double)
  nextSeq=seq
  startTime=Timer - songposition
  lastTime=startTime
End Sub


'---------- send "All Notes Off" to all channels ----------
'
Sub FBMIDI.AllNotesOff()
  MidiMsg.ParmA  = 123    'All Notes Off
  MidiMsg.ParmB  = 0      'All Notes Off
  For i As Integer=0 To 15
    MidiMsg.Number = evController Or i
    MidiSendMessage(MidiMsg)
  Next i
End Sub


'---------- get next line of lyrics from "seq" ----------
'
Function FBMIDI.getLyricsElement(nextSeq As tSequence Ptr, setGlob As Integer) As String
Dim As String txt
  If (nextSeq <> 0)_
  AndAlso (nextSeq->pEvent <> 0) Then
    If globalTextIsLyrics Then
      If (nextSeq->pEvent->evCode=&HFF05) Then
        txt=getEvString(nextSeq->pEvent)
        If txt<" " Then txt="/"
      EndIf
    Else
      If (nextSeq->pEvent->evCode=&HFF01) Then
        txt=getEvString(nextSeq->pEvent)
        var infoType=Left(txt,2)
        var infoTxt=Right(txt,Len(txt)-2)
        Select Case infoType
          Case "@I":  'Information
            txt=""
            If setGlob Then globalInfInfo+=Chr(13,10)+"  "+infoTxt
          Case "@T":  'Title
            txt=""
            If setGlob Then globalInfTitle+=Chr(13,10)+"  "+infoTxt
          Case "@K":  'ignore (Karaoke Type Info)
            txt=""
          Case "@L":  'ignore (Karaoke Lyrics Language)
            txt=""
          Case "@V":  'ignore (Karaoke File Version)
            txt=""
        End Select
      EndIf
    EndIf
  EndIf
  'Handle KarMaker vocal strings
  '(they might include 0x00 and some additional codes)
  If InStr(txt,Chr(0)) Then
    txt=Left(txt,InStr(txt,Chr(0))-1)
  EndIf
  Return txt
End Function


'---------- read Lyrics into string array ----------
' read lyrics from sequence "seq"
'
Sub FBMIDI.readLyrics()
  nextSeq=seq
  Do
    'wait until next event has to be played
    If nextSeq<>0 _
    AndAlso (nextSeq->pEvent<>0) Then
      var txt=getLyricsElement(nextSeq, 1)
      Select Case Left(txt,1)
        Case "/","\":
          lyricsCount += 1
          lyricsStartEvent(lyricsCount) = nextSeq
          txt=Right(txt,Len(txt)-1)
      End Select
      'print lyrics
      If txt<>"" Then
        lyrics(lyricsCount) += txt
      EndIf
      nextSeq=nextSeq->pNext
    EndIf
    If lyricsCount>=maxLyrics Then
      Print "ERROR: too much lyrics lines"
      End
    EndIf
  Loop Until (nextSeq=0) OrElse (nextSeq->pEvent=0)
  If globalInfTitle="" Then globalInfTitle="- not defined -"
  If globalInfInfo="" Then globalInfInfo="- not defined -"
End Sub


'---------- save energy, sleep while nothing to play ----------
'
Sub FBMIDI.saveEnergy()
  'wait for next event to be played
  'but no longer than 20 ms to prevent blocking user interface
  If nextSeq<>0 _
  AndAlso (nextSeq->pEvent<>0) Then
    If nextSeq->playTime - (Timer-lastTime) > 0.025 Then
      Sleep 20
    Else
      While nextSeq->playTime > (Timer-lastTime)
        Sleep 1
      Wend
    EndIf
  EndIf
End Sub


'---------- play MIDI file (with karaoke text) from "seq" ----------
'
'Dim Shared As Integer cursX, cursY

Sub FBMIDI.playMidiEvent(nextSeq As tSequence Ptr)
  'play next MIDI event
  'if tempo changes -> set new tempo
  If nextSeq->pEvent->setTempo>0 Then
    globalTempo=nextSeq->pEvent->setTempo
  EndIf
  'play note, if channel is enabled
  If tInf(nextSeq->trackIdx).enabled _
  AndAlso isPlayable(nextSeq->pEvent->evCode) Then
    MidiMsg.Number = nextSeq->pEvent->evCode
    MidiMsg.ParmA  = nextSeq->pEvent->evPara1
    MidiMsg.ParmB  = nextSeq->pEvent->evPara2
    'transpose note, but leave drums untouched
    If (MidiMsg.Number And maskChannel) = cDrumtrack Then
      'drums
      MidiSendMessage(MidiMsg)
    Else
      'transpose other instruments
      MidiMsg.ParmA+=transpose
      'play if notes are in a valid range
      If (MidiMsg.ParmA>=0) AndAlso (MidiMsg.ParmA<=127) Then
        'play NoteOn
        MidiSendMessage(MidiMsg)
      EndIf
    EndIf
  EndIf
End Sub


'---------- check if no more to play ----------
'
Function FBMIDI.isEndOfMusic() As Integer
  Return (nextSeq=0) OrElse (nextSeq->pEvent=0)
End Function


'---------- play next MIDI event from "seq" in a loop ----------
'
Sub FBMIDI.windTo(songposition As Double)
  initLoop(songposition)
  If songposition>0 Then
    'search for event to be played
    While nextSeq->playTime <= songposition'(startTime+songposition)
      If (nextSeq=0) _
      OrElse (nextSeq->pEvent=0) Then Exit While
      nextSeq=nextSeq->pNext
    Wend
  EndIf
End Sub


'---------- play next MIDI event from "seq" in a loop ----------
'
Sub FBMIDI.playLoop()
  'wait until next event has to be played
  While nextSeq->playTime <= (Timer-lastTime)
    If (nextSeq=0) _
    OrElse (nextSeq->pEvent=0) Then Exit While
    'play next MIDI event
    playMidiEvent(nextSeq)
    nextSeq=nextSeq->pNext
  Wend
End Sub


'---------- delete infos from last song ----------
'
Sub FBMIDI.deleteOldSong()
  addressCounter=0
  heapPtr=0
  trackPtr=1
  transpose=0
  filesize=0
  For i As Integer=0 To textinfoPtr
    textinfo(i)=""
  next i
  textinfoPtr=0
  For i As Integer=0 To lyricsCount
    lyrics(i)=""
  next i
  lyricsCount=0
  globalInfInfo=""
  globalInfTitle=""
End Sub
oog
Posts: 124
Joined: Jul 08, 2011 20:34

Re: Proog FBMIDI Library - play MIDI Files

Postby oog » May 27, 2018 8:59

demo01file.bas Analyze MIDI File - hex-dump

Code: Select all

' FBMIDI - Demo
' copyright by oog/proog.de 2013-2018
'

#define MIDISONG "midi1.mid"
#include "fbmidi.bi"

'---------- Init ----------
Dim Shared As FBMIDI midi

' open MIDI interface
If (midi.setup() <> MMSYSERR_NOERROR) Then
  Print "Error opening MIDI Output."
  End
EndIf

'---------- MAIN ----------
Cls
Print
Print "FBMIDI Demo, file:'";MIDISONG;"'"

midi.loadFile(MIDISONG)

If midi.readMidi()>1 Then
  Print
  Print ("=========================================")
  Print (" MIDI File Info")
  Print ("=========================================")
  Print
  Print
  Print ("MIDI File        = "+MIDISONG)
  Print ("MIDI Format Type = "+Str(midi.globalFormatType))
  Print ("Number Of Tracks = "+Str(midi.globalNumOfTracks))
  Print ("Time Division    = "+Str(midi.globalDivision)+" Ticks per Beat")
  Print
  Print
  Print ("=========================================")
  Print (" MIDI File Dump")
  Print ("=========================================")
  Print
  Print ("MIDI File Size   = 0x"+Hex(midi.filesize)+" / "+Str(midi.filesize))
  For i As Integer=0 To (midi.filesize-16) / 16
    Dim As Integer a
    'Print file offset address
    Print Hex(i*16,6)+":";
    'Print hex dump
    For j As Integer=0 To 15
      a=i*16+j
      If j=8 Then Print " ";
      If a<=midi.filesize Then
        Print " "+Hex(midi.midiDat(a),2);
      Else
        Print " ..";
      EndIf
    Next j
    'Print ASCII dump
    Print "  ";
    For j As Integer=0 To 15
      a=i*16+j
      If j=8 Then Print " ";
      If a<=midi.filesize Then
        Dim As Integer c=midi.midiDat(a)
        If (c>=32) AndAlso (c<=126) Then
          Print chr(midi.midiDat(a));
        Else
          Print ".";
        EndIf
      Else
        Print " ";
      EndIf
    Next j
    Print
  Next i
EndIf
End


demo02chunk.bas Analyze MIDI File - chunks

Code: Select all

' FBMIDI - Demo
' copyright by oog/proog.de 2013-2018
'

#define MIDISONG "midi1.mid"
#include "fbmidi.bi"

'---------- Init ----------
Dim Shared As FBMIDI midi

' open MIDI interface
If (midi.setup() <> MMSYSERR_NOERROR) Then
  Print "Error opening MIDI Output."
  End
EndIf

'---------- MAIN ----------
Cls
Print
Print "FBMIDI Demo, file:'";MIDISONG;"'"

midi.loadFile(MIDISONG)

If midi.readMidi()>1 Then
  Print
  Print ("=========================================")
  Print (" MIDI File Info")
  Print ("=========================================")
  Print
  Print
  Print ("MIDI File        = "+MIDISONG)
  Print ("MIDI Format Type = "+Str(midi.globalFormatType))
  Print ("Number Of Tracks = "+Str(midi.globalNumOfTracks))
  Print ("Time Division    = "+Str(midi.globalDivision)+" Ticks per Beat")
  Print
  Print
  Print ("=========================================")
  Print (" Header Chunk")
  Print ("=========================================")
  Print
  Dim As thdChunk hdChunk
  Dim As ttrChunk trChunk
  midi.addressCounter=0
  hdChunk=midi.getHeaderChunk
  Print ("startAddr   : 0x"+Hex(hdChunk.startAddr,6)+" / "+Str(hdChunk.startAddr))
  Print ("chunkID     : "+hdChunk.chunkID)
  Print ("chunkSize   : "+Str(hdChunk.chunkSize))
  Print ("formatType  : "+Str(hdChunk.formatType))
  Print ("numOfTracks : "+Str(hdChunk.numOfTracks))
  Print ("timeDivision: "+Str(hdChunk.timeDivision))
  Print
  Print ("=========================================")
  Print (" Track Chunks")
  Print ("=========================================")
  Print
  For t As Integer=1 To midi.globalNumOfTracks
    trChunk=midi.getTrackChunk
    Print
    Print ("Track     : "+Str(t))
    Print ("startAddr : 0x"+Hex(trChunk.startAddr,6)+" / "+Str(trChunk.startAddr))
    Print ("chunkID   : "+trChunk.chunkID)
    Print ("chunkSize : "+Str(trChunk.chunkSize))
    Print
  Next t
EndIf
End


demo03tracks.bas Analyze MIDI File - information about tracks

Code: Select all

' FBMIDI - Demo
' copyright by oog/proog.de 2013-2018
'

#define MIDISONG "midi1.mid"
#include "fbmidi.bi"

'---------- Init ----------
Dim Shared As FBMIDI midi

'---------- print file from midiDat() array from sequencer ----------
'
Function showTrackInfo(t As Integer) As String
Dim As String s
  s=Chr(13,10)+"Track "+midi.intLeft(t,2)
  If midi.tInf(t).seqNumber Then s+=" Sequence Number:"+midi.intLeft(midi.tInf(t).seqNumber,2)
  If midi.tInf(t).lastTicks Then
    s+=Chr(13,10)
    s+=" Ticks Counter: "+midi.intLeft(midi.tInf(t).lastTicks,5)
    s+=Chr(13,10)
    s+=" Quarter Notes: "+midi.intLeft(midi.tInf(t).lastTicks\midi.globalDivision,5)
  EndIf
  If midi.tInf(t).numEvents>1 Then
    s+=Chr(13,10)
    s+=" Num of Events: "+midi.intLeft(midi.tInf(t).numEvents-1,4)
    If (midi.tInf(t).loNote + midi.tInf(t).hiNote) > 0 Then
      s+=Chr(13,10)+" -               Lowest Note: "+midi.intLeft(midi.tInf(t).loNote,4)
      s+=Chr(13,10)+" -              Highest Note: "+midi.intLeft(midi.tInf(t).hiNote,4)
    EndIf
    s+=Chr(13,10)+" -               Note Events: "+midi.intLeft(midi.tInf(t).noteEvents,4)
    s+=Chr(13,10)+" -               Text Events: "+midi.intLeft(midi.tInf(t).textEvents,3)
    s+=Chr(13,10)+" -                    Lyrics: "+midi.intLeft(midi.tInf(t).lyrics,3)
    s+=Chr(13,10)+" -                    Marker: "+midi.intLeft(midi.tInf(t).marker,3)
    s+=Chr(13,10)+" -                 Cue Point: "+midi.intLeft(midi.tInf(t).cuePoint,3)
    s+=Chr(13,10)+" - OBSOLETE MIDI Chan Prefix: "+midi.intLeft(midi.tInf(t).prefix,3)
    s+=Chr(13,10)+" -        OBSOLETE MIDI Port: "+midi.intLeft(midi.tInf(t).port,3)
    s+=Chr(13,10)+" -              End Of Track: "+midi.intLeft(midi.tInf(t).endOT,3)
    s+=Chr(13,10)+" -                 Set Tempo: "+midi.intLeft(midi.tInf(t).tempo,3)
    s+=Chr(13,10)+" -              SMPTE Offset: "+midi.intLeft(midi.tInf(t).sOffset,3)
    s+=Chr(13,10)+" -            Time Signature: "+midi.intLeft(midi.tInf(t).timeSig,3)
    s+=Chr(13,10)+" -             Key Signature: "+midi.intLeft(midi.tInf(t).keySig,3)
    s+=Chr(13,10)+" -         Seqencer Specific: "+midi.intLeft(midi.tInf(t).seqSpec,3)
    s+=Chr(13,10)+" -              SysEx Events: "+midi.intLeft(midi.tInf(t).sysEx,3)
    s+=Chr(13,10)+" -            Unknown Events: "+midi.intLeft(midi.tInf(t).unknown,3)
  EndIf
  If midi.tInf(t).copyright<>""  Then s+=Chr(13,10)+" Copyright....: "+midi.tInf(t).copyright
  If midi.tInf(t).stName<>""     Then s+=Chr(13,10)+" Track Name...: "+midi.tInf(t).stName
  If midi.tInf(t).instrument<>"" Then s+=Chr(13,10)+" Instrument...: "+midi.tInf(t).instrument
  If midi.tInf(t).useChannels    Then s+=Chr(13,10)+" Used Channels: "+Bin(midi.tInf(t).useChannels,16)
  Return s
End Function

' open MIDI interface
If (midi.setup() <> MMSYSERR_NOERROR) Then
  Print "Error opening MIDI Output."
  End
EndIf

'---------- MAIN ----------
Cls
Print
Print "FBMIDI Demo, file:'";MIDISONG;"'"

midi.loadFile(MIDISONG)

If midi.readMidi()>1 Then
  Print
  Print ("=========================================")
  Print (" MIDI File Info")
  Print ("=========================================")
  Print

  Print
  Print ("MIDI File        = "+MIDISONG)
  Print ("MIDI Format Type = "+Str(midi.globalFormatType))
  Print ("Number Of Tracks = "+Str(midi.globalNumOfTracks))
  Print ("Time Division    = "+Str(midi.globalDivision)+" Ticks per Beat")
  Print
  Print
  Print ("=========================================")
  Print (" Track Info")
  Print ("=========================================")
  Print
  For t As Integer=1 To midi.trackPtr-1
    Print
    Print showTrackInfo(t)
  Next t
EndIf
End


demo04events.bas Analyze MIDI File - all MIDI-events in a track

Code: Select all

' FBMIDI - Demo
' copyright by oog/proog.de 2013-2018
'

#define MIDISONG "midi1.mid"
#include "fbmidi.bi"

'---------- Init ----------
Dim Shared As FBMIDI midi

'---------- get info about MIDI event ----------
'
Function getMidiInfo(thisEvent As tEvent Ptr, showMidiFormat As Integer) As String
Dim As String r,s
  If thisEvent->pNext<>0 Then
    s=midi.getEvPara(thisEvent)
    If showMidiFormat=1 Then
      r=" Ticks:"+midi.intLeft(thisEvent->evTicks,6)_
       +" "+midi.eventInfo(thisEvent->evCode).paraName+" "+s
    ElseIf showMidiFormat=2 Then
      r=" @:"+Hex(thisEvent->evAddr,6)_
       +" Tk:"+midi.intLeft(thisEvent->evTicks,7)_
       +" qN:"+midi.intLeft(Int(10*thisEvent->evTicks/midi.globalDivision)/10,6)_
       +" Code:"+Hex(thisEvent->evCode,4)_
       +" Para:"+s _
       +" ("+midi.eventInfo(thisEvent->evCode).paraName+")"
    EndIf
  EndIf
  Return r
End Function

' open MIDI interface
If (midi.setup() <> MMSYSERR_NOERROR) Then
  Print "Error opening MIDI Output."
  End
EndIf

'---------- MAIN ----------
Cls
Print
Print "FBMIDI Demo, file:'";MIDISONG;"'"

midi.loadFile(MIDISONG)

If midi.readMidi()>1 Then
  Print
  Print ("=========================================")
  Print (" MIDI File Info")
  Print ("=========================================")
  Print
  Print
  Print ("MIDI File        = "+MIDISONG)
  Print ("MIDI Format Type = "+Str(midi.globalFormatType))
  Print ("Number Of Tracks = "+Str(midi.globalNumOfTracks))
  Print ("Time Division    = "+Str(midi.globalDivision)+" Ticks per Beat")
  Print
  Print
  Print ("=========================================")
  Print (" MIDI Events")
  Print ("=========================================")
  Print
  For t As Integer=1 To midi.trackPtr-1
    Print
    Print "Track "+Str(t)
    midi.thisEvent=midi.track(t)
    while midi.thisEvent->pNext<>0
      midi.thisEvent = midi.thisEvent->pNext
      Print getMidiInfo(midi.thisEvent, 2)
    Wend
    Print
  Next t
EndIf
End


demo05lyrics.bas Analyze MIDI File - lyrics from KARAOKE MIDI file

Code: Select all

' FBMIDI - Demo
' copyright by oog/proog.de 2013-2018
'

#define MIDISONG "midi1.mid"
#include "fbmidi.bi"

'---------- Init ----------
Dim Shared As FBMIDI midi

' open MIDI interface
If (midi.setup() <> MMSYSERR_NOERROR) Then
  Print "Error opening MIDI Output."
  End
EndIf

'---------- MAIN ----------
Cls
Print
Print "FBMIDI Demo, file:'";MIDISONG;"'"

midi.loadFile(MIDISONG)

If midi.readMidi()>1 Then
  Print
  Print ("=========================================")
  Print (" MIDI File Info")
  Print ("=========================================")
  Print
  Print
  Print ("MIDI File        = "+MIDISONG)
  Print ("MIDI Format Type = "+Str(midi.globalFormatType))
  Print ("Number Of Tracks = "+Str(midi.globalNumOfTracks))
  Print ("Time Division    = "+Str(midi.globalDivision)+" Ticks per Beat")
  Print
  midi.buildSequence()
  midi.analyseLyrics()
  midi.readLyrics()  'run this after 'buildSequence()'
  Print
  Print ("=========================================")
  Print (" Lyrics")
  Print ("=========================================")
  Print
  Print "globalKaraokeType.....:"; midi.globalKaraokeType
  Print "globalKaraokeTypeTrack:"; midi.globalKaraokeTypeTrack
  Print "lyricsCount...........:"; midi.lyricsCount
  Print
  For t As Integer=0 To midi.lyricsCount
    Print Str(t), midi.lyrics(t)
  Next t
  Print
EndIf
End
oog
Posts: 124
Joined: Jul 08, 2011 20:34

Re: Proog FBMIDI Library - play MIDI Files

Postby oog » May 27, 2018 9:01

demo06play.bas Play MIDI File - simple player

Code: Select all

' FBMIDI - Demo
' copyright by oog/proog.de 2013-2018
'

#define MIDISONG "midi1.mid"
#include "fbmidi.bi"

'---------- Init ----------
Dim Shared As FBMIDI midi
Dim Shared As String k

' open MIDI interface
If (midi.setup() <> MMSYSERR_NOERROR) Then
  Print "Error opening MIDI Output."
  End
EndIf

'---------- MAIN ----------
midi.loadFile(MIDISONG)
If midi.readMidi()>1 Then
  Cls
  Print
  Print "    ESC  : quit                 song: ";MIDISONG
  midi.buildSequence()
  midi.windTo(0)
  ' Play MIDI Song
  Do
    'sleep until it's time to play next note
    midi.saveEnergy()
    'handle user input
    k=Inkey
    'play next MIDI event
    midi.playLoop()
    'show playtime
    Locate 1,1
    Print Int(midi.globalPlaytime-(Timer-midi.lastTime))
  Loop Until midi.isEndOfMusic OrElse k=Chr(27)
EndIf
midi.AllNotesOff
End


demo07play.bas Play MIDI File - more complex player

Code: Select all

' FBMIDI - Demo
' copyright by oog/proog.de 2013-2018
'

#define MIDISONG "midi1.mid"
#include "fbmidi.bi"

'---------- Init ----------
Dim Shared As FBMIDI midi
Dim Shared As String k

Function minsec(t As Integer) As String
Dim As String r
  r = Str(t\60)+":"
  r += Right("0"+Str(t Mod 60),2)
  Return r
End Function

Sub showTracks()
  Locate 6,1
  For t As Integer=1 To min(midi.trackPtr-1, 20)
    Print "Track ";midi.intLeft(t,3);" ";
    Print Chr(Asc("a")-1+t);":";
    If midi.tInf(t).enabled Then
      Print "PLAY";
    Else
      Print "mute";
    EndIf
    Print " - ";midi.tInf(t).stName
  Next t
  If (midi.trackPtr-1)>20 Then Print "..."
End Sub

' open MIDI interface
If (midi.setup() <> MMSYSERR_NOERROR) Then
  Print "Error opening MIDI Output."
  End
EndIf

'---------- MAIN ----------
midi.loadFile(MIDISONG)
If midi.readMidi()>1 Then
  Cls
  Print
  Print "    ESC  : quit                 song: ";MIDISONG
  Print "    1,2,3: song position        <,> : rew, ffwd"
  Print "    a,b..: mute / PLAY track    +,- : transpose, pitch up/down"
  midi.buildSequence()
  midi.windTo(0)
  showTracks()
  ' Play MIDI Song
  Do
    'sleep until it's time to play next note
    midi.saveEnergy()
    'handle user input
    k=Inkey
    Select Case LCase(k)
      Case "+":
        midi.AllNotesOff
        If midi.transpose<9 Then midi.transpose+=1
      Case "-":
        midi.AllNotesOff
        If midi.transpose>-9 Then midi.transpose-=1
      Case ">":
        midi.AllNotesOff
        midi.windTo(Timer-midi.lastTime + 10)
      Case "<":
        midi.AllNotesOff
        If Timer-midi.lastTime > 10 Then
          midi.windTo(Timer-midi.lastTime - 10)
        EndIf
      Case "1":
        'rewind to start of song
        midi.AllNotesOff
        midi.windTo(0)
      Case "2":
        'wind to middle of song
        midi.AllNotesOff
        midi.windTo(midi.globalPlaytime / 2)
      Case "3":
        'wind to 10 seconds before end of song
        midi.AllNotesOff
        midi.windTo(midi.globalPlaytime - 10)
      Case "a" To "z":
        midi.AllNotesOff
        midi.tInf(1+Asc(k)-Asc("a")).enabled = (midi.tInf(1+Asc(k)-Asc("a")).enabled = 0)
        showTracks()
    End Select
    'play next MIDI event
    midi.playLoop()
    'show playtime
    Locate 1,1
    Dim As Integer t1, t2
    t1 = Timer-midi.lastTime  ' actual playtime
    t2 = midi.globalPlaytime  ' playtime of complete song
    Print minsec(t1);" / ";minsec(t2);", Transpose=";midi.transpose
  Loop Until midi.isEndOfMusic OrElse k=Chr(27)
EndIf
midi.AllNotesOff
End

Return to “Libraries”

Who is online

Users browsing this forum: No registered users and 3 guests