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


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



Users browsing this thread: 9 Guest(s)