Proog MIDI / Karaoke Player

User projects written in or related to FreeBASIC.
oog
Posts: 124
Joined: Jul 08, 2011 20:34

Proog MIDI / Karaoke Player

Postby oog » Jan 06, 2017 18:52

This is a simple FreeBASIC MIDI / Karaoke Player. It can play simple MIDI files or Karaoke files of different formats. The songtext is displayed with color enlightenment of the current text position. An extra text line will be displayed as 'look ahead'.
This program is a result of my trials on reading and understanding MIDI files, so it includes some analysis code which is not really necessary for the player function.

Features:
    Simple keyboard control, a USB numpad is enough to control everything.
    Support transpose (pitch shifting) (keys "+" / "-" for halftone up / down).
    Playtime/Songtime display.
    No external DLLs needed..
    Analysis of actual played song is saved in a temporary file "~out.txt".

How to use:
    Compile "karaoke.bas" as console app.
    Copy the file "karaoke.exe" where you want.
    Create a subdirectory named "songs" in the same directory of "karaoke.exe".
    Store some MIDI / Karaoke files in the "songs" subdirectory. The file extension must be "*.mid".
    The website "http://www.midaoke.com/" has some files, for example.

Controls:
    '+', '-': navigate through pages in song directory (or transpose when playing)
    '1'..'9': play the associated song
    '0': exit (or stop song when playing)

Start the karaoke player by doubleclick on "karaoke.exe".


License ist GPL V3
oog
Posts: 124
Joined: Jul 08, 2011 20:34

Re: Proog MIDI / Karaoke Player

Postby oog » Jan 06, 2017 18:54

The Source Code

File "karaoke.bas"

Code: Select all

' karaoke midi player
' load and analyse midi files
' play song and lyrics
' copyright by oog/proog.de 2013-2017
'

Const Version="Version 0.17.01.06"

' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General 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 General Public License for more details.
'
' You should have received a copy of the GNU General Public License
' along with this program.  If not, see <http://www.gnu.org/licenses/>.
   
   
'
'---------- program structure ----------
'
'loadFile(infile)
'setGlobalTempo()
'loadMidi
'retimeTrack
'analyseKaraoke
'showMidi
'buildSequence
'playMidi


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

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

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))


'---------- 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 = "|"

Const ht="-------------------------------------------------------------"


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
 
'  'track info / analyse
'  '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

'  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
'  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.
 
End Type


Type ttrInfo
  'track info / analyse
  '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


'---------- 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


'---------- global variables ----------

Dim Shared As MidiMessage MidiMsg
Dim Shared As HMIDIOUT MYPLAYDEVICE     '// MIDI device interface for sending MIDI output

Dim Shared As String infile, outfile
Dim Shared As UByte midiDat(maxCounter)
Dim Shared As Integer addressCounter, filesize, outf
Dim Shared As UInteger globalNumOfTracks
Dim Shared As Integer globalFormatType
Dim Shared As longint globalDivision
Dim Shared As longint globalTempo
Dim Shared As Double globalPlaytime

Const heapMax=999999
Dim Shared As Integer heap(heapMax)
Dim Shared As Integer heapPtr

Const textinfoMax=9999
Dim Shared As String  textinfo(textinfoMax)
Dim Shared As Integer textinfoPtr

Dim Shared As tEvent Ptr track(maxTracks)
Dim Shared As ttrInfo tInf(maxTracks)
Dim Shared As tEvent Ptr playEvent(maxTracks)  'cursor to next event of this track
Dim Shared As Integer trackPtr=1
'Dim Shared As Integer trkSeqNumber(maxTracks)

Dim Shared As Integer transpose

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

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


'---------- load file into midiDat() array ----------
'
Sub 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


'---------- string function - convert time into H:MM:SS ----------
Function hms(t As Double) As String
Dim As Integer th, tm, ts
Dim As String r
  th=t
  ts=th Mod 60
  th=(th-ts)\60
  tm=th Mod 60
  th=(th-ts)\60
  r=Str(th)+":"+Right("0"+Str(tm),2)+":"+Right("0"+Str(ts),2)
  Return r
