Thread Rating:
  • 1 Vote(s) - 5 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Exploring QB64-PE default soundfont patches
#41
Looks like QB64-PE has a good GM (general midi) soundfont.  Most GM sound fonts have 128 sounds plus about 48 drum sounds to be used on channel 10.   I've discovered that MIDI channel 10 does indeed tap into the standard drum kit sounds,  So a midi track assigned channel 10 will always play the drumkit sounds, no matter what program # you give it..  You play the drum kits sounds by giving notes as well.  Not all notes have drum kit sounds. You can hear the drum kit sounds by playing all notes on channel 10 like this.

Code: (Select All)
'play all notes
all$ = "ena0A0b0c1C1d1D1e1f1F1g1G1a1A1b1c2C2d2D2e2f2F2g2G2a2A2b2"
all$ = all$ + "c3C3d3D3e3f3F3g3G3a3A3b3c4C4d4D4e4f4F4g4G4a4A4b4"
all$ = all$ + "c5C5d5D5e5f5F5g5G5a5A5b5c6C6d6D6e6f6F6g6G6a6A6b6"
all$ = all$ + "c7C7s7S7e7f7F7g7G7a7A7b7c8"
note$ = MidiNotes$(160, 1, all$, 10) '<<< channel 10 uses drum kit sounds always
midisong& = _SndOpen(note$, "memory")
_SndPlay midisong&
Sleep
   

Also, I've found that there is more than 128 available program sounds in our soundfont, I've used program numbers up to 255 and it has a sound.  Some of those extended numbers sounds good, a lot are repeated, a lot of synth sounds.  Haven't listened to them all.  You can't go higher that 255, that's the limit for a CHR$ value that it goes into.

- Dav

Find my programs here in Dav's QB64 Corner
Reply
#42
@Dav The v1.06 update you shared is awesome and works like a charm. It's really tempting me to write a QB64 PLAY-compatible MML player using the built-in MIDI engine, similar to what @FellippeHeitor mentioned earlier in the thread. Maybe someday... Big Grin

Regarding the point you made about the count of sounds, I'm quite sure you can get past 127 because the sequencer masks the topmost bit. So, anything above 127 would be a repeated sound from the 0-127 range.

See here:
https://github.com/QB64-Phoenix-Edition/...er.cpp#L62
Reply
#43
(09-13-2024, 12:04 AM)a740g Wrote: Regarding the point you made about the count of sounds, I'm quite sure you can get past 127 because the sequencer masks the topmost bit. So, anything above 127 would be a repeated sound from the 0-127 range.

See here:
https://github.com/QB64-Phoenix-Edition/...er.cpp#L62

Thanks. Yeah I believe you're right.  Some of the 128+ sound a little off somehow, like they don't cut off right, but not an issue since I don't expect to use them.  Perhaps I will put in a limit on that variable when I add error checking.  I've added rest notes tonight, trying to see if doing a program number change in the notes during a song will work too, to jump to a new sound on the fly for that track.  I can't see anything else to add.

- Dav

Find my programs here in Dav's QB64 Corner
Reply
#44
Added the last two things I thought was missing, having rests between notes, and allowing a program sound change during the playing track (switch sounds).  

To add a rest use code "rn", it will rest the duration previously set ( no sound).  To change the sound on the fly for that track, use "p000" to "p127" , the number being the sound patch you want to use.

This last version plays two little songs showing most everything the MIDI maker function can do, and how using channel 10 to access the drum sounds..

- Dav

Code: (Select All)
'=============
'MidiNotes.bas - v1.07
'=============
'Generates MIDI file data from string of notes.
'Coded by Dav, SEP/2024

'Added: "rn" - can now add rest notes (pauses) in note string.
'      "rn" is the rest note code, it uses and duration set.
'      "P010" program change code to change sounds in notes.
'      You assign a new sound # for that track anytime.
'      Use p000 to p127. Must be 4 characters long (like p030).

$Unstable:Midi
$MidiSoundFont: Default

