Posts: 713
Threads: 117
Joined: Apr 2022
Reputation:
105
09-11-2024, 04:29 PM
(This post was last modified: 09-11-2024, 04:44 PM by Dav.)
I'm please to finally share a real working MIDI generator that is capable of making your own MIDI songs which you can either play from memory as save as .MID files to disk. You can play all 88 notes (groups of notes too), and there are note duration from Whole Note down to 32nd note. This makes single track MIDI's only for now. I've included a song in this program as an example of making and playing a MIDI, and how it can be used to make/save valid MIDI's and hear QB64-PE's builtin soundfont sounds..
I haven't written instructions on how to use it yet (and there's no error checking yet!) but it seems to be working correctly. You specify notes like c4 d4, and play groups enclosed in parenthesis (c4e4g4). Note length is given in wn en qn, etc. Will write further instructions when I have time.
Hey, @bplus, I did silent night here to see if it would fit your Christmas program. This uses GM patch sound #11, which is standard for a Music Box sound. See if you would like to use this.
This was a blast to figure out! Still very much a work in progress.
- Dav
Code: (Select All)
'=============
'MidiNotes.bas - v1,02
'=============
'Generates MIDI file data from string of notes.
'Coded by Dav, SEP/2024
'Added: Notes now can be written ias c4,d4, etc.
'Added: Duration change is now in notes$ string.
'Added: Can now play grouped notes at same time (c4e4g4)
'Added: Added more note lengths / fixed old ones.
$Unstable:Midi
$MidiSoundFont: Default
'Example: make silent night song midi notes
a$ = "dq(g4e4c4) en(a4f4) qn(g4e4) dh(e4c4g3)" 'silent night
a$ = a$ + "dq(g4e4c4) en(a4f4) qn(g4e4) dh(e4c4g3)" 'holy night
a$ = a$ + "hn(d5b4) qn(d5b4) dq(g4b4) enc5 qn(d5b4)" 'all is calm
a$ = a$ + "hn(c5g4e4) qn(c5g4e4) dq(c4e4g4) end4e4g4" 'all is bright
a$ = a$ + "hn(a4f4c4) qn(a4f4c4) dq(c5a4f4) en(b4g4) qn(a4f4)" 'round yon virgin
a$ = a$ + "dq(g4e4c4) en(a4f4) qn(g4e4) dq(e4c4g3) enf4 qng4" 'mother and child
a$ = a$ + "dq(a4f4c4) enf4(a4f4)b4 qn(c5a4f4)(b4g4)(a4f4)" 'holy infant so
a$ = a$ + "dq(g4e4c4) en(a4f4) qn(g4e4) hn(e4c4g3) sng4a4(b4g4)(a4c5)" 'tender and mild
a$ = a$ + "hn(d5b4g4)qn(d5b4g4)dq(f5d5b4)en(d5b4)qn(b4g4f4)dh(c5g4e4)(e5c5g4)" 'sleep in heavenly peace
a$ = a$ + "qn(c5g4e4) g4 e4 dq(g4d4b4) enf4 qn(d4b3f4) wn(c4g3e4c3)" 'sleep in heavenly peace
'generate midi data
note$ = MidiNotes$(100, 11, a$) 'setting tempo 100, use sound patch #11
'=================================================================
'optional here.... you could save that as a silentnight.mid file
'Open "silentnight.mid" For Output As #1: Print #1, note$;: Close #1
'=================================================================
midisong& = _SndOpen(note$, "memory")
_SndPlay midisong&
Print "Playing Silent Night MIDI song..."
Print "Press any key to stop."
Sleep
_SndStop midisong&
_SndClose midisong&
Function MidiNotes$ (tempo&, patch, notes$)
'--------------------------------------------
'Returns MIDI data suitable for MIDI playback
'--------------------------------------------
'tempo& = tempo of the midi
'patch = program number (sound) to use (0-127)
'note$ = string data of notes to play
'The following duration strings are allowed:
' wn = whole note
' dh = dotted half note
' hn = half note
' dq = dotted quarter
' qn = quarter note
' de = dotted eighth
' en = eighth note
' ds = dotted sixteenth note
' sn = sixteenth note
' ts = 32nd note
'--------------------------------------------
'first, remove any spaces from the string
n2$ = ""
For i = 1 To Len(notes$)
a$ = Mid$(notes$, i, 1): If a$ <> " " Then n2$ = n2$ + a$
Next
notes$ = n2$
'=======================================
'make MIDI Header Chunk (MThd)
MThd$ = "MThd"
MThd$ = MThd$ + Chr$(0) + Chr$(0) + Chr$(0) + Chr$(6) 'header size
MThd$ = MThd$ + Chr$(0) + Chr$(1) 'format type (1)
MThd$ = MThd$ + Chr$(0) + Chr$(1) 'number of tracks (1)
MThd$ = MThd$ + Chr$(0) + Chr$(96) 'division (ticks per quarter note)
'=======================================
'make tempo data to save
'calculate microseconds per beat from tempo& in BPM
MicroSecsPerBeat& = 60000000 \ tempo& 'Converts BPM to microseconds per beat
'get msb/mb/lsb from MicroSecsPerBeat& for saving tempo
'(Midi requires 3 bytes for this info)
msb = (MicroSecsPerBeat& \ 65536) And 255 'most significant byte
middle = (MicroSecsPerBeat& \ 256) And 255 'middle byte
lsb = MicroSecsPerBeat& And 255 'least significant byte
'make the tempo data + the 3 bytes
TrackData$ = TrackData$ + Chr$(0) + Chr$(255) + Chr$(81) + Chr$(3) + Chr$(msb) + Chr$(middle) + Chr$(lsb)
'======================================
'set Program number (patch) to use
TrackData$ = TrackData$ + Chr$(0) + Chr$(192) + Chr$(patch)
'======================================
'define ticks
'Set defaut note duration, get tickdata$
ticks& = 96 'default 96 ticks per quarter note
GoSub GetTickData
'=====================================================
'Load all notes string
'Loop through all notes$ given
For n = 1 To Len(notes$) Step 2
'see if it's a group first ()
If Mid$(notes$, n, 1) = "(" Then
'grab group string of notes until a ) found
group$ = "": count = 0: n = n + 1
Do
g$ = Mid$(notes$, n + count, 1)
If g$ = ")" Then Exit Do Else group$ = group$ + g$: count = count + 1
Loop
'========================
'do group notes here here
notesoff$ = "" ' holding space for turning notes off
For g = 1 To Len(group$) Step 2
b2$ = Mid$(group$, g, 2) 'grab 2 bytes
'must be a note, so get note val
GoSub GetNoteValue
notesoff$ = notesoff$ + Str$(note) 'save this for use
'set Note On: play note value (with velocity 127)
TrackData$ = TrackData$ + Chr$(0) + Chr$(144) + Chr$(note) + Chr$(127)
Next
addtick = 0 'only add tickdata once flag
'now send notes off to those above
For g = 1 To Len(notesoff$) Step 2
note = Val(Mid$(notesoff$, g, 2))
'set note off: stop playing note after specified duration
If addtick = 0 Then
'only add tickdata first time around
TrackData$ = TrackData$ + TickData$ + Chr$(128) + Chr$(note) + Chr$(64)
addtick = 1 'mark we done it
Else
'all the others add chr$(0) instead of tickdata
TrackData$ = TrackData$ + Chr$(0) + Chr$(0) + Chr$(128) + Chr$(note) + Chr$(64)
End If
Next
n = (n + count - 1) 'update n location
_Continue
End If
'do regular bytes (not a group)
b2$ = Mid$(notes$, n, 2) 'grab 2 bytes
'see if b2$ is a duration change
Select Case LCase$(b2$)
Case "wn", "dh", "hn", "qn", "dq", "de", "en", "ds", "sn", "ts"
'all these values are based on 'ticks per quarter note' = 96
If b2$ = "wn" Then ticks& = 384 'whole note (4 * 96)
If b2$ = "dh" Then ticks& = 288 'dotted half note (3 * 96)
If b2$ = "hn" Then ticks& = 192 'half note (2 * 96)
If b2$ = "dq" Then ticks& = 144 'dotted quarter (1.5 * 96 )
If b2$ = "qn" Then ticks& = 96 'quarter note
If b2$ = "de" Then ticks& = 72 'dotted eighth (.75 * 96)
If b2$ = "en" Then ticks& = 48 'eighth note (.5 * 96)
If b2$ = "ds" Then ticks& = 36 'dotted sixteenth note (sn + (.5 * sn)
If b2$ = "sn" Then ticks& = 24 'sixteenth note (.25 * 96)
If b2$ = "ts" Then ticks& = 12 '32nd notes (1 / 8) * 96
GoSub GetTickData
_Continue
End Select
'must be a note, so get note val
GoSub GetNoteValue
'================================
'set Note On: play note value (with velocity 127)
TrackData$ = TrackData$ + Chr$(0) + Chr$(144) + Chr$(note) + Chr$(127)
'===============================
'set note off: stop playing note after specified duration
TrackData$ = TrackData$ + TickData$ + Chr$(128) + Chr$(note) + Chr$(64)
'================================
Next
'============================
'SAVE TRACK DATA
'make the MTrk header
MTrk$ = "MTrk"
'make track end event
TrackData$ = TrackData$ + Chr$(0) + Chr$(255) + Chr$(47) + Chr$(0)
'make the track data length (4 bytes)
TrackLen& = Len(TrackData$)
TrackLength$ = Chr$((TrackLen& \ 16777216) And 255) + Chr$((TrackLen& \ 65536) And 255) + Chr$((TrackLen& \ 256) And 255) + Chr$(TrackLen& And 255)
'============================
'put it all together
MidiNotes$ = MThd$ + MTrk$ + TrackLength$ + TrackData$
Exit Function
'====================================================================================
'GOSUBS...Like'em or not, they're here to use.
' (keeping eveything in one FUNCTION)
'=============================================
GetTickData:
'==========
'convert ticks& to variable length quantity (VLQ)
TickData$ = ""
If ticks& = 0 Then
TickData$ = Chr$(0) 'safety, in case ticks& = 0
Else
Do
byte& = ticks& And &H7F
ticks& = ticks& \ 128
If TickData$ <> "" Then byte& = byte& Or &H80
TickData$ = Chr$(byte&) + TickData$
Loop While ticks& <> 0
End If
Return
'============================================
GetNoteValue:
'===========
'Gets a note value from b2$
note = 0 'safety defaut
If b2$ = "a0" Then note = 21
If b2$ = "A0" Then note = 22
If b2$ = "b0" Then note = 23
If b2$ = "c1" Then note = 24
If b2$ = "C1" Then note = 25
If b2$ = "d1" Then note = 26
If b2$ = "D1" Then note = 27
If b2$ = "e1" Then note = 28
If b2$ = "f1" Then note = 29
If b2$ = "F1" Then note = 30
If b2$ = "g1" Then note = 31
If b2$ = "G1" Then note = 32
If b2$ = "a1" Then note = 33
If b2$ = "A1" Then note = 34
If b2$ = "b1" Then note = 35
If b2$ = "c2" Then note = 36
If b2$ = "C2" Then note = 37
If b2$ = "d2" Then note = 38
If b2$ = "D2" Then note = 39
If b2$ = "e2" Then note = 40
If b2$ = "f2" Then note = 41
If b2$ = "F2" Then note = 42
If b2$ = "g2" Then note = 43
If b2$ = "G2" Then note = 44
If b2$ = "a2" Then note = 45
If b2$ = "A2" Then note = 46
If b2$ = "b2" Then note = 47
If b2$ = "c3" Then note = 48
If b2$ = "C3" Then note = 49
If b2$ = "d3" Then note = 50
If b2$ = "D3" Then note = 51
If b2$ = "e3" Then note = 52
If b2$ = "f3" Then note = 53
If b2$ = "F3" Then note = 54
If b2$ = "g3" Then note = 55
If b2$ = "G3" Then note = 56
If b2$ = "a3" Then note = 57
If b2$ = "A3" Then note = 58
If b2$ = "b3" Then note = 59
If b2$ = "c4" Then note = 60
If b2$ = "C4" Then note = 61
If b2$ = "d4" Then note = 62
If b2$ = "D4" Then note = 63
If b2$ = "e4" Then note = 64
If b2$ = "f4" Then note = 65
If b2$ = "F4" Then note = 66
If b2$ = "g4" Then note = 67
If b2$ = "G4" Then note = 68
If b2$ = "a4" Then note = 69
If b2$ = "A4" Then note = 70
If b2$ = "b4" Then note = 71
If b2$ = "c5" Then note = 72
If b2$ = "C5" Then note = 73
If b2$ = "d5" Then note = 74
If b2$ = "D5" Then note = 75
If b2$ = "e5" Then note = 76
If b2$ = "f5" Then note = 77
If b2$ = "F5" Then note = 78
If b2$ = "g5" Then note = 79
If b2$ = "G5" Then note = 80
If b2$ = "a5" Then note = 81
If b2$ = "A5" Then note = 82
If b2$ = "b5" Then note = 83
If b2$ = "c6" Then note = 84
If b2$ = "C6" Then note = 85
If b2$ = "d6" Then note = 86
If b2$ = "D6" Then note = 87
If b2$ = "e6" Then note = 88
If b2$ = "f6" Then note = 89
If b2$ = "F6" Then note = 90
If b2$ = "g6" Then note = 91
If b2$ = "G6" Then note = 92
If b2$ = "a6" Then note = 93
If b2$ = "A6" Then note = 94
If b2$ = "b6" Then note = 95
If b2$ = "c7" Then note = 96
If b2$ = "C7" Then note = 97
If b2$ = "d7" Then note = 98
If b2$ = "D7" Then note = 99
If b2$ = "e7" Then note = 100
If b2$ = "f7" Then note = 101
If b2$ = "F7" Then note = 102
If b2$ = "g7" Then note = 103
If b2$ = "G7" Then note = 104
If b2$ = "a7" Then note = 105
If b2$ = "A7" Then note = 106
If b2$ = "b7" Then note = 107
If b2$ = "c8" Then note = 108
Return
End Function
Posts: 72
Threads: 3
Joined: Apr 2022
Reputation:
14
(09-11-2024, 04:29 PM)Dav Wrote: I'm please to finally share a real working MIDI generator that is capable of making your own MIDI songs which you can either play from memory as save as .MID files to disk. You can play all 88 notes (groups of notes too), and there are note duration from Whole Note down to 32nd note. This makes single track MIDI's only for now. I've included a song in this program as an example of making and playing a MIDI, and how it can be used to make/save valid MIDI's and hear QB64-PE's builtin soundfont sounds..
I haven't written instructions on how to use it yet (and there's no error checking yet!) but it seems to be working correctly. You specify notes like c4 d4, and play groups enclosed in parenthesis (c4e4g4). Note length is given in wn en qn, etc. Will write further instructions when I have time.
Hey, @bplus, I did silent night here to see if it would fit your Christmas program. This uses GM patch sound #11, which is standard for a Music Box sound. See if you would like to use this.
This was a blast to figure out! Still very much a work in progress.
- Dav
Code: (Select All)
'=============
'MidiNotes.bas - v1,02
'=============
'Generates MIDI file data from string of notes.
'Coded by Dav, SEP/2024
'Added: Notes now can be written ias c4,d4, etc.
'Added: Duration change is now in notes$ string.
'Added: Can now play grouped notes at same time (c4e4g4)
'Added: Added more note lengths / fixed old ones.
$Unstable:Midi
$MidiSoundFont: Default
'Example: make silent night song midi notes
a$ = "dq(g4e4c4) en(a4f4) qn(g4e4) dh(e4c4g3)" 'silent night
a$ = a$ + "dq(g4e4c4) en(a4f4) qn(g4e4) dh(e4c4g3)" 'holy night
a$ = a$ + "hn(d5b4) qn(d5b4) dq(g4b4) enc5 qn(d5b4)" 'all is calm
a$ = a$ + "hn(c5g4e4) qn(c5g4e4) dq(c4e4g4) end4e4g4" 'all is bright
a$ = a$ + "hn(a4f4c4) qn(a4f4c4) dq(c5a4f4) en(b4g4) qn(a4f4)" 'round yon virgin
a$ = a$ + "dq(g4e4c4) en(a4f4) qn(g4e4) dq(e4c4g3) enf4 qng4" 'mother and child
a$ = a$ + "dq(a4f4c4) enf4(a4f4)b4 qn(c5a4f4)(b4g4)(a4f4)" 'holy infant so
a$ = a$ + "dq(g4e4c4) en(a4f4) qn(g4e4) hn(e4c4g3) sng4a4(b4g4)(a4c5)" 'tender and mild
a$ = a$ + "hn(d5b4g4)qn(d5b4g4)dq(f5d5b4)en(d5b4)qn(b4g4f4)dh(c5g4e4)(e5c5g4)" 'sleep in heavenly peace
a$ = a$ + "qn(c5g4e4) g4 e4 dq(g4d4b4) enf4 qn(d4b3f4) wn(c4g3e4c3)" 'sleep in heavenly peace
'generate midi data
note$ = MidiNotes$(100, 11, a$) 'setting tempo 100, use sound patch #11
'=================================================================
'optional here.... you could save that as a silentnight.mid file
'Open "silentnight.mid" For Output As #1: Print #1, note$;: Close #1
'=================================================================
midisong& = _SndOpen(note$, "memory")
_SndPlay midisong&
Print "Playing Silent Night MIDI song..."
Print "Press any key to stop."
Sleep
_SndStop midisong&
_SndClose midisong&
Function MidiNotes$ (tempo&, patch, notes$)
'--------------------------------------------
'Returns MIDI data suitable for MIDI playback
'--------------------------------------------
'tempo& = tempo of the midi
'patch = program number (sound) to use (0-127)
'note$ = string data of notes to play
'The following duration strings are allowed:
' wn = whole note
' dh = dotted half note
' hn = half note
' dq = dotted quarter
' qn = quarter note
' de = dotted eighth
' en = eighth note
' ds = dotted sixteenth note
' sn = sixteenth note
' ts = 32nd note
'--------------------------------------------
'first, remove any spaces from the string
n2$ = ""
For i = 1 To Len(notes$)
a$ = Mid$(notes$, i, 1): If a$ <> " " Then n2$ = n2$ + a$
Next
notes$ = n2$
'=======================================
'make MIDI Header Chunk (MThd)
MThd$ = "MThd"
MThd$ = MThd$ + Chr$(0) + Chr$(0) + Chr$(0) + Chr$(6) 'header size
MThd$ = MThd$ + Chr$(0) + Chr$(1) 'format type (1)
MThd$ = MThd$ + Chr$(0) + Chr$(1) 'number of tracks (1)
MThd$ = MThd$ + Chr$(0) + Chr$(96) 'division (ticks per quarter note)
'=======================================
'make tempo data to save
'calculate microseconds per beat from tempo& in BPM
MicroSecsPerBeat& = 60000000 \ tempo& 'Converts BPM to microseconds per beat
'get msb/mb/lsb from MicroSecsPerBeat& for saving tempo
'(Midi requires 3 bytes for this info)
msb = (MicroSecsPerBeat& \ 65536) And 255 'most significant byte
middle = (MicroSecsPerBeat& \ 256) And 255 'middle byte
lsb = MicroSecsPerBeat& And 255 'least significant byte
'make the tempo data + the 3 bytes
TrackData$ = TrackData$ + Chr$(0) + Chr$(255) + Chr$(81) + Chr$(3) + Chr$(msb) + Chr$(middle) + Chr$(lsb)
'======================================
'set Program number (patch) to use
TrackData$ = TrackData$ + Chr$(0) + Chr$(192) + Chr$(patch)
'======================================
'define ticks
'Set defaut note duration, get tickdata$
ticks& = 96 'default 96 ticks per quarter note
GoSub GetTickData
'=====================================================
'Load all notes string
'Loop through all notes$ given
For n = 1 To Len(notes$) Step 2
'see if it's a group first ()
If Mid$(notes$, n, 1) = "(" Then
'grab group string of notes until a ) found
group$ = "": count = 0: n = n + 1
Do
g$ = Mid$(notes$, n + count, 1)
If g$ = ")" Then Exit Do Else group$ = group$ + g$: count = count + 1
Loop
'========================
'do group notes here here
notesoff$ = "" ' holding space for turning notes off
For g = 1 To Len(group$) Step 2
b2$ = Mid$(group$, g, 2) 'grab 2 bytes
'must be a note, so get note val
GoSub GetNoteValue
notesoff$ = notesoff$ + Str$(note) 'save this for use
'set Note On: play note value (with velocity 127)
TrackData$ = TrackData$ + Chr$(0) + Chr$(144) + Chr$(note) + Chr$(127)
Next
addtick = 0 'only add tickdata once flag
'now send notes off to those above
For g = 1 To Len(notesoff$) Step 2
note = Val(Mid$(notesoff$, g, 2))
'set note off: stop playing note after specified duration
If addtick = 0 Then
'only add tickdata first time around
TrackData$ = TrackData$ + TickData$ + Chr$(128) + Chr$(note) + Chr$(64)
addtick = 1 'mark we done it
Else
'all the others add chr$(0) instead of tickdata
TrackData$ = TrackData$ + Chr$(0) + Chr$(0) + Chr$(128) + Chr$(note) + Chr$(64)
End If
Next
n = (n + count - 1) 'update n location
_Continue
End If
'do regular bytes (not a group)
b2$ = Mid$(notes$, n, 2) 'grab 2 bytes
'see if b2$ is a duration change
Select Case LCase$(b2$)
Case "wn", "dh", "hn", "qn", "dq", "de", "en", "ds", "sn", "ts"
'all these values are based on 'ticks per quarter note' = 96
If b2$ = "wn" Then ticks& = 384 'whole note (4 * 96)
If b2$ = "dh" Then ticks& = 288 'dotted half note (3 * 96)
If b2$ = "hn" Then ticks& = 192 'half note (2 * 96)
If b2$ = "dq" Then ticks& = 144 'dotted quarter (1.5 * 96 )
If b2$ = "qn" Then ticks& = 96 'quarter note
If b2$ = "de" Then ticks& = 72 'dotted eighth (.75 * 96)
If b2$ = "en" Then ticks& = 48 'eighth note (.5 * 96)
If b2$ = "ds" Then ticks& = 36 'dotted sixteenth note (sn + (.5 * sn)
If b2$ = "sn" Then ticks& = 24 'sixteenth note (.25 * 96)
If b2$ = "ts" Then ticks& = 12 '32nd notes (1 / 8) * 96
GoSub GetTickData
_Continue
End Select
'must be a note, so get note val
GoSub GetNoteValue
'================================
'set Note On: play note value (with velocity 127)
TrackData$ = TrackData$ + Chr$(0) + Chr$(144) + Chr$(note) + Chr$(127)
'===============================
'set note off: stop playing note after specified duration
TrackData$ = TrackData$ + TickData$ + Chr$(128) + Chr$(note) + Chr$(64)
'================================
Next
'============================
'SAVE TRACK DATA
'make the MTrk header
MTrk$ = "MTrk"
'make track end event
TrackData$ = TrackData$ + Chr$(0) + Chr$(255) + Chr$(47) + Chr$(0)
'make the track data length (4 bytes)
TrackLen& = Len(TrackData$)
TrackLength$ = Chr$((TrackLen& \ 16777216) And 255) + Chr$((TrackLen& \ 65536) And 255) + Chr$((TrackLen& \ 256) And 255) + Chr$(TrackLen& And 255)
'============================
'put it all together
MidiNotes$ = MThd$ + MTrk$ + TrackLength$ + TrackData$
Exit Function
'====================================================================================
'GOSUBS...Like'em or not, they're here to use.
' (keeping eveything in one FUNCTION)
'=============================================
GetTickData:
'==========
'convert ticks& to variable length quantity (VLQ)
TickData$ = ""
If ticks& = 0 Then
TickData$ = Chr$(0) 'safety, in case ticks& = 0
Else
Do
byte& = ticks& And &H7F
ticks& = ticks& \ 128
If TickData$ <> "" Then byte& = byte& Or &H80
TickData$ = Chr$(byte&) + TickData$
Loop While ticks& <> 0
End If
Return
'============================================
GetNoteValue:
'===========
'Gets a note value from b2$
note = 0 'safety defaut
If b2$ = "a0" Then note = 21
If b2$ = "A0" Then note = 22
If b2$ = "b0" Then note = 23
If b2$ = "c1" Then note = 24
If b2$ = "C1" Then note = 25
If b2$ = "d1" Then note = 26
If b2$ = "D1" Then note = 27
If b2$ = "e1" Then note = 28
If b2$ = "f1" Then note = 29
If b2$ = "F1" Then note = 30
If b2$ = "g1" Then note = 31
If b2$ = "G1" Then note = 32
If b2$ = "a1" Then note = 33
If b2$ = "A1" Then note = 34
If b2$ = "b1" Then note = 35
If b2$ = "c2" Then note = 36
If b2$ = "C2" Then note = 37
If b2$ = "d2" Then note = 38
If b2$ = "D2" Then note = 39
If b2$ = "e2" Then note = 40
If b2$ = "f2" Then note = 41
If b2$ = "F2" Then note = 42
If b2$ = "g2" Then note = 43
If b2$ = "G2" Then note = 44
If b2$ = "a2" Then note = 45
If b2$ = "A2" Then note = 46
If b2$ = "b2" Then note = 47
If b2$ = "c3" Then note = 48
If b2$ = "C3" Then note = 49
If b2$ = "d3" Then note = 50
If b2$ = "D3" Then note = 51
If b2$ = "e3" Then note = 52
If b2$ = "f3" Then note = 53
If b2$ = "F3" Then note = 54
If b2$ = "g3" Then note = 55
If b2$ = "G3" Then note = 56
If b2$ = "a3" Then note = 57
If b2$ = "A3" Then note = 58
If b2$ = "b3" Then note = 59
If b2$ = "c4" Then note = 60
If b2$ = "C4" Then note = 61
If b2$ = "d4" Then note = 62
If b2$ = "D4" Then note = 63
If b2$ = "e4" Then note = 64
If b2$ = "f4" Then note = 65
If b2$ = "F4" Then note = 66
If b2$ = "g4" Then note = 67
If b2$ = "G4" Then note = 68
If b2$ = "a4" Then note = 69
If b2$ = "A4" Then note = 70
If b2$ = "b4" Then note = 71
If b2$ = "c5" Then note = 72
If b2$ = "C5" Then note = 73
If b2$ = "d5" Then note = 74
If b2$ = "D5" Then note = 75
If b2$ = "e5" Then note = 76
If b2$ = "f5" Then note = 77
If b2$ = "F5" Then note = 78
If b2$ = "g5" Then note = 79
If b2$ = "G5" Then note = 80
If b2$ = "a5" Then note = 81
If b2$ = "A5" Then note = 82
If b2$ = "b5" Then note = 83
If b2$ = "c6" Then note = 84
If b2$ = "C6" Then note = 85
If b2$ = "d6" Then note = 86
If b2$ = "D6" Then note = 87
If b2$ = "e6" Then note = 88
If b2$ = "f6" Then note = 89
If b2$ = "F6" Then note = 90
If b2$ = "g6" Then note = 91
If b2$ = "G6" Then note = 92
If b2$ = "a6" Then note = 93
If b2$ = "A6" Then note = 94
If b2$ = "b6" Then note = 95
If b2$ = "c7" Then note = 96
If b2$ = "C7" Then note = 97
If b2$ = "d7" Then note = 98
If b2$ = "D7" Then note = 99
If b2$ = "e7" Then note = 100
If b2$ = "f7" Then note = 101
If b2$ = "F7" Then note = 102
If b2$ = "g7" Then note = 103
If b2$ = "G7" Then note = 104
If b2$ = "a7" Then note = 105
If b2$ = "A7" Then note = 106
If b2$ = "b7" Then note = 107
If b2$ = "c8" Then note = 108
Return
End Function
I would have liked to listen to it, but there is a very loud 'SILENCE' coming from my speakers. 
I still don’t know why I’m using QB64PE 3.14.1
I've already tried it without $Unstable:Midi and without $MidiSoundFont: Default because as of version 3.14 MIDI is no longer unstable, but nothing.
Posts: 367
Threads: 23
Joined: May 2022
Reputation:
55
On v3.14.1 _SndOpen is returning 0. That would mean it did not like the MIDI file MidiNotes$ is generating?
I dumped the MIDI using: Code: (Select All)
_WRITEFILE "test.mid", note$
Windows Media Player was not able to play it back either.
Posts: 713
Threads: 117
Joined: Apr 2022
Reputation:
105
09-11-2024, 05:12 PM
(This post was last modified: 09-11-2024, 05:14 PM by Dav.)
Hmm, I dunno. I still haven’t install 3.14 yet. Have to leave for a gig soon, but when I get back home I will install 3.14 and see what I can figure out.
- Dav
(09-11-2024, 05:12 PM)a740g Wrote: On v3.14.1 _SndOpen is returning 0. That would mean it did not like the MIDI file MidiNotes$ is generating?
I dumped the MIDI using: Code: (Select All)
_WRITEFILE "test.mid", note$
Windows Media Player was not able to play it back either.
Aw man, I must have messed up something before posting the code. I’ll check on it.
- Dav
Posts: 367
Threads: 23
Joined: May 2022
Reputation:
55
(09-11-2024, 05:08 PM)Steffan-68 Wrote: (09-11-2024, 04:29 PM)Dav Wrote: I'm please to finally share a real working MIDI generator that is capable of making your own MIDI songs which you can either play from memory as save as .MID files to disk. You can play all 88 notes (groups of notes too), and there are note duration from Whole Note down to 32nd note. This makes single track MIDI's only for now. I've included a song in this program as an example of making and playing a MIDI, and how it can be used to make/save valid MIDI's and hear QB64-PE's builtin soundfont sounds..
I haven't written instructions on how to use it yet (and there's no error checking yet!) but it seems to be working correctly. You specify notes like c4 d4, and play groups enclosed in parenthesis (c4e4g4). Note length is given in wn en qn, etc. Will write further instructions when I have time.
Hey, @bplus, I did silent night here to see if it would fit your Christmas program. This uses GM patch sound #11, which is standard for a Music Box sound. See if you would like to use this.
This was a blast to figure out! Still very much a work in progress.
- Dav
Code: (Select All)
'=============
'MidiNotes.bas - v1,02
'=============
'Generates MIDI file data from string of notes.
'Coded by Dav, SEP/2024
'Added: Notes now can be written ias c4,d4, etc.
'Added: Duration change is now in notes$ string.
'Added: Can now play grouped notes at same time (c4e4g4)
'Added: Added more note lengths / fixed old ones.
$Unstable:Midi
$MidiSoundFont: Default
'Example: make silent night song midi notes
a$ = "dq(g4e4c4) en(a4f4) qn(g4e4) dh(e4c4g3)" 'silent night
a$ = a$ + "dq(g4e4c4) en(a4f4) qn(g4e4) dh(e4c4g3)" 'holy night
a$ = a$ + "hn(d5b4) qn(d5b4) dq(g4b4) enc5 qn(d5b4)" 'all is calm
a$ = a$ + "hn(c5g4e4) qn(c5g4e4) dq(c4e4g4) end4e4g4" 'all is bright
a$ = a$ + "hn(a4f4c4) qn(a4f4c4) dq(c5a4f4) en(b4g4) qn(a4f4)" 'round yon virgin
a$ = a$ + "dq(g4e4c4) en(a4f4) qn(g4e4) dq(e4c4g3) enf4 qng4" 'mother and child
a$ = a$ + "dq(a4f4c4) enf4(a4f4)b4 qn(c5a4f4)(b4g4)(a4f4)" 'holy infant so
a$ = a$ + "dq(g4e4c4) en(a4f4) qn(g4e4) hn(e4c4g3) sng4a4(b4g4)(a4c5)" 'tender and mild
a$ = a$ + "hn(d5b4g4)qn(d5b4g4)dq(f5d5b4)en(d5b4)qn(b4g4f4)dh(c5g4e4)(e5c5g4)" 'sleep in heavenly peace
a$ = a$ + "qn(c5g4e4) g4 e4 dq(g4d4b4) enf4 qn(d4b3f4) wn(c4g3e4c3)" 'sleep in heavenly peace
'generate midi data
note$ = MidiNotes$(100, 11, a$) 'setting tempo 100, use sound patch #11
'=================================================================
'optional here.... you could save that as a silentnight.mid file
'Open "silentnight.mid" For Output As #1: Print #1, note$;: Close #1
'=================================================================
midisong& = _SndOpen(note$, "memory")
_SndPlay midisong&
Print "Playing Silent Night MIDI song..."
Print "Press any key to stop."
Sleep
_SndStop midisong&
_SndClose midisong&
Function MidiNotes$ (tempo&, patch, notes$)
'--------------------------------------------
'Returns MIDI data suitable for MIDI playback
'--------------------------------------------
'tempo& = tempo of the midi
'patch = program number (sound) to use (0-127)
'note$ = string data of notes to play
'The following duration strings are allowed:
' wn = whole note
' dh = dotted half note
' hn = half note
' dq = dotted quarter
' qn = quarter note
' de = dotted eighth
' en = eighth note
' ds = dotted sixteenth note
' sn = sixteenth note
' ts = 32nd note
'--------------------------------------------
'first, remove any spaces from the string
n2$ = ""
For i = 1 To Len(notes$)
a$ = Mid$(notes$, i, 1): If a$ <> " " Then n2$ = n2$ + a$
Next
notes$ = n2$
'=======================================
'make MIDI Header Chunk (MThd)
MThd$ = "MThd"
MThd$ = MThd$ + Chr$(0) + Chr$(0) + Chr$(0) + Chr$(6) 'header size
MThd$ = MThd$ + Chr$(0) + Chr$(1) 'format type (1)
MThd$ = MThd$ + Chr$(0) + Chr$(1) 'number of tracks (1)
MThd$ = MThd$ + Chr$(0) + Chr$(96) 'division (ticks per quarter note)
'=======================================
'make tempo data to save
'calculate microseconds per beat from tempo& in BPM
MicroSecsPerBeat& = 60000000 \ tempo& 'Converts BPM to microseconds per beat
'get msb/mb/lsb from MicroSecsPerBeat& for saving tempo
'(Midi requires 3 bytes for this info)
msb = (MicroSecsPerBeat& \ 65536) And 255 'most significant byte
middle = (MicroSecsPerBeat& \ 256) And 255 'middle byte
lsb = MicroSecsPerBeat& And 255 'least significant byte
'make the tempo data + the 3 bytes
TrackData$ = TrackData$ + Chr$(0) + Chr$(255) + Chr$(81) + Chr$(3) + Chr$(msb) + Chr$(middle) + Chr$(lsb)
'======================================
'set Program number (patch) to use
TrackData$ = TrackData$ + Chr$(0) + Chr$(192) + Chr$(patch)
'======================================
'define ticks
'Set defaut note duration, get tickdata$
ticks& = 96 'default 96 ticks per quarter note
GoSub GetTickData
'=====================================================
'Load all notes string
'Loop through all notes$ given
For n = 1 To Len(notes$) Step 2
'see if it's a group first ()
If Mid$(notes$, n, 1) = "(" Then
'grab group string of notes until a ) found
group$ = "": count = 0: n = n + 1
Do
g$ = Mid$(notes$, n + count, 1)
If g$ = ")" Then Exit Do Else group$ = group$ + g$: count = count + 1
Loop
'========================
'do group notes here here
notesoff$ = "" ' holding space for turning notes off
For g = 1 To Len(group$) Step 2
b2$ = Mid$(group$, g, 2) 'grab 2 bytes
'must be a note, so get note val
GoSub GetNoteValue
notesoff$ = notesoff$ + Str$(note) 'save this for use
'set Note On: play note value (with velocity 127)
TrackData$ = TrackData$ + Chr$(0) + Chr$(144) + Chr$(note) + Chr$(127)
Next
addtick = 0 'only add tickdata once flag
'now send notes off to those above
For g = 1 To Len(notesoff$) Step 2
note = Val(Mid$(notesoff$, g, 2))
'set note off: stop playing note after specified duration
If addtick = 0 Then
'only add tickdata first time around
TrackData$ = TrackData$ + TickData$ + Chr$(128) + Chr$(note) + Chr$(64)
addtick = 1 'mark we done it
Else
'all the others add chr$(0) instead of tickdata
TrackData$ = TrackData$ + Chr$(0) + Chr$(0) + Chr$(128) + Chr$(note) + Chr$(64)
End If
Next
n = (n + count - 1) 'update n location
_Continue
End If
'do regular bytes (not a group)
b2$ = Mid$(notes$, n, 2) 'grab 2 bytes
'see if b2$ is a duration change
Select Case LCase$(b2$)
Case "wn", "dh", "hn", "qn", "dq", "de", "en", "ds", "sn", "ts"
'all these values are based on 'ticks per quarter note' = 96
If b2$ = "wn" Then ticks& = 384 'whole note (4 * 96)
If b2$ = "dh" Then ticks& = 288 'dotted half note (3 * 96)
If b2$ = "hn" Then ticks& = 192 'half note (2 * 96)
If b2$ = "dq" Then ticks& = 144 'dotted quarter (1.5 * 96 )
If b2$ = "qn" Then ticks& = 96 'quarter note
If b2$ = "de" Then ticks& = 72 'dotted eighth (.75 * 96)
If b2$ = "en" Then ticks& = 48 'eighth note (.5 * 96)
If b2$ = "ds" Then ticks& = 36 'dotted sixteenth note (sn + (.5 * sn)
If b2$ = "sn" Then ticks& = 24 'sixteenth note (.25 * 96)
If b2$ = "ts" Then ticks& = 12 '32nd notes (1 / 8) * 96
GoSub GetTickData
_Continue
End Select
'must be a note, so get note val
GoSub GetNoteValue
'================================
'set Note On: play note value (with velocity 127)
TrackData$ = TrackData$ + Chr$(0) + Chr$(144) + Chr$(note) + Chr$(127)
'===============================
'set note off: stop playing note after specified duration
TrackData$ = TrackData$ + TickData$ + Chr$(128) + Chr$(note) + Chr$(64)
'================================
Next
'============================
'SAVE TRACK DATA
'make the MTrk header
MTrk$ = "MTrk"
'make track end event
TrackData$ = TrackData$ + Chr$(0) + Chr$(255) + Chr$(47) + Chr$(0)
'make the track data length (4 bytes)
TrackLen& = Len(TrackData$)
TrackLength$ = Chr$((TrackLen& \ 16777216) And 255) + Chr$((TrackLen& \ 65536) And 255) + Chr$((TrackLen& \ 256) And 255) + Chr$(TrackLen& And 255)
'============================
'put it all together
MidiNotes$ = MThd$ + MTrk$ + TrackLength$ + TrackData$
Exit Function
'====================================================================================
'GOSUBS...Like'em or not, they're here to use.
' (keeping eveything in one FUNCTION)
'=============================================
GetTickData:
'==========
'convert ticks& to variable length quantity (VLQ)
TickData$ = ""
If ticks& = 0 Then
TickData$ = Chr$(0) 'safety, in case ticks& = 0
Else
Do
byte& = ticks& And &H7F
ticks& = ticks& \ 128
If TickData$ <> "" Then byte& = byte& Or &H80
TickData$ = Chr$(byte&) + TickData$
Loop While ticks& <> 0
End If
Return
'============================================
GetNoteValue:
'===========
'Gets a note value from b2$
note = 0 'safety defaut
If b2$ = "a0" Then note = 21
If b2$ = "A0" Then note = 22
If b2$ = "b0" Then note = 23
If b2$ = "c1" Then note = 24
If b2$ = "C1" Then note = 25
If b2$ = "d1" Then note = 26
If b2$ = "D1" Then note = 27
If b2$ = "e1" Then note = 28
If b2$ = "f1" Then note = 29
If b2$ = "F1" Then note = 30
If b2$ = "g1" Then note = 31
If b2$ = "G1" Then note = 32
If b2$ = "a1" Then note = 33
If b2$ = "A1" Then note = 34
If b2$ = "b1" Then note = 35
If b2$ = "c2" Then note = 36
If b2$ = "C2" Then note = 37
If b2$ = "d2" Then note = 38
If b2$ = "D2" Then note = 39
If b2$ = "e2" Then note = 40
If b2$ = "f2" Then note = 41
If b2$ = "F2" Then note = 42
If b2$ = "g2" Then note = 43
If b2$ = "G2" Then note = 44
If b2$ = "a2" Then note = 45
If b2$ = "A2" Then note = 46
If b2$ = "b2" Then note = 47
If b2$ = "c3" Then note = 48
If b2$ = "C3" Then note = 49
If b2$ = "d3" Then note = 50
If b2$ = "D3" Then note = 51
If b2$ = "e3" Then note = 52
If b2$ = "f3" Then note = 53
If b2$ = "F3" Then note = 54
If b2$ = "g3" Then note = 55
If b2$ = "G3" Then note = 56
If b2$ = "a3" Then note = 57
If b2$ = "A3" Then note = 58
If b2$ = "b3" Then note = 59
If b2$ = "c4" Then note = 60
If b2$ = "C4" Then note = 61
If b2$ = "d4" Then note = 62
If b2$ = "D4" Then note = 63
If b2$ = "e4" Then note = 64
If b2$ = "f4" Then note = 65
If b2$ = "F4" Then note = 66
If b2$ = "g4" Then note = 67
If b2$ = "G4" Then note = 68
If b2$ = "a4" Then note = 69
If b2$ = "A4" Then note = 70
If b2$ = "b4" Then note = 71
If b2$ = "c5" Then note = 72
If b2$ = "C5" Then note = 73
If b2$ = "d5" Then note = 74
If b2$ = "D5" Then note = 75
If b2$ = "e5" Then note = 76
If b2$ = "f5" Then note = 77
If b2$ = "F5" Then note = 78
If b2$ = "g5" Then note = 79
If b2$ = "G5" Then note = 80
If b2$ = "a5" Then note = 81
If b2$ = "A5" Then note = 82
If b2$ = "b5" Then note = 83
If b2$ = "c6" Then note = 84
If b2$ = "C6" Then note = 85
If b2$ = "d6" Then note = 86
If b2$ = "D6" Then note = 87
If b2$ = "e6" Then note = 88
If b2$ = "f6" Then note = 89
If b2$ = "F6" Then note = 90
If b2$ = "g6" Then note = 91
If b2$ = "G6" Then note = 92
If b2$ = "a6" Then note = 93
If b2$ = "A6" Then note = 94
If b2$ = "b6" Then note = 95
If b2$ = "c7" Then note = 96
If b2$ = "C7" Then note = 97
If b2$ = "d7" Then note = 98
If b2$ = "D7" Then note = 99
If b2$ = "e7" Then note = 100
If b2$ = "f7" Then note = 101
If b2$ = "F7" Then note = 102
If b2$ = "g7" Then note = 103
If b2$ = "G7" Then note = 104
If b2$ = "a7" Then note = 105
If b2$ = "A7" Then note = 106
If b2$ = "b7" Then note = 107
If b2$ = "c8" Then note = 108
Return
End Function
I would have liked to listen to it, but there is a very loud 'SILENCE' coming from my speakers.
I still don’t know why I’m using QB64PE 3.14.1
I've already tried it without $Unstable:Midi and without $MidiSoundFont: Default because as of version 3.14 MIDI is no longer unstable, but nothing. My take is that the MIDI file it is generating has issues. Windows Media Player fails to play it back.
Posts: 72
Threads: 3
Joined: Apr 2022
Reputation:
14
(09-11-2024, 05:12 PM)a740g Wrote: On v3.14.1 _SndOpen is returning 0. That would mean it did not like the MIDI file MidiNotes$ is generating?
I dumped the MIDI using: Code: (Select All)
_WRITEFILE "test.mid", note$
Windows Media Player was not able to play it back either. The VLC player can play it if you specify a midi sound background in the program settings.
Posts: 713
Threads: 117
Joined: Apr 2022
Reputation:
105
09-11-2024, 05:21 PM
(This post was last modified: 09-11-2024, 05:25 PM by Dav.)
You're probably right, must not be creating a 100% valid MIDI. However, it is playing for me in my QB64-PE and also the saved .mid plays using VLC. I'll review how I'me saving MIDI info and also test it on my windows laptop. By the way, did that Laser sound snippet I posted earlier play for you?
EDIT: Thanks, guys for testing!
- Dav
Posts: 3,886
Threads: 174
Joined: Apr 2022
Reputation:
202
09-11-2024, 05:36 PM
(This post was last modified: 09-11-2024, 05:37 PM by bplus.)
+1 @Dav, plays fine for me also on Win10 Qb64pe 3.13.1
Is there a patch that sound more like bells?
BTW when you get around to little manual, a quick description and/or code sample would be nice. I know you have something in code above already, maybe mod that to a menu for checking out sounds for comparing?
b = b + ...
Posts: 72
Threads: 3
Joined: Apr 2022
Reputation:
14
(09-11-2024, 05:21 PM)Dav Wrote: You're probably right, must not be creating a 100% valid MIDI. However, it is playing for me in my QB64-PE and also the saved .mid plays using VLC. I'll review how I'me saving MIDI info and also test it on my windows laptop. By the way, did that Laser sound snippet I posted earlier play for you?
EDIT: Thanks, guys for testing!
- Dav
No, unfortunately that doesn't work either.
Posts: 713
Threads: 117
Joined: Apr 2022
Reputation:
105
09-11-2024, 05:45 PM
(This post was last modified: 09-11-2024, 05:47 PM by Dav.)
I think this fixed it. I was saving the tracklength wrong. Hopefully this versipon works. I tested the generated silentnight.mid file with an online MIDI analyzer tool and the .MID checks out ok.
Try this version (fingers crossed!)
- Dav
Code: (Select All)
'=============
'MidiNotes.bas - v1,03
'=============
'Generates MIDI file data from string of notes.
'Coded by Dav, SEP/2024
'Fixed?: Hopefully make a valid midi now.
$Unstable:Midi
$MidiSoundFont: Default
'Example: make silent night song midi notes
a$ = "dq(g4e4c4) en(a4f4) qn(g4e4) dh(e4c4g3)" 'silent night
a$ = a$ + "dq(g4e4c4) en(a4f4) qn(g4e4) dh(e4c4g3)" 'holy night
a$ = a$ + "hn(d5b4) qn(d5b4) dq(g4b4) enc5 qn(d5b4)" 'all is calm
a$ = a$ + "hn(c5g4e4) qn(c5g4e4) dq(c4e4g4) end4e4g4" 'all is bright
a$ = a$ + "hn(a4f4c4) qn(a4f4c4) dq(c5a4f4) en(b4g4) qn(a4f4)" 'round yon virgin
a$ = a$ + "dq(g4e4c4) en(a4f4) qn(g4e4) dq(e4c4g3) enf4 qng4" 'mother and child
a$ = a$ + "dq(a4f4c4) enf4(a4f4)b4 qn(c5a4f4)(b4g4)(a4f4)" 'holy infant so
a$ = a$ + "dq(g4e4c4) en(a4f4) qn(g4e4) hn(e4c4g3) sng4a4(b4g4)(a4c5)" 'tender and mild
a$ = a$ + "hn(d5b4g4)qn(d5b4g4)dq(f5d5b4)en(d5b4)qn(b4g4f4)dh(c5g4e4)(e5c5g4)" 'sleep in heavenly peace
a$ = a$ + "qn(c5g4e4) g4 e4 dq(g4d4b4) enf4 qn(d4b3f4) wn(c4g3e4c3)" 'sleep in heavenly peace
'generate midi data
note$ = MidiNotes$(100, 11, a$)
'=================================================================
'optional here.... you could save that as a silentnight.mid file
'Open "silentnight.mid" For Output As #1: Print #1, note$;: Close #1
'=================================================================
midisong& = _SndOpen(note$, "memory")
_SndPlay midisong&
Print "Playing Silent Night MIDI song..."
Print "Press any key to stop."
Sleep
_SndStop midisong&
_SndClose midisong&
Function MidiNotes$ (tempo&, patch, notes$)
'--------------------------------------------
'Returns MIDI data suitable for MIDI playback
'--------------------------------------------
'tempo& = tempo of the midi
'patch = program number (sound) to use (0-127)
'note$ = string data of notes to play
'The following duration strings are allowed:
' wn = whole note
' dh = dotted half note
' hn = half note
' dq = dotted quarter
' qn = quarter note
' de = dotted eighth
' en = eighth note
' ds = dotted sixteenth note
' sn = sixteenth note
' ts = 32nd note
'--------------------------------------------
'first, remove any spaces from the string
n2$ = ""
For i = 1 To Len(notes$)
a$ = Mid$(notes$, i, 1): If a$ <> " " Then n2$ = n2$ + a$
Next
notes$ = n2$
'=======================================
'make MIDI Header Chunk (MThd)
MThd$ = "MThd"
MThd$ = MThd$ + Chr$(0) + Chr$(0) + Chr$(0) + Chr$(6) 'header size
MThd$ = MThd$ + Chr$(0) + Chr$(1) 'format type (1)
MThd$ = MThd$ + Chr$(0) + Chr$(1) 'number of tracks (1)
MThd$ = MThd$ + Chr$(0) + Chr$(96) 'division (ticks per quarter note)
'=======================================
'make tempo data to save
'calculate microseconds per beat from tempo& in BPM
MicroSecsPerBeat& = 60000000 \ tempo& 'Converts BPM to microseconds per beat
'get msb/mb/lsb from MicroSecsPerBeat& for saving tempo
'(Midi requires 3 bytes for this info)
msb = (MicroSecsPerBeat& \ 65536) And 255 'most significant byte
middle = (MicroSecsPerBeat& \ 256) And 255 'middle byte
lsb = MicroSecsPerBeat& And 255 'least significant byte
'make the tempo data + the 3 bytes
TrackData$ = TrackData$ + Chr$(0) + Chr$(255) + Chr$(81) + Chr$(3) + Chr$(msb) + Chr$(middle) + Chr$(lsb)
'======================================
'set Program number (patch) to use
TrackData$ = TrackData$ + Chr$(0) + Chr$(192) + Chr$(patch)
'======================================
'define ticks
'Set defaut note duration, get tickdata$
ticks& = 96 'default 96 ticks per quarter note
GoSub GetTickData
'=====================================================
'Load all notes string
'Loop through all notes$ given
For n = 1 To Len(notes$) Step 2
'see if it's a group first ()
If Mid$(notes$, n, 1) = "(" Then
'grab group string of notes until a ) found
group$ = "": count = 0: n = n + 1
Do
g$ = Mid$(notes$, n + count, 1)
If g$ = ")" Then Exit Do Else group$ = group$ + g$: count = count + 1
Loop
'========================
'do group notes here here
notesoff$ = "" ' holding space for turning notes off
For g = 1 To Len(group$) Step 2
b2$ = Mid$(group$, g, 2) 'grab 2 bytes
'must be a note, so get note val
GoSub GetNoteValue
notesoff$ = notesoff$ + Str$(note) 'save this for use
'set Note On: play note value (with velocity 127)
TrackData$ = TrackData$ + Chr$(0) + Chr$(144) + Chr$(note) + Chr$(127)
Next
addtick = 0 'only add tickdata once flag
'now send notes off to those above
For g = 1 To Len(notesoff$) Step 2
note = Val(Mid$(notesoff$, g, 2))
'set note off: stop playing note after specified duration
If addtick = 0 Then
'only add tickdata first time around
TrackData$ = TrackData$ + TickData$ + Chr$(128) + Chr$(note) + Chr$(64)
addtick = 1 'mark we done it
Else
'all the others add chr$(0) instead of tickdata
TrackData$ = TrackData$ + Chr$(0) + Chr$(0) + Chr$(128) + Chr$(note) + Chr$(64)
End If
Next
n = (n + count - 1) 'update n location
_Continue
End If
'do regular bytes (not a group)
b2$ = Mid$(notes$, n, 2) 'grab 2 bytes
'see if b2$ is a duration change
Select Case LCase$(b2$)
Case "wn", "dh", "hn", "qn", "dq", "de", "en", "ds", "sn", "ts"
'all these values are based on 'ticks per quarter note' = 96
If b2$ = "wn" Then ticks& = 384 'whole note (4 * 96)
If b2$ = "dh" Then ticks& = 288 'dotted half note (3 * 96)
If b2$ = "hn" Then ticks& = 192 'half note (2 * 96)
If b2$ = "dq" Then ticks& = 144 'dotted quarter (1.5 * 96 )
If b2$ = "qn" Then ticks& = 96 'quarter note
If b2$ = "de" Then ticks& = 72 'dotted eighth (.75 * 96)
If b2$ = "en" Then ticks& = 48 'eighth note (.5 * 96)
If b2$ = "ds" Then ticks& = 36 'dotted sixteenth note (sn + (.5 * sn)
If b2$ = "sn" Then ticks& = 24 'sixteenth note (.25 * 96)
If b2$ = "ts" Then ticks& = 12 '32nd notes (1 / 8) * 96
GoSub GetTickData
_Continue
End Select
'must be a note, so get note val
GoSub GetNoteValue
'================================
'set Note On: play note value (with velocity 127)
TrackData$ = TrackData$ + Chr$(0) + Chr$(144) + Chr$(note) + Chr$(127)
'===============================
'set note off: stop playing note after specified duration
TrackData$ = TrackData$ + TickData$ + Chr$(128) + Chr$(note) + Chr$(64)
'================================
Next
'============================
'SAVE TRACK DATA
'make the MTrk header
MTrk$ = "MTrk"
'make track end event
TrackData$ = TrackData$ + Chr$(0) + Chr$(255) + Chr$(47) + Chr$(0)
'make the track data length (4 bytes)
TrackLen& = Len(TrackData$)
TrackLength$ = Chr$((TrackLen& \ 16777216) And 255) + Chr$((TrackLen& \ 65536) And 255) + Chr$((TrackLen& \ 256) And 255) + Chr$(TrackLen& And 255)
'============================
'put it all together
MidiNotes$ = MThd$ + MTrk$ + TrackLength$ + TrackData$
Exit Function
'====================================================================================
'GOSUBS...Like'em or not, they're here to use.
' (keeping eveything in one FUNCTION)
'=============================================
GetTickData:
'==========
'convert ticks& to variable length quantity (VLQ)
TickData$ = ""
If ticks& = 0 Then
TickData$ = Chr$(0) 'safety, in case ticks& = 0
Else
Do
byte& = ticks& And &H7F
ticks& = ticks& \ 128
If TickData$ <> "" Then byte& = byte& Or &H80
TickData$ = Chr$(byte&) + TickData$
Loop While ticks& <> 0
End If
Return
'============================================
GetNoteValue:
'===========
'Gets a note value from b2$
note = 0 'safety defaut
If b2$ = "a0" Then note = 21
If b2$ = "A0" Then note = 22
If b2$ = "b0" Then note = 23
If b2$ = "c1" Then note = 24
If b2$ = "C1" Then note = 25
If b2$ = "d1" Then note = 26
If b2$ = "D1" Then note = 27
If b2$ = "e1" Then note = 28
If b2$ = "f1" Then note = 29
If b2$ = "F1" Then note = 30
If b2$ = "g1" Then note = 31
If b2$ = "G1" Then note = 32
If b2$ = "a1" Then note = 33
If b2$ = "A1" Then note = 34
If b2$ = "b1" Then note = 35
If b2$ = "c2" Then note = 36
If b2$ = "C2" Then note = 37
If b2$ = "d2" Then note = 38
If b2$ = "D2" Then note = 39
If b2$ = "e2" Then note = 40
If b2$ = "f2" Then note = 41
If b2$ = "F2" Then note = 42
If b2$ = "g2" Then note = 43
If b2$ = "G2" Then note = 44
If b2$ = "a2" Then note = 45
If b2$ = "A2" Then note = 46
If b2$ = "b2" Then note = 47
If b2$ = "c3" Then note = 48
If b2$ = "C3" Then note = 49
If b2$ = "d3" Then note = 50
If b2$ = "D3" Then note = 51
If b2$ = "e3" Then note = 52
If b2$ = "f3" Then note = 53
If b2$ = "F3" Then note = 54
If b2$ = "g3" Then note = 55
If b2$ = "G3" Then note = 56
If b2$ = "a3" Then note = 57
If b2$ = "A3" Then note = 58
If b2$ = "b3" Then note = 59
If b2$ = "c4" Then note = 60
If b2$ = "C4" Then note = 61
If b2$ = "d4" Then note = 62
If b2$ = "D4" Then note = 63
If b2$ = "e4" Then note = 64
If b2$ = "f4" Then note = 65
If b2$ = "F4" Then note = 66
If b2$ = "g4" Then note = 67
If b2$ = "G4" Then note = 68
If b2$ = "a4" Then note = 69
If b2$ = "A4" Then note = 70
If b2$ = "b4" Then note = 71
If b2$ = "c5" Then note = 72
If b2$ = "C5" Then note = 73
If b2$ = "d5" Then note = 74
If b2$ = "D5" Then note = 75
If b2$ = "e5" Then note = 76
If b2$ = "f5" Then note = 77
If b2$ = "F5" Then note = 78
If b2$ = "g5" Then note = 79
If b2$ = "G5" Then note = 80
If b2$ = "a5" Then note = 81
If b2$ = "A5" Then note = 82
If b2$ = "b5" Then note = 83
If b2$ = "c6" Then note = 84
If b2$ = "C6" Then note = 85
If b2$ = "d6" Then note = 86
If b2$ = "D6" Then note = 87
If b2$ = "e6" Then note = 88
If b2$ = "f6" Then note = 89
If b2$ = "F6" Then note = 90
If b2$ = "g6" Then note = 91
If b2$ = "G6" Then note = 92
If b2$ = "a6" Then note = 93
If b2$ = "A6" Then note = 94
If b2$ = "b6" Then note = 95
If b2$ = "c7" Then note = 96
If b2$ = "C7" Then note = 97
If b2$ = "d7" Then note = 98
If b2$ = "D7" Then note = 99
If b2$ = "e7" Then note = 100
If b2$ = "f7" Then note = 101
If b2$ = "F7" Then note = 102
If b2$ = "g7" Then note = 103
If b2$ = "G7" Then note = 104
If b2$ = "a7" Then note = 105
If b2$ = "A7" Then note = 106
If b2$ = "b7" Then note = 107
If b2$ = "c8" Then note = 108
Return
End Function
|