End Function


'---------- string function - intLeft ----------
Function 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


'---------- print string to stdout or file ----------
Sub pr(s As String="")
  If outfile="" Then
    Print s
  Else
    Print #outf, s
  EndIf
End Sub


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


''---------- get next 4 character string ----------
'' chunk ID
Function headerStr As String
  Return Chr(nextByte) _
       + Chr(nextByte) _
       + Chr(nextByte) _
       + Chr(nextByte)
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 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 num4 As UInteger
  Return (nextByte Shl 24) _
       + (nextByte Shl 16) _
       + (nextByte Shl 8) _
       + (nextByte)
End Function


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


'---------- get next track chunk ----------
Function 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 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 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


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


'---------- get infos about a MIDI event ----------
'
Function 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


'---------- load event data ----------
'
Sub loadEventData(event As tEvent Ptr)
Dim As UByte b
Dim As Integer d
 
  '1 - define parameter type (pType)
  event->pType = eventInfo(event->evCode).paraType
 
  '2 - load 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 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 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 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


'---------- load all events in a chunk ----------
'
Sub loadTrackEvents(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
        pr
        pr("ERROR: Running Status is zero at @"+Hex(addressCounter))
        pr
      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
    loadEventData(newEvent)
   
    '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
          PR("  Unknown Event Code:"+Hex(eventCode,6)_
             +" @ "+Hex(eventAddress,6)_
             +" Track="+Str(trackPtr+1))
      End Select
    EndIf
   
    tInf(trackPtr).numEvents += 1       'count number of all events
   
  Wend
End Sub


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


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


'---------- read file from midiDat() array into sequencer ----------
'
Sub loadMidi
Dim As Integer cursor=0
Dim As tEvent Ptr thisEvent
Dim As String s
  pr
  pr(ht)
  pr
  pr("loadMIDI")
 
  addressCounter=0
  loadHeaderChunk
  pr
  pr("MIDI Header Chunk:")
  pr("MIDI Format Type = "+Str(globalFormatType))
  pr("Number Of Tracks = "+Str(globalNumOfTracks))
  pr("Time Division    = "+Str(globalDivision)+" Ticks per Beat")
  pr
  For t As Integer=1 To globalNumOfTracks
    loadTrackChunk(t)
  Next t
End Sub


'---------- 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 retimeTrack
Dim As Integer ticksCounter
Dim As tEvent Ptr thisEvent
Dim As String s
  pr
  pr(ht)
  pr
  pr("retimeTrack")
  pr
  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


'---------- print file from midiDat() array from sequencer ----------
'
Dim Shared As Integer globalKaraokeWordsTrack
Dim Shared As Integer globalKaraokeTypeTrack
Dim Shared As Integer globalKaraokeType
Dim Shared As Integer globalLyricsTrack
Dim Shared As Integer globalTextIsLyrics

Sub analyseKaraoke
Dim As tEvent Ptr thisEvent
Dim As String s
  pr
  pr(ht)
  pr
  pr("analyseKaraoke")
  For t As Integer=1 To trackPtr-1
   
    'Fint "Words" Track
    if (tInf(t).stName = "Words") Then globalKaraokeWordsTrack=t
   
    'Fint 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
 
 
  pr
  pr("KaraokeTypeTrack  "+Str(globalKaraokeTypeTrack))
  pr("KaraokeTypeTrName "+tInf(globalKaraokeTypeTrack).stName)
  pr("globalKaraokeType "+Str(globalKaraokeType))
  pr("KaraokeWordsTrack "+Str(globalKaraokeWordsTrack))
  pr("LyricsTrack       "+Str(globalLyricsTrack))
  pr("TextIsLyrics      "+Str(globalTextIsLyrics))
  pr("Lyrics #          "+Str(tInf(globalLyricsTrack).lyrics))
  pr
 
  pr
End Sub


'---------- print file from midiDat() array from sequencer ----------
'
Sub showMidi(showMidiFormat As Integer)
Dim As tEvent Ptr thisEvent
Dim As String s
  pr
  pr(ht)
  pr
  pr("showMIDI")
  For t As Integer=1 To trackPtr-1
    pr
    pr("Track "+Str(t))
    thisEvent=track(t)
    pr(" Track Address  Ticks      quartNote EventCode Parameters")
    pr(ht)
    While thisEvent->pNext<>0
      thisEvent = thisEvent->pNext
      s=getEvPara(thisEvent)
      If showMidiFormat=1 Then
        pr(" "+intLeft(thisEvent->evTicks,6)_
          +" "+eventInfo(thisEvent->evCode).paraName+" "+s)
      ElseIf showMidiFormat=2 Then
        pr(" Tr:"+intLeft(t,2)_
          +" @:"+Hex(thisEvent->evAddr,6)_
          +" Tk:"+intLeft(thisEvent->evTicks,7)_
          +" qN:"+intLeft(Int(10*thisEvent->evTicks/globalDivision)/10,6)_
          +" Code:"+Hex(thisEvent->evCode,4)_
          +" Para:"+s _
          +" ("+eventInfo(thisEvent->evCode).paraName+")")
      EndIf
    Wend
  Next t
  pr
End Sub


'---------- detect end of track by event code or zero pointer ----------
'
Function 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" ----------
'
Dim Shared As tSequence Ptr seq

Sub 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

  pr
  pr(ht)
  pr
  pr("buildSequence")
  pr
  While seq<>0
    var cleanup=seq
    seq=seq->pnext
    DELETE cleanup
    pr(".")
  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
    pr(" T"+Left(Str(nextSeq->trackIdx+1)+" ",2)_
      +" "+hms(nextSeq->playTime)_
      +" qNote:"+Left(Str(Int(10*qNote)/10)+Space(6),6)_
      +" Tks:"+Left(Str(nextSeq->pEvent->evTicks)+Space(8),8)_
      +" Code:"+Hex(nextSeq->pEvent->evCode,4)_
      +" PType:"+Hex(nextSeq->pEvent->pType,1)_
      +" Param:"+getEvPara(nextSeq->pEvent))
   
    nextSeq           = nextSeq->pnext
    If playEvent(nextEvent)<>0 Then playEvent(nextEvent)=playEvent(nextEvent)->pNext
   
  Loop Until playEvent(nextEvent)=0
  pr
  pr("sequence complete.")
  pr
 
End Sub


'---------- send "All Notes Off" to all channels ----------
'
Sub AllNotesOff
  'MidiMsg.Number = evController
  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 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 readLyrics
Dim As tSequence Ptr nextSeq
  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)
  pr
  pr("readLyrics:")
  For i As Integer=1 To lyricsCount
    pr(intleft(i,3)+": "+lyrics(i))
  Next i
  pr
  Print "Read "+Str(lyricsCount)+" lines of lyrics."
 
  If globalInfTitle="" Then globalInfTitle="- not defined -"
  If globalInfInfo="" Then globalInfInfo="- not defined -"