'======================================================
'THIS DEMO SHOWS HOW TO MAKE A MILTI-TRACK MIDI SONG.
'YOU DON'T HAVE TO DO THIS, YOU CAN MAKE A 1 TRACK TOO:
'Like,  song$ = MidiNotes$(120, 1, "c4e4g4e4f4d4", 1)
'Then just play single track that using _SNDPLAY.
'
'After multitrack is played, a single MIDI song is too.
'======================================================

'4-track song demo....

'notes for all four instruments below...
p1$ = "sne4f4g4a4eng4qn(c5e4)en(d5g4)qn(c5e5)p080sne4f4g4a4eng4qnc5end5qnc5" 'melody part (violin)
p2$ = "p011 wn (c4e4g4) p088 (c4e4g4)" 'harmony part (bells)
p3$ = "en c3g3(c3g2)g3c3g3(c3g2)g3c3g3(c3g2)g3c3g3c3g3" 'piano sound
p4$ = "c4eng3a3qnc4g3c4eng3a3qnc4g3" 'for the drum sounds
'let's make the song a longer one by doubling the song parts.
p1$ = p1$ + p1$: p2$ = p2$ + p2$
p3$ = p3$ + p3$: p4$ = p4$ + p4$

'generate midi data for 4 tracks.
'each track uses its own channel, 1 - 4.
'We only need MIDI header for the first track, so we are
'going to remove the MIDI header for track 2, 3 and 4 below
track1$ = MidiNotes$(100, 41, p1$, 1) 'keep first track as is, with a midi header
track2$ = Mid$(MidiNotes$(100, 11, p2$, 2), 15) 'strip midi header off (removes 14 bytes)
track3$ = Mid$(MidiNotes$(100, 1, p3$, 3), 15) 'strip
track4$ = Mid$(MidiNotes$(100, 115, p4$, 10), 15) 'strip  <<< use channel 10 for drums.

'combine tracks 1+2+3+4 to form one MIDI data file
note$ = track1$ + track2$ + track3$ + track4$

'last step, update midi header to say 4 tracks used, not 1  <<<<< important for multitracks
Mid$(note$, 12, 1) = Chr$(4) '4 tracks now  <<< your number of tracks used
'================================================================

'================================================================
'optional here.... you could save that as a MIDI file like so....
'Open "4tracks.mid" For Output As #1: Print #1, note$;: Close #1
'================================================================

'play the 4 track midi..
midisong& = _SndOpen(note$, "memory")
_SndPlay midisong&

Print "Playing a Multi-track MIDI song..."
Print "Press any key to move on..."
Sleep 10
_SndStop midisong&
_SndClose midisong&

'=============================

'Now play a simple midi song...
Print
Print "Playing a simple track song..."
Print
end$ = MidiNotes$(200, 5, "c5rneng4F4g4G4rnrng4rnrnrnrnrnenp016b4rnrnenc5qnrn", 1)
midisong2& = _SndOpen(end$, "memory")
_SndPlay midisong2&
Sleep 4
End


