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


Messages In This Thread
RE: Exploring QB64-PE default soundfont patches - by Dav - 09-11-2024, 04:29 PM



Users browsing this thread: 4 Guest(s)