End Sub


'---------- play MIDI file (with karaoke text) from "seq" ----------
'
Sub printLyricsLine(nextSeq As tSequence Ptr, yLine As integer)
Dim c As UInteger
 
  'Normal     Intense Value, Name
  '0 black    8 dark grey
  '1 blue     9 bright blue
  '2 green    10 bright green
  '3 cyan     11 bright cyan
  '4 red      12 bright red
  '5 pink     13 bright pink
  '6 yellow   14 bright yellow
  '7 grey     15 white
 
  'print next line of lyrics
  For i As Integer=1 To lyricsCount
    If lyricsStartEvent(i)=nextSeq Then
      c=Color()
      Color 15,HiWord(c)
      Locate yLine-2,1
      Print lyrics(i);
      Color 8,HiWord(c)
      Locate yLine-1,1
      Print lyrics(i+1);
      Color c
      Exit For
    EndIf
  Next i
End Sub




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

Sub 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
 
  'show player interface
  var txt=getLyricsElement(nextSeq,0)
  Select Case Left(txt,1)
    Case "/":
      cursX=1
      cursY+=1
      txt=Right(txt,Len(txt)-1)
    Case "\":
      cursX=1
      cursY+=1 '2
      txt=Right(txt,Len(txt)-1)
  End Select
 
  'scroll screen?
  while cursY>=HiWord(Width)
    Locate HiWord(Width),cursX
    'write over playtime counter
    Print "                                "
    cursY-=1
  Wend
 
  printLyricsLine(nextSeq, cursY)
 
  'print lyrics
  If txt<>"" Then
    Locate cursY-2,cursX
    Print txt;
    cursX+=Len(txt)
  EndIf
 
  'play note
  If 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