Function MidiNotes$ (tempo&, patch, notes$, channel)
    '--------------------------------------------
    '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
    'channel = channel for track to use (1 to 16)
    'You can play notes like this: "c4e4g4"
    'To play notes at the same time you can
    'put them in parenthesis: "(c4e4g4)"
    '
    'You can put duration codes in front of notes.
    'Like this play eighth notes: "en c4e4g4"
    '
    '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
    '
    '  rn - rest note - no sound
    '      (uses the set duration)
    '
    'You can change volume of notes by using
    'values v000 to v127, like "v030c4"
    '
    'You can switch program sound # track uses.
    'Use values p000 to p127, like "p011"
    '--------------------------------------------

    vol = 127 'default volume

    'check and fix channel number here
    '(for programming purpose channels are used 0-15)
    channel = Fix(channel) - 1
    If channel < 0 Then channel = 0
    If channel > 15 Then channel = 15

    '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$(1) + Chr$(224) '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$ = 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 + channel) + Chr$(patch)
    '======================================
    'define ticks
    'Set defaut note duration, get tickdata$
    ticks& = 480 'default 480 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 + channel) + Chr$(note) + Chr$(vol)
            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 + channel) + Chr$(note) + Chr$(64)
                    addtick = 1 'mark we done it
                Else
                    TrackData$ = TrackData$ + Chr$(0) + Chr$(128 + channel) + Chr$(note) + Chr$(64)
                End If
            Next
            n = (n + count - 1) 'update n location
            _Continue
        End If
        'see if it's a volume change
        If LCase$(Mid$(notes$, n, 1)) = "v" Then
            vol = Int(Val(Mid$(notes$, n + 1, 3)))
            If vol < 0 Then vol = 0
            If vol > 127 Then vol = 127
            n = n + 2: _Continue
        End If

        'see if it's a program change
        If LCase$(Mid$(notes$, n, 1)) = "p" Then
            pro = Int(Val(Mid$(notes$, n + 1, 3)))
            If pro < 0 Then pro = 0
            If pro > 127 Then pro = 127
            'set Program number (patch) to use
            TrackData$ = TrackData$ + Chr$(0) + Chr$(192 + channel) + Chr$(pro)
            n = n + 2: _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' = 480
                If b2$ = "wn" Then ticks& = 1920 'whole note (4 * tpq)
                If b2$ = "dh" Then ticks& = 1440 'dotted half note (3 * tpq)
                If b2$ = "hn" Then ticks& = 960 'half note (2 * tpq)
                If b2$ = "dq" Then ticks& = 720 'dotted quarter (1.5 * tpq )
                If b2$ = "qn" Then ticks& = 480 'quarter note
                If b2$ = "de" Then ticks& = 360 'dotted eighth (.75 * tpq)
                If b2$ = "en" Then ticks& = 240 'eighth note (.5 * tpq)
                If b2$ = "ds" Then ticks& = 180 'dotted sixteenth note (sn + (.5 * sn)
                If b2$ = "sn" Then ticks& = 120 'sixteenth note (.25 * tpq)
                If b2$ = "ts" Then ticks& = 60 '32nd notes (1 / 8) * tpq
                GoSub GetTickData
                _Continue
        End Select
        'check for a rest note, handle special
        If LCase$(Mid$(notes$, n, 2)) = "rn" Then
            '(play any note at zero volume? (this just fakes a rest)
            'TrackData$ = TrackData$ + Chr$(0) + Chr$(144 + channel) + Chr$(22) + Chr$(0)
            'set rest note off: stop playing note after specified duration
            TrackData$ = TrackData$ + TickData$ + Chr$(128 + channel) + Chr$(note) + Chr$(64)
            _Continue
        End If

        '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 + channel) + Chr$(note) + Chr$(vol)
        '===============================
        'set note off: stop playing note after specified duration
        TrackData$ = TrackData$ + TickData$ + Chr$(128 + channel) + 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
#45
Corrected a big bug when playing groups of notes (inside parenthesis).  They were not being given the proper "note off" command which is why they were sometimes hanging on.   I wasn't trimming spaces off the notes when storing them in the notesoff$ string, so they were being skipped.

I put all thee example songs in this last version, recommend using this one for now on as it seems to play flawless now and has all examples of making regular and multitrack MIDI's, and using all note commands.

I'm wondering now how difficult it would be to make a graphical front end.  A real MIDI editor/player.  Drag and drop music notes on the screen, just call the function to generate/play the output.  

- Dav


Code: (Select All)
'=============
'MidiNotes.bas - v1.08
'=============
'Generates MIDI file data from string of notes.
'Coded by Dav, SEP/2024

'Fixed:  Corrected bad bug when playing groups of notes.
'        Notes were not being given the proper "note off"

$Unstable:Midi
$MidiSoundFont: Default

'THIS DEMO MAKES AND PLAYS 3 MIDI SONGS AS EXAMPLES.

