Thread Rating:
  • 1 Vote(s) - 5 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Exploring QB64-PE default soundfont patches
#11
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

Find my programs here in Dav's QB64 Corner
Reply
#12
(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.  Angry
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.
Reply
#13
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.
Reply
#14
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

Find my programs here in Dav's QB64 Corner
Reply
#15
(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.  Angry
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.
Reply
#16
(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.
Reply
#17
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

Find my programs here in Dav's QB64 Corner
Reply
#18
+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 + ...
Reply
#19
(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.
Reply
#20
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

Find my programs here in Dav's QB64 Corner
Reply




Users browsing this thread: 35 Guest(s)