'---------- play MIDI file (with karaoke text) from "seq" ----------
'
Sub playMidi(optionShowEventlist As Integer)
Dim As tSequence Ptr nextSeq
Dim As Integer nextEvent
Dim As Integer t, t0
Dim As tEvent Ptr thisEvent
Dim As Double startTime
Dim As Double lastTime
Dim As String k
 
  Locate 1,1
  Print "(+/-)Transpose  (0)Quit                                 "
  nextSeq=seq
  startTime=Timer
  lastTime=startTime
  cursX=1
  cursY=HiWord(Width)-4
 
  var quit=0
 
  printLyricsLine(lyricsStartEvent(1), cursY+1)
 
  Do
    'wait until next event has to be played
    If nextSeq<>0 _
    AndAlso (nextSeq->pEvent<>0) Then
   
      'while nothing to play, do user interface and save energy (sleep 1)
      While nextSeq->playTime > (Timer-lastTime)
        Sleep 1
        If optionShowEventlist=0 Then
          t=Timer-startTime
          k=InKey
          Select Case LCase(k)
            Case "+":
              AllNotesOff
              If transpose<9 Then transpose+=1
            Case "-":
              AllNotesOff
              If transpose>-9 Then transpose-=1
            Case "0":
              AllNotesOff
              quit=-1
          End Select
         
          'bottom of screen
          'print playtime
          If t<>t0 Then 'seconds have changed
            Locate HiWord(Width),2
            Print hms(t)+" / "+hms(globalPlayTime);
            If transpose Then
              Print " T:"+Str(transpose)+" ";
            Else
              Print "      ";
            EndIf
            t0=t
          EndIf
        EndIf
      Wend
     
      'play next MIDI event
     
      playMidiEvent(nextSeq)
      nextSeq=nextSeq->pNext
     
    EndIf
  Loop Until (nextSeq=0) OrElse (nextSeq->pEvent=0) OrElse quit
  Print Chr(13,10)+"-- end --"
  Print Chr(13,10)+"Title: "+globalInfTitle
  Print Chr(13,10)+"Info:  "+globalInfInfo
  Sleep 2000
  Print
End Sub


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


'---------- read midi-file names into filenamelist()-array ----------
'
#include "dir.bi" 'provides constants to use for the attrib_mask parameter
Const maxFiles=999
Dim Shared As String filenamelist(maxFiles)
Dim Shared As Integer numFiles=0

Sub readFilenames(ByRef filespec As String, ByVal attrib As Integer)
  Dim As String filename = Dir(filespec, attrib) ' Start a file search with the specified filespec/attrib *AND* get the first filename.
  Do While Len(filename) > 0 ' If len(filename) is 0, exit the loop: no more filenames are left to be read.
    filenamelist(numFiles)=filename
    numFiles+=1
    filename = Dir()
  Loop
End Sub


'---------- delete infos from last song ----------
'
Sub 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=""
'  outf=0
'  globalNumOfTracks=0
'  globalFormatType=0
'  globalDivision=0
'  globalTempo=0
'  globalPlaytime=0
End Sub