'First MIDI Example: make silent night song in 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 the midi data
note$ = MidiNotes$(100, 11, a$, 1)

'===================================================================
'optional here.... you could save that as a silentnight.mid file
'Open "silentnight.mid" For Output As #1: Print #1, note$;: Close #1
'===================================================================

'Open the MIDI using _SNDPLAY & "memory"
midisong& = _SndOpen(note$, "memory")
_SndPlay midisong&

'play the song
Print
Print "Playing Silent Night MIDI song..."
Print "Press any key to move on...."
Sleep 41 'time to play it all
_SndStop midisong&
_SndClose midisong&


'SECOND MIDI EXAMPLE - HOW TO MAKE A MUILTITRACK MIDI

'===================================================================
'BELOW SHOWS HOW TO MAKE A MILTI-TRACK MIDI SONG USING THE FUNCTION.
'===================================================================

'notes for all four instruments/tracks below...
p1$ = "p041sne4f4g4a4eng4qn(c5g4e4)en(d5g4)qn(c5e5)p080sne4f4g4a4eng4qn(c5e4)en(d5f4)qn(c5e4)" 'melody part (violin)
p2$ = "p011 wn (c4e4g4) p088 (c4e4g4)" 'harmony part (bells)
p3$ = "en c3g3(c3g2)g3c3g3(c3g2)g3c3g3(c3g2)g3c3g3c3g3" 'piano sound
p4$ = "c4eng3a3qnc4g3c4eng3a3qnc4g3" 'for the drum sounds
'let's make the song longer by doubling the song parts.
p1$ = p1$ + p1$: p2$ = p2$ + p2$
p3$ = p3$ + p3$: p4$ = p4$ + p4$

'generate midi data for 4 tracks.
'each track uses its own channel, 1 - 4.
'We only need MIDI header for the first track, so we are
'going to remove the MIDI header for track 2, 3 and 4 below
track1$ = MidiNotes$(100, 41, p1$, 1) 'keep first track as is, with a midi header
track2$ = Mid$(MidiNotes$(100, 11, p2$, 2), 15) 'strip midi header off (removes 14 bytes)
track3$ = Mid$(MidiNotes$(100, 1, p3$, 3), 15) 'strip
track4$ = Mid$(MidiNotes$(100, 115, p4$, 10), 15) 'strip  <<< use channel 10 for drums.

'combine tracks 1+2+3+4 to form one MIDI data file
note$ = track1$ + track2$ + track3$ + track4$

'**** IMPORTANT STEP BELOW WHEN MAKING MULTI-TRACK MIDIS THIS WAY ****

'last step, update midi header to say 4 tracks used, not 1  <<<<< important for multitracks
Mid$(note$, 12, 1) = Chr$(4) '4 tracks now  <<< your number of tracks used

'================================================================
'optional here.... you could save that as a MIDI file like so....
'Open "4tracks.mid" For Output As #1: Print #1, note$;: Close #1
'================================================================

'Open & play the 4 track midi..
midisong& = _SndOpen(note$, "memory")
_SndPlay midisong&

Print
Print "Playing a Multi-track MIDI song..."
Print "Press any key to move on..."
Sleep 10
_SndStop midisong&
_SndClose midisong&

'=================================================

'3rd MIDI example, lust play a simple midi song...

Print
Print "Playing a simple track song..."
Print
end$ = MidiNotes$(200, 5, "c5rneng4F4g4G4rnrng4rnrnrnrnrnenp016(b4f4)rnrnen(c5e4)qnrn", 1)
midisong2& = _SndOpen(end$, "memory")
_SndPlay midisong2&
Sleep 4
_SndStop midisong&
_SndClose midisong&
End


