Fondere insieme due file MIDI

Mostriamo di seguito un codice, sufficientemente commentato, per fondere (mischiare) due file Midi con le sole funzioni di Gambas.

Va precisato che la dinamica e modalità dell'esecuzione di un file Midi potrà essere influenzata in modo particolare da diverso tipo di file Midi, da diversa risoluzione del Tempo-Delta e dagli eventuali Meta-eventi contenuti nell'altro file Midi. Pertanto si suggerisce di usare il seguente codice con due file Midi, dei quali almeno uno appartenga al tipo 1 di file Midi, e che posseggano medesima risoluzione del Tempo-Delta, nonché medesimo valore del Meta-evento relativo al Tempo metronomico.

Public Sub Main()

 Dim s1, s2, mtrk1, mtrk2, file_finale As String
 Dim nt1, nt2 As Byte

 s1 = File.Load("/percorso/del/primo/file.mid")
 s2 = File.Load("/percorso/del/secondo/file.mid")

' Innanzitutto verifica se almeno uno dei due file appartenga al tipo "1" di file Midi:
 If Asc(s1[9, 1]) + Asc(s2[9, 1]) == 0 Then Error.Raise("Nessuno dei due file appartiene al tipo '1' di file Midi !")

' Assicura che il 10° byte del Blocco d'intestazione del file Midi possegga il valore relativo al tipo "1" di file Midi.
' Assegna il valore "1" mediante la funzione "MkByte()", affinché sia assegnata precisamente la rappresentazione in memoria del valore 1 e non quella ASCII (che in memoria risulta essere &31). Si potrebbe usare in alternativa anche la funzione "Chr()".
 Mid(s1, 10, 1) = MkByte(1)

' Individua il numero di tracce presenti nel primo file:
 nt1 = Asc(s1[11, 1]) ' ...oppure anche: Byte@(s1[11, 1]), che in questo caso è usata per restituire un risultato opposto a quello della funzione "MkByte()"
' Individua il numero di tracce presenti nel secondo file:
 nt2 = Asc(s2[11, 1]) ' ...oppure anche: Byte@(s2[11, 1]), che in questo caso è usata per restituire un risultato opposto a quello della funzione "MkByte()"
 
' Raccoglie del 1° file Midi solo il valore della risoluzione del Tempo-Delta e la parte delle tracce "MTrk":
 mtrk1 = s1[12, s1.Len]
' Raccoglie del 2° file Midi solo la parte delle tracce "MTrk":
 mtrk2 = s2[14, s2.Len]

' Estrae e confronta il tempo metronomico dal primo blocco di tracce.
' Tenere comunque in considerazione che secondo lo standard MIDI, se un file non contiene esplicitamente il meta-evento 0xFF 0x51 ("Set Tempo"), il tempo metronomico predefinito è uguale a 500.000 microsecondi per quarto di nota, cioè 120 bpm.
' Pertanto, se il parser non trova il meta-evento Set Tempo, esso assume tempo = 500000 microsecondi.
 tempo1 = TrovaTempoMetronomico(mtrk1)
 tempo2 = TrovaTempoMetronomico(mtrk2)

 If tempo1 <> tempo2 Then
   Print "\e[31m\e[1mATTENZIONE: i due file hanno tempi metronomici differenti!\e[0m\n"
 Endif

 file_finale = s1[0, 11] & MkByte(nt1 + nt2) & mtrk1 & mtrk2

 File.Save("/tmp/nuovo.mid", file_finale)

End


' Funzione per trovare il meta-evento 0xFF 0x51 (Set Tempo)
Private Function TrovaTempoMetronomico(mtrk As String) As Integer

 Dim i As Integer = 0
 Dim tempo As Integer
 Dim delta, vlqLen As Integer

 While i < mtrk.Len - 5
' Legge delta-time:
   delta = LeggiVLQ(mtrk, i, vlqLen)
   i += vlqLen

   If Asc(mtrk[i]) = &HFF Then
     If Asc(mtrk[i + 1]) = &H51 And Asc(mtrk[i + 2]) = 3 Then
       tempo = Asc(mtrk[i + 3]) * 65536 + Asc(mtrk[i + 4]) * 256 + Asc(mtrk[i + 5])
       Return tempo
     Else
' Salta meta-evento generico:
       Dim metaLen As Integer
       metaLen = LeggiVLQ(mtrk, i + 2, vlqLen)
       i += 2 + vlqLen + metaLen
     Endif
   Else If Asc(mtrk[i]) >= &H80 And Asc(mtrk[i]) <= &HEF Then
' Evento MIDI standard: salta 2 o 3 byte in base al tipo:
     Dim evType As Integer = Asc(mtrk[i]) \ 16
     Select Case evType
       Case 8 To 11
         i += 3
       Case 12, 13
         i += 2
       Case 14
         i += 3
       Case Else 
         i += 1 ' fallback
     End Select
   Else
' SysEx o byte non riconosciuto:
     i += 1
   Endif
 Wend

' Se non trovato, ritorna valore di default (120 bpm = 500.000 μs):
 Return 500000

End


' Funzione per leggere VLQ(Variable Length Quantity)da posizione 'start'
Private Function LeggiVLQ(dat As String, start As Integer, ByRef nbytes As Integer) As Integer

 Dim val As Integer = 0
 Dim b As Integer
 nbytes = 0

 Repeat
   b = Asc(dat[start + nbytes])
   val = (val * 128) Or (b And &H7F)
   Inc nbytes
 Until (b And &H80) = 0 Or nbytes > 4

 Return val

End