'---------- select a song name from filenamelist()-array ----------
'
Dim Shared As Integer pg
Function selectSong() As String
  Dim As String k
  Dim As Integer maxPg=((numFiles-1)\9), mxSong
  deleteOldSong()
  If (numFiles>0) Then
    Do
      Cls
      Print
      Print "Karaoke Midi Player by oog/proog.de"
      Print Version
      Print "Choose a song (0 = Exit, +/- = Navigate):"
      Print
      Print
      mxSong=(pg+1)*9
      If mxSong>numFiles Then mxSong=numFiles
      Print "Page: "+Str(pg+1)+"/"+Str(maxPg+1)+" - Songs:"+Str(pg*9+1)+"-"+Str(mxSong)+" of "+Str(numFiles)
      Print
      For i As Integer=0 To 8
        If(i+pg*9)<numFiles Then
          Print ""+Str(1+i)+" - "+filenamelist(i+pg*9)
          If (i Mod 3)=2 Then Print
        EndIf
      Next i
      Sleep
      k=InKey
      If (k>="1") AndAlso (k<="9") Then Return filenamelist((pg*9)+Asc(k)-Asc("1"))
      If (k="0") Then Return ""
      If (k="+") Then pg+=1
      If (k="-") Then pg-=1
      If pg>maxPg Then pg=maxPg
      If pg<0 Then pg=0
    Loop
  Else
    PR("")
    PR("Error, no MIDI-Files/Songs found in ./songs/")
    Sleep
    end
  EndIf
End Function




'---------- Init ----------

' MIDI init
MidiMsg.Reserved = 0
var FLAG = midiOutOpen(@MYPLAYDEVICE, MIDI_MAPPER, 0, 0, null)
if (FLAG <> MMSYSERR_NOERROR) Then
  print "Error opening MIDI Output."
end If

For t As Integer=0 To maxTracks
  tInf(t).loNote=-1
  tInf(t).hiNote=-1
Next t

outfile="~out.txt"

Dim As Integer optionPlaySong=1
Dim As Integer optionShowEventlist=0
Dim As Integer optionShowMidiTracks=2

readFilenames("./songs/*.mid", fbArchive)


'---------- MAIN ----------

Do
  transpose = 0
  infile=selectSong()
 
  If infile<>"" Then
    Cls
    Print
    Print
    Print "Song: "+infile
   
    loadFile("./songs/"+infile)
    outf = FreeFile()
    Open outfile For Output As #outf
   
    pr("Midi Karaoke Player")
    pr(" File: "+infile)
    pr(" Size: "+Str(filesize)+" Bytes.")
   
    setGlobalTempo()
    loadMidi
    If trackPtr>1 Then
      retimeTrack
      analyseKaraoke
      If optionShowMidiTracks Then
        showMidi(optionShowMidiTracks)
      EndIf
      'show track info
      For t As Integer=1 To trackPtr-1
        pr(showTrackInfo(t))
      Next t
      buildSequence
      readLyrics
      If optionPlaySong=1 Then playMidi(optionShowEventlist)
    EndIf
    Close #outf
  EndIf
Loop Until infile=""
End


Have fun.

oog / proog.de
chung
Posts: 532
Joined: Jan 16, 2010 20:52
Location: France
Contact:

Re: Proog MIDI / Karaoke Player

Postby chung » Mar 05, 2017 10:01

thanks a lot , it works well .
angros47
Posts: 1421
Joined: Jun 21, 2005 19:04

Re: Proog MIDI / Karaoke Player

Postby angros47 » May 14, 2018 14:58

Is there any chance that the license will be upgraded to LGPL, to allow the inclusion of the code in a library?
oog
Posts: 124
Joined: Jul 08, 2011 20:34

Re: Proog MIDI / Karaoke Player

Postby oog » May 18, 2018 5:52

I can make a library version of the MIDI part which then can be published under LGPL license. But it needs some rework and documentation. I'll do my best.
MrSwiss
Posts: 2763
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Proog MIDI / Karaoke Player

Postby MrSwiss » May 18, 2018 10:44

I'd first, have a good look, at the code "as-is".

Reason:
For it to run equally on 32/64 bit's FBC, you'll probably have to:
- replace all *Integer* with *Long* as a first step (fixed 32bit INT-Type) since,
*Integer* on 64bit FBC, becomes a 64bit variable, which isn't wanted.

For more details: Differences between 32 bit and 64 bit click here ...
oog
Posts: 124
Joined: Jul 08, 2011 20:34

Re: Proog MIDI / Karaoke Player

Postby oog » May 27, 2018 9:02


Return to “Projects”

Who is online

Users browsing this forum: No registered users and 3 guests