Function MidiNotes$ (tempo&, patch, notes$, channel)
    '--------------------------------------------
    '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
    'channel = channel for track to use (1 to 16)
    'You can play notes like this: "c4e4g4"
    'To play notes at the same time you can
    'put them in parenthesis: "(c4e4g4)"
    '
    'You can put duration codes in front of notes.
    'Like this play eighth notes: "en c4e4g4"
    '
    '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
    '
    '  rn - rest note - no sound
    '      (uses the set duration)
    '
    'You can change volume of notes by using
    'values v000 to v127, like "v030c4"
    '
    'You can switch program sound # track uses.
    'Use values p000 to p127, like "p011"
    '--------------------------------------------

    vol = 127 'default volume

    'check and fix channel number here
    '(for programming purpose channels are used 0-15)
    channel = Fix(channel) - 1
    If channel < 0 Then channel = 0
    If channel > 15 Then channel = 15

    '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$(1) + Chr$(224) '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$ = 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 + channel) + Chr$(patch)
    '======================================
    'define ticks
    'Set defaut note duration, get tickdata$
    ticks& = 480 'default 480 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$ + _Trim$(Str$(note)) 'save this for use
                'set Note On: play note value (with velocity 127)
                TrackData$ = TrackData$ + Chr$(0) + Chr$(144 + channel) + Chr$(note) + Chr$(vol)
            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 + channel) + Chr$(note) + Chr$(64)
                    addtick = 1 'mark we done it
                Else
                    TrackData$ = TrackData$ + Chr$(0) + Chr$(128 + channel) + Chr$(note) + Chr$(64)
                End If
            Next
            n = (n + count - 1) 'update n location
            _Continue
        End If
        'see if it's a volume change
        If LCase$(Mid$(notes$, n, 1)) = "v" Then
            vol = Int(Val(Mid$(notes$, n + 1, 3)))
            If vol < 0 Then vol = 0
            If vol > 127 Then vol = 127
            n = n + 2: _Continue
        End If

        'see if it's a program change
        If LCase$(Mid$(notes$, n, 1)) = "p" Then
            pro = Int(Val(Mid$(notes$, n + 1, 3)))
            If pro < 0 Then pro = 0
            If pro > 127 Then pro = 127
            'set Program number (patch) to use
            TrackData$ = TrackData$ + Chr$(0) + Chr$(192 + channel) + Chr$(pro)
            n = n + 2: _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' = 480
                If b2$ = "wn" Then ticks& = 1920 'whole note (4 * tpq)
                If b2$ = "dh" Then ticks& = 1440 'dotted half note (3 * tpq)
                If b2$ = "hn" Then ticks& = 960 'half note (2 * tpq)
                If b2$ = "dq" Then ticks& = 720 'dotted quarter (1.5 * tpq )
                If b2$ = "qn" Then ticks& = 480 'quarter note
                If b2$ = "de" Then ticks& = 360 'dotted eighth (.75 * tpq)
                If b2$ = "en" Then ticks& = 240 'eighth note (.5 * tpq)
                If b2$ = "ds" Then ticks& = 180 'dotted sixteenth note (sn + (.5 * sn)
                If b2$ = "sn" Then ticks& = 120 'sixteenth note (.25 * tpq)
                If b2$ = "ts" Then ticks& = 60 '32nd notes (1 / 8) * tpq
                GoSub GetTickData
                _Continue
        End Select
        'check for a rest note, handle special
        If LCase$(Mid$(notes$, n, 2)) = "rn" Then
            '(play any note at zero volume? (this just fakes a rest)
            'TrackData$ = TrackData$ + Chr$(0) + Chr$(144 + channel) + Chr$(22) + Chr$(0)
            'set rest note off: stop playing note after specified duration
            TrackData$ = TrackData$ + TickData$ + Chr$(128 + channel) + Chr$(note) + Chr$(64)
            _Continue
        End If

        '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 + channel) + Chr$(note) + Chr$(vol)
        '===============================
        'set note off: stop playing note after specified duration
        TrackData$ = TrackData$ + TickData$ + Chr$(128 + channel) + 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
#46
There's a project! Score on top and keys below along with switches for note length staccato, normal or slurr, rest then volume controller getting louder, holding, then getting softer... perhaps color code for multiple voices Smile Might need a wide screen monitor for all that. Big Grin
b = b + ...
Reply
#47
I didn't intend on sharing this MIDI2CODE$ function, made it for my purposes to just quickly convert MIDI data to callable QB64 code snippet to stick small sounds in programs, but thought might as well share it here anyway.  Below is a sample of what the MIDI2CODE$ function outputs.  It basically just hexify's the data and makes the QB64 code all set up to use.   I know we have EMBED stuff now, but I still like to put pure code stuff in now and then.  MIDI's are small, just a few lines of code for a neat sound effect is OK with me.

- Dav

Explosion sound effect below....
(.MID file was made with the MidiNotes program)

Code: (Select All)
$Unstable:Midi
$MidiSoundFont: Default
'Make Explosion& sound handle
a$ = "4D546864000000060001000101E04D54726B0000001700FF51030F424000C07F0090157F87408015"
a$ = a$ + "4000FF2F00": midi$ = ""
For i = 1 To Len(a$) Step 2
    midi$ = midi$ + Chr$(Val("&H" + Mid$(a$, i, 2)))
Next
Explosion& = _SndOpen(midi$, "memory")
_SndPlay Explosion&: _Delay 2
_SndStop Explostion&

And here's the MIDI2CODE$ Function.  I usually just send the code to clipboard for copy/paste.

Code: (Select All)
'MIDI2CODE$.BAS
'==============
'Converts MIDI FILE/DATA to callable QB64-PE CODE.
'By Dav, SEP/2024

'This is a tool I made for personal use, sharing it tho.

'You can grab a .MID file...
'Open "4tracks.mid" For Binary As 1
'm$ = Input$(LOF(1), 1): Close 1

'Send the code to the clipboard to look at.

'_Clipboard$ = MIDI2CODE$(m$, 1)
'Print "Sent to clipboard"

Function MIDI2CODE$ (in$, compress)
    'in$ = the midi data you want to use.
    'compress =  use 1 to use compression, 0 for none.
    'It's most always better to use compression, unless you
    'have a one or two note midi for a sound effect.  If
    'that's the case you end up a little less code bloat
    'witout using compression.
    If compress = 1 Then in$ = _Deflate$(in$)
    out$ = ""
    For i = 1 To Len(in$)
        out$ = out$ + Right$("0" + Hex$(Asc(Mid$(in$, i, 1))), 2)
    Next
    'out$ is now hexified in$
    'wrap that and build qb64 code
    max = 80 'max length of line
    startpos = 1: q$ = Chr$(34): first = 1
    Do While startpos <= Len(out$)
        endpos = startpos + max - 1
        If endpos > Len(out$) Then endpos = Len(out$)
        'complete lineof maxlength
        If first = 1 Then
            out2$ = "midi$ = " + q$ + Mid$(out$, startpos, endpos - startpos + 1) + q$ + Chr$(13)
            first = 0
            max = max - 8 'shift len now for midi$ name, looks better
        Else
            out2$ = out2$ + "midi$ = midi$ + " + q$ + Mid$(out$, startpos, endpos - startpos + 1) + q$ + Chr$(13)
        End If
        'move start position to the next group
        startpos = endpos + 1
    Loop
    'now out2$ is hexifided data in qb64 code
    'so make out3$, final product with decoder
    out3$ = "$Unstable:Midi" + Chr$(13)
    out3$ = out3$ + "$MidiSoundFont: Default" + Chr$(13)
    out3$ = out3$ + "'Name your midi file here...." + Chr$(13)
    out3$ = out3$ + out2$
    out3$ = out3$ + "mididata$ = " + q$ + q$ + Chr$(13)
    out3$ = out3$ + "For i = 1 To Len(midi$) Step 2" + Chr$(13)
    out3$ = out3$ + "mididata$ = mididata$ + Chr$(Val(" + q$ + "&H" + q$ + " + Mid$(midi$, i, 2)))" + Chr$(13)
    out3$ = out3$ + "Next" + Chr$(13)
    If compress = 1 Then
        out3$ = out3$ + "mididata$ = _inflate$(mididata$)" + Chr$(13)
    End If
    out3$ = out3$ + "'make your midi sound to use" + Chr$(13)
    out3$ = out3$ + "midi& = _SndOpen(mididata$, " + q$ + "memory" + q$ + ")" + Chr$(13)
    out3$ = out3$ + "_SndPlay midi&" + Chr$(13)

    MIDI2CODE$ = out3$

End Function

Find my programs here in Dav's QB64 Corner
Reply
#48
I really think it's great what they've created.
I just have one more question.
Where the hell do they get the notes from?   Big Grin
Without notes, I don't even know how to put together a sensible melody.
Reply
#49
(09-15-2024, 07:20 PM)Steffan-68 Wrote: I really think it's great what they've created.
I just have one more question.
Where the hell do they get the notes from?   Big Grin
Without notes, I don't even know how to put together a sensible melody.

Sorry for this late reply, @Steffan-68 - I didn't notice it.  I will write a tutorial of using this function one day.  Here's a little info for now.  You will have to know music probably to make any good song with this function.  it's not easy really to make music  this way for anyone honestly.  I would like to make a graphical way.

Every note is a two bytes long, the first byte is the name of the note to play, and the 2nd byte is the octave of the note.  Like to do a simple 8 notes C scale, you can go from bottom C to the top C like this (starting on middle C so it's the 4th octave).

"c4 d4 e4 f4 g4 a4 b4 c5"  

That first 7 notes are in the 4th octave so a 4 is after each note.  The C5 would start the next octave up, so that;s why a 5 is there.

Now for the length for the notes, you have to declare that in front of the notes, so if you want that scale to be played in eight notes, do a EN in front of the scale.  "en c4 d4 e4 f4 g4 a4 b4 c5"

You can put a melody together like this using notes and durations in the string.  Here's the beginning of "Somewhere over the Rainbow" melody:

"hn c4 c5"  'some-where (those notes both use half notes)
"qn b4   en g4 a4" 'ov-er the (one quater note, two eight notes)
"qn b4 c5" 'rain-bow.  (quarter notes)

Hope that may help a little bit.

- Dav

Find my programs here in Dav's QB64 Corner
Reply
#50
I was planning to make a new instrument program, using midi notes instead of separate .ogg files for all the individual notes to play, but it looks like multiple MIDI files can't be playing at the same time cleanly like .ogg files can.  I'm getting distortion pretty bad when multiple MIDI files are being sounded.  Is there a way to prevent this?

Here's a small example just playing 8 separate notes (8 different MIDI files).  You need latest QB64PE.

- Dav

Code: (Select All)

'make all notes
Dim notes&(8)
notes&(1) = _SndOpen(MidiNotes$(100, 10, "c4rn", 1), "memory")
notes&(2) = _SndOpen(MidiNotes$(100, 10, "d4rn", 1), "memory")
notes&(3) = _SndOpen(MidiNotes$(100, 10, "e4rn", 1), "memory")
notes&(4) = _SndOpen(MidiNotes$(100, 10, "f4rn", 1), "memory")
notes&(5) = _SndOpen(MidiNotes$(100, 10, "g4rn", 1), "memory")
notes&(6) = _SndOpen(MidiNotes$(100, 10, "a4rn", 1), "memory")
notes&(7) = _SndOpen(MidiNotes$(100, 10, "b4rn", 1), "memory")
notes&(8) = _SndOpen(MidiNotes$(100, 10, "c5rn", 1), "memory")

'play notes
For t = 1 To 8
    _SndPlayCopy notes&(t)
    _Delay .2
Next


Function MidiNotes$ (tempo&, patch, notes$, channel)
    '--------------------------------------------
    '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
    'channel = channel for track to use (1 to 16)
    'You can play notes like this: "c4e4g4"
    'To play notes at the same time you can
    'put them in parenthesis: "(c4e4g4)"
    '
    'You can put duration codes in front of notes.
    'Like this play eighth notes: "en c4e4g4"
    '
    '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
    '
    '  rn - rest note - no sound
    '      (uses the set duration)
    '
    'You can change volume of notes by using
    'values v000 to v127, like "v030c4"
    '
    'You can switch program sound # track uses.
    'Use values p000 to p127, like "p011"
    '--------------------------------------------

    vol = 127 'default volume

    'check and fix channel number here
    '(for programming purpose channels are used 0-15)
    channel = Fix(channel) - 1
    If channel < 0 Then channel = 0
    If channel > 15 Then channel = 15

    '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$(1) + Chr$(224) '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$ = 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 + channel) + Chr$(patch)
    '======================================
    'define ticks
    'Set defaut note duration, get tickdata$
    ticks& = 480 'default 480 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$ + _Trim$(Str$(note)) 'save this for use
                'set Note On: play note value (with velocity 127)
                TrackData$ = TrackData$ + Chr$(0) + Chr$(144 + channel) + Chr$(note) + Chr$(vol)
            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 + channel) + Chr$(note) + Chr$(64)
                    addtick = 1 'mark we done it
                Else
                    TrackData$ = TrackData$ + Chr$(0) + Chr$(128 + channel) + Chr$(note) + Chr$(64)
                End If
            Next
            n = (n + count - 1) 'update n location
            _Continue
        End If
        'see if it's a volume change
        If LCase$(Mid$(notes$, n, 1)) = "v" Then
            vol = Int(Val(Mid$(notes$, n + 1, 3)))
            If vol < 0 Then vol = 0
            If vol > 127 Then vol = 127
            n = n + 2: _Continue
        End If

        'see if it's a program change
        If LCase$(Mid$(notes$, n, 1)) = "p" Then
            pro = Int(Val(Mid$(notes$, n + 1, 3)))
            If pro < 0 Then pro = 0
            If pro > 127 Then pro = 127
            'set Program number (patch) to use
            TrackData$ = TrackData$ + Chr$(0) + Chr$(192 + channel) + Chr$(pro)
            n = n + 2: _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' = 480
                If b2$ = "wn" Then ticks& = 1920 'whole note (4 * tpq)
                If b2$ = "dh" Then ticks& = 1440 'dotted half note (3 * tpq)
                If b2$ = "hn" Then ticks& = 960 'half note (2 * tpq)
                If b2$ = "dq" Then ticks& = 720 'dotted quarter (1.5 * tpq )
                If b2$ = "qn" Then ticks& = 480 'quarter note
                If b2$ = "de" Then ticks& = 360 'dotted eighth (.75 * tpq)
                If b2$ = "en" Then ticks& = 240 'eighth note (.5 * tpq)
                If b2$ = "ds" Then ticks& = 180 'dotted sixteenth note (sn + (.5 * sn)
                If b2$ = "sn" Then ticks& = 120 'sixteenth note (.25 * tpq)
                If b2$ = "ts" Then ticks& = 60 '32nd notes (1 / 8) * tpq
                GoSub GetTickData
                _Continue
        End Select
        'check for a rest note, handle special
        If LCase$(Mid$(notes$, n, 2)) = "rn" Then
            '(play any note at zero volume? (this just fakes a rest)
            'TrackData$ = TrackData$ + Chr$(0) + Chr$(144 + channel) + Chr$(22) + Chr$(0)
            'set rest note off: stop playing note after specified duration
            TrackData$ = TrackData$ + TickData$ + Chr$(128 + channel) + Chr$(note) + Chr$(64)
            _Continue
        End If

        '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 + channel) + Chr$(note) + Chr$(vol)
        '===============================
        'set note off: stop playing note after specified duration
        TrackData$ = TrackData$ + TickData$ + Chr$(128 + channel) + 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: 2 Guest(s)