Terug naar inhoudtafel: <Index Kursus>
1073:
Een konversieprogramma om zelf midi-files te maken
Meer dan heel wat teorie, zal een uitgewerkt programma waarin standaard midi-files worden geschreven, uitgaand van het eerder aangeleerde P(i,j) formaat veel duidelijk maken. Het programma is op de komputer in de klas beschikbaar, zowel als bronkode als gekompileerd. Het is mits enkele wijzigingen bruikbaar voor midi-files bestaande uit tot 127 tracks... Ook P(i,j) arrays waarbij pitch-bend informatie voor stukken in andere toonsystemen evenals andere real-time controllers werden opgeslagen kunnen worden gekonverteerd mits enkele wijzigingen.
' ***************************************************************************
' * <Binary to Midi file converter>> *
' * Written with united forces by: *
' * Dr.Godfried-Willem Raes *
' * Joachim Brackx *
' * Johan Vercruysse *
' ***************************************************************************
'$DYNAMIC
CONST TimeBase% = 120
CONST Tim% = 0: ' pointer in Track() to time information in track-array
CONST Msg% = 1: ' pointer in Track() to message information in track-array
TYPE Spoor
PatchName AS STRING * 10
Patch AS INTEGER
Port AS INTEGER
Volume AS INTEGER
Panning AS INTEGER
Ptr AS INTEGER
OldPtr AS INTEGER
TrackSize AS INTEGER
END TYPE
COMMON SHARED NrTracks%, Tempo%, Maatteller%, Maatnoemer%, Tunit%
COMMON SHARED Marker$, Author$
COMMON SHARED Wijzer&, OldPtr%, Nr%
COMMON SHARED Stem() AS Spoor
COMMON SHARED Track() AS LONG: '3 dimensional complete score array in dT
DECLARE SUB FillArray (Nr%, Time&, duur%, Status%, Dat1%, Dat2%)
DECLARE SUB RedimTrack (Nr%, Size%) : dynamic array dimensioning...
DECLARE SUB WriteMid (f$)
DECLARE SUB WriteChunk (chunk$) : ' writes a midi-chunk$ to the midi file. Used only by procedure WriteMid()
DECLARE SUB PutByte (byte%)
DECLARE FUNCTION MakeTempoChunk$ (Tempo%)
DECLARE FUNCTION MakeChunk$ (a$)
DECLARE FUNCTION B2S$ (b%) : ' converts bytes to 2-digit hex-strings
DECLARE SUB ReadBinFile (f$)
DECLARE SUB GetParameters ()
DECLARE SUB WriteDeltaT (dT&)
DECLARE SUB WriteMsg (Word&)
' voorlopige dimensionering der dynamische arrays...
DIM SHARED Stem(0 TO 1) AS Spoor
DIM SHARED Track(0 TO 1, 0 TO 1, 0) AS LONG
DIM SHARED P%(0 TO 1, 0 TO 15)
' konversieprogramma:
CLS
LOCATE 10, 10
INPUT "File to convert?"; fin$
fin$ = UCASE$(fin$)
IF LEFT$(fin$, 4) <> ".BIN" THEN fin$ = fin$ + ".BIN"
GetParameters
ReadBinFile (fin$)
Tick& = 0
FOR Nr% = 0 TO NrTracks% ' write initialisation & controller data to arrays on time=0
FillArray Nr%, Tick&, 0, &HB0 + Nr%, 7, Stem(Nr%).Volume: ' mastervolume
FillArray Nr%, Tick&, 0, &HB0 + Nr%, 10, Stem(Nr%).Panning: ' panning
NEXT Nr%
FOR Nr% = 0 TO NrTracks%
Tick& = 0: ' reset counter for each track...
j% = (Nr% * 2) + 1: ' voice counter in BIN-files
FOR i% = 0 TO UBOUND(P%, 1)
IF (P%(i%, j%) > 0) THEN
IF P%(i%, j% + 1) > 0 THEN
noot% = P%(i%, j%)
velo% = P%(i%, j% + 1)
' in this case we have a new note-ON/OFF event. we just have to calculate the note duration...
cnt% = i% + 1
DO
IF P%(cnt%, j%) > 0 THEN
d% = cnt% - i%
EXIT DO
END IF
cnt% = cnt% + 1
LOOP UNTIL cnt% > UBOUND(P%, 1)
IF d% < 1 THEN d% = 1
duur% = (d% * (Tunit% + 1)) - 1
FillArray Nr%, Tick&, duur%, &H90 + Nr%, noot%, velo%
ELSE
' this must be a note-off
END IF
END IF
Tick& = Tick& + (Tunit% + 1)
NEXT i%
NEXT Nr%
LOCATE 22, 10: INPUT "Output file-name?", MidiFile$
WriteMid (MidiFile$)
CLEAR
CLOSE
END
FUNCTION B2S$ (b%) ' converts a byte to a 2-digit hex string
b% = b% AND 255: ' beveiliging
IF b% < &H10 THEN
B2S$ = "0" + HEX$(b%)
ELSE
B2S$ = HEX$(b%)
END IF
END FUNCTION
SUB FillArray (Nr%, Time&, duur%, Status%, Dat1%, Dat2%)
' tracknummer tick duur statusbyte note velo
Mssg& = VAL("&H" + B2S$(Status%) + B2S$(Dat1%) + B2S$(Dat2%))
Stem(Nr%).Ptr = Stem(Nr%).Ptr + 1: ' counter for pointer
RedimTrack Nr%, Stem(Nr%).Ptr:
Deze funktie laat het Track() array toe te groeien naar gelang de noodzaak. Het maakt op een intelligente wijze gebruik van het REDIM PRESERVE statement, waardoor we niet telkens opnieuw de gehele inhoud moeten herschrijven.
De doorschuifoperatie die hier volgt is ook een mooie vondst: ook invoegen is mogelijk!
Dit is echter niet strikt nodig bij konversie van P(i,j) formaat omdat daarbij, nooit noten tussengevoegd worden... Ook resizing, hoe mooi ook, is voor P(i,j) konversie niet nodig, omdat de noodzakelijke maat voor Track() op voorhand kan berekend worden uit de maat van P(i,j). De hier gebruikte resizing is evenwel ook algemeen bruikbaar in kompositiesoftware, ook al zit er een snelheids-penalty aan vast, vergeleken dan met een vast geheugenblok.
DO UNTIL Time& >= Track(Nr%, Tim%, Stem(Nr%).OldPtr)
Track(Nr%, Tim%, Stem(Nr%).OldPtr + 1) = Track(Nr%, Tim%, Stem(Nr%).OldPtr)
Track(Nr%, Msg%, Stem(Nr%).OldPtr + 1) = Track(Nr%, Msg%, Stem(Nr%).OldPtr)
Stem(Nr%).OldPtr = Stem(Nr%).OldPtr - 1
LOOP
Track(Nr%, Tim%, Stem(Nr%).OldPtr + 1) = Time&
Track(Nr%, Msg%, Stem(Nr%).OldPtr + 1) = Mssg&
Stem(Nr%).OldPtr = Stem(Nr%).Ptr
' invoegen van de midi-event informatie: (hier:144+ k%...)
IF Status% >= &H90 AND Status% <= &H9F THEN
Mssg& = Mssg& - Dat2%
Time& = Time& + duur%
Stem(Nr%).Ptr = Stem(Nr%).Ptr + 1
RedimTrack Nr%, Stem(Nr%).Ptr
DO UNTIL Time& >= Track(Nr%, Tim%, Stem(Nr%).OldPtr)
Track(Nr%, Tim%, Stem(Nr%).OldPtr + 1) = Track(Nr%, Tim%, Stem(Nr%).OldPtr)
Track(Nr%, Msg%, Stem(Nr%).OldPtr + 1) = Track(Nr%, Msg%, Stem(Nr%).OldPtr)
Stem(Nr%).OldPtr = Stem(Nr%).OldPtr - 1
LOOP
Track(Nr%, Tim%, Stem(Nr%).OldPtr + 1) = Time&
Track(Nr%, Msg%, Stem(Nr%).OldPtr + 1) = Mssg&
Stem(Nr%).OldPtr = Stem(Nr%).Ptr
END IF
END SUB
SUB GetParameters
' this procedure lets the user specify conversion parameters for the BIN to Midi file conversion.
Marker$ = ""
LOCATE 15, 10
INPUT "Teller maatcijfer ?"; Maatteller%
LOCATE 16, 10
INPUT "Noemer maatcijfer ?"; Maatnoemer%
LOCATE 17, 10
INPUT "Tempo (MM) ?"; Tempo%
LOCATE 18, 10
INPUT "i-unit in P(i,j) [W, H, Q, E, S, T] "; un$
' uitbreidbaar naar 3-ledige en vijfledige maatsoorten...
un$ = RTRIM$(LTRIM$(UCASE$(un$)))
SELECT CASE un$
CASE "W"
Tunit% = (TimeBase% * 4) - 1
CASE "H"
Tunit% = (TimeBase% * 2) - 1
CASE "Q"
Tunit% = TimeBase% - 1
CASE "E"
Tunit% = (TimeBase% \ 2) - 1
CASE "S"
Tunit% = (TimeBase% \ 4) - 1
CASE "T"
Tunit% = (TimeBase% \ 8) - 1: ' 14 bij timebase=120
END SELECT
LOCATE 19, 10
INPUT "Aantal te konverteren stemmen? "; NrTracks%
' reminder: in midi-files, track 0 will be used for tempo information!
IF NrTracks% < 0 THEN NrTracks% = 1
LOCATE 20, 10
INPUT "Komponist ?"; Author$
REDIM Stem(0 TO NrTracks%) AS Spoor
FOR i% = 0 TO NrTracks%
Stem(i%).PatchName = "Patch" + HEX$(i% + 1)
Stem(i%).Patch = i% + 1
Stem(i%).Port = 0: ' default is one single midi-port device
Stem(i%).Panning = 64
Stem(i%).Volume = 120
Stem(i%).Ptr = 0
Stem(i%).OldPtr = 0
Stem(i%).TrackSize = 0
Stem(i%).Panning = 64
Stem(i%).Volume = 120
NEXT i%
REDIM Track(0 TO NrTracks%, 0 TO 1, 0) AS LONG: ' dynamisch...
' herdimensionering in de loop van het programma
LOCATE 21, 10
END SUB
FUNCTION MakeChunk$ (a$)
' converts a string to the format required by midi-files:' lenght followed by 7-bit numbers in hex.
Instr$ = ""
FOR i% = 1 TO LEN(a$)
Instr$ = Instr$ + HEX$(ASC(MID$(a$, i%, 1)))
NEXT i%
Name$ = Instr$
SELECT CASE LEN(HEX$(LEN(a$)))
CASE 0
Namelen$ = "00"
CASE 1
Namelen$ = "0" + HEX$(LEN(a$))
CASE 2
Namelen$ = HEX$(LEN(a$))
END SELECT
MakeChunk$ = Namelen$ + Name$
END FUNCTION
FUNCTION MakeTempoChunk$ (Tempo%)
Temp$ = HEX$(60000000 / Tempo%)
Tempo$ = "FF5103" + "000000"
MID$(Tempo$, 13 - LEN(Temp$), LEN(Temp$)) = Temp$
MakeTempoChunk$ = "78" + Tempo$
END FUNCTION
SUB PutByte (b%)
Wijzer& = Wijzer& + 1
PUT #1, Wijzer&, b%
END SUB
SUB ReadBinFile (f$)
OPEN f$ FOR INPUT AS #1
x& = LOF(1)
REDIM P%(0 TO (x& \ 16), 0 TO 15): ' (X \ 16) = endcount
' LOF(1) is steeds = ((X\16)*16)+1 het extra byte is de E.O.F.-marker !
NrBlok% = (x& \ (2 ^ 14)): ' aantal volledige blokken van 16kByte in de file.Het maximale maat voor strings in QB/BC7 is
' eigenlijk 2^5, maar dan dreigen we een out off string space foutmelding te krijgen!
Rest% = x& MOD (2 ^ 14): ' overschot... ' nu moet X= (NrBlok * (2^14) ) + Rest
i% = 0: k& = 0: j% = 0 q' reset alle tellers naar 0 - pro disciplina nu gebeurt het inlezen van de file
' eerst wordt het aantal volledige 16kByte blokken ingelezen
DO UNTIL i% >= NrBlok%
Lees$ = INPUT$((2 ^ 14), #1)
GOSUB CONVERT
i% = i% + 1
LOOP
' inlezen resterend aantal bytes in de file...
IF Rest% > 0 THEN
Lees$ = INPUT$((Rest%), #1)
GOSUB CONVERT
END IF
CLOSE #1
EXIT SUB
' conversiealgoritme om deze strings nu terug om te zetten naar binaire waarden
CONVERT:
FOR y% = 1 TO LEN(Lees$) ' byte-teller
P%(k&, j%) = ASC(MID$(Lees$, y%, 1))
j% = j% + 1
IF j% = 16 THEN k& = k& + 1: j% = j% MOD 16
NEXT y%
Lees$ = "" geheugen opruimen ...
RETURN
END SUB
SUB RedimTrack (Nr%, Size%)
' dynamic adaptation of track-array size. This costs us more memory than in the case we would use individual arrays for the tracks...
STATIC OldSize%
IF Size% > OldSize% THEN
REDIM PRESERVE Track(0 TO NrTracks%, 0 TO 1, 0 TO Size%) AS LONG
OldSize% = Size%
END IF
' but we still have to know the exact size of each individual track, hence:
Stem(Nr%).TrackSize = Size%
END SUB
SUB WriteChunk (chunk$)
FOR j% = 1 TO LEN(chunk$) STEP 2
b% = VAL("&H" + (MID$(chunk$, j%, 2)))
Wijzer& = Wijzer& + 1
PUT #1, Wijzer&, b%
NEXT j%
END SUB
SUB WriteDeltaT (dT&)
' realizes the compressed midi-time format (cfr. book quoted in header, & notes in this course).
IF dT& > &H1FFFFF THEN
byte% = (dT& \ &H200000) OR &H80
dT& = dT& AND &H1FFFFF
PutByte byte%
END IF
IF dT& > &H3FFF THEN
byte% = (dT& \ &H4000) OR &H80
dT& = dT& AND &H3FFF
PutByte byte%
END IF
IF dT& > &H7F THEN
byte% = (dT& \ &H80) OR &H80
dT& = dT& AND &H7F
PutByte byte%
END IF
IF dT& >= 0 THEN
byte% = dT&
PutByte byte%
END IF
END SUB
SUB WriteMid (fl$)
' dokumentatiebron voor de kodering van SMF's:
' "Het complete Midi-boek", Christian Braut, Sybex,1992, p.331-
Wijzer& = 0: ' counter to file-write position must be reset on init.
' header for midifile
' LOCAL Midi-file constants - here defined as 7-bit strings
MThd$ = "4D546864" + "00000006": ' Chunk-type= 4D 54 68 64
' + lenght= 00 00 00 06
MThdData$ = "0001" + "00" + B2S$(NrTracks% + 1) + "00" + B2S$(TimeBase%)
' 2 bytes = format, 0, 1 or 2: 00 01 =1
' 2 bytes = Nr tracks 00 09 =9
' track0 is used for tempo-information!
' 2 bytes = eenheid voor delta time berekening
' 00 78 =120
' timebase.
' bit 15 =0 dus, metrisch ingedeeld
' bit 15 = 1 -> timecode (absolute time)
Header$ = MThd$ + MThdData$
' Track-chunk constants:
MTrk$ = "4D54726B" + "00000000": ' string format
' chunk type = 4D 54 72 6B for each chunk
' aangevuld met nullen, waar we later
' de lengte van de chunk moeten invullen.
' meta-events: (starten steeds met &HFF)
' ***************************************
' algemene kodering:
' 1e byte = &HFF
' 2e byte = type metaevent
' 3e byte = lengte van het metaevent in bytes die volgen
' volgende bytes: data.
' Ze worden hier geschreven met delta-time 0, vandaar
' de twee leading zero's.
'SeqNr$= "00" + "FF0002" + "0001":' = sequence number - not used here
'TxtEv$ = "00" + "FF01" + lengte + tekst in ascii - optional- not used here
' maatcijfer meta-event - koderingsdokumentatie: ------------------------
maattell$ = B2S$(Maatteller%): ' teller= 4 bvb.
SELECT CASE Maatnoemer%
CASE 1
n% = 0: ' hele noot
CASE 2
n% = 1: ' halve noot
CASE 4
n% = 2: ' vierde noot
CASE 8
n% = 3: ' achtste noot
CASE 16
n% = 4 ' 16-e
CASE 32
n% = 5
CASE 64
n% = 6
CASE 128
n% = 7
CASE 256
n% = 8
CASE ELSE
' give error message, or use a default...
n% = 2
END SELECT
maatnoem$ = B2S$(n%)
cc$ = B2S$(24): ' aantal midi-kloks per metronoomtik (24/kwartnoot)
bb$ = B2S$(8): ' aantal tweeendertigste noten per kwartnoot
' (per 24 klokmessages)
TimeSig$ = "00" + "FF5804" + maattell$ + maatnoem$ + cc$ + bb$
' voortekening & modus meta-event:----------------------------------------
' 0-7 = aantal kruisen
' -1 -> -7 = aantal mollen: 2's complement 7-bits
sf$ = B2S$(0)
indien je dit wil gebruiken met mollen moet de string
' geretourneerd door B2S aangepast worden: set het MSB naar 1 !
' Wie tonale muziekjes wil maken, zoeke dit zelf uit...
' modus informatie: 0= majeur, 1=mineur
mi$ = B2S$(0)
' wij stellen de file in als atonaal:
KeySig$ = "00" + "FF5902" + sf$ + mi$
' meta-event voor tempo: --------------------------------------------------
' tempo is uitgedrukt in microsekonden per kwartnoot en beslaat steeds 3 bytes (6 nibbles)
' bvb: MM=40 -> "16E360" omdat 60.000.000/ 40 = &H16E360
tmp$ = HEX$(60000000 / Tempo%)
IF LEN(tmp$) < 6 THEN
DO
tmp$ = "0" + tmp$
LOOP UNTIL LEN(tmp$) = 6
END IF
IF LEN(tmp$) > 6 THEN
PRINT "Illegal tempo !":
SLEEP
END
END IF
Tempo$ = "00" + "FF5103" + tmp$
' meta-event Auteurschap: -------------------------------------------------
IF Author$ <> "" THEN
l$ = MakeChunk$(Author$)
AuthorEvent$ = "00" + "FF02" + l$
ELSE
AuthorEvent$ = ""
END IF
' marker-event: -----------------------------------------------------------
' komt alleen voor in Track1 en geeft analyze informatie mbt. couplet, refrein, reprise etc...
IF Marker$ <> "" THEN
l$ = MakeChunk$(Marker$)
MarkerEvent$ = "00" + "FF06" + l$
ELSE
MarkerEvent$ = ""
END IF
' midi-channel prefix event:-----------------------------------------------
MiChannel$ = "00" + "FF2001" + B2S$(kanaal%)
' sequencer specific event: -----------------------------------------------
tekst$ = "Experimental Music Class"
MsgSx$ = MakeChunk$(tekst$)
SqSx$ = "00" + "FF7F" + MsgSx$
' end-of Nr% event:------------------------------------------------------
' Dit meta-event moet in elk geval in de file staan en moet elke Track afsluiten.
EndOfTrack$ = "00" + "FF2F00"
Nr% = -1
' here starts the real midi-file making procedure...
OPEN fl$ FOR BINARY AS #1
'******************************
'Write global Track-information
'******************************
WriteChunk Header$
MTrkIDPointer& = Wijzer& ' save Pointer& naar Track ID
WriteChunk MTrk$
MTrkDataPointer& = Wijzer& ' save Pointer& naar begin trackdata
WriteChunk TimeSig$ + KeySig$ + Tempo$ + MarkerEvent$ + AuthorEvent$
WriteChunk EndOfTrack$
TrackLenght$ = (HEX$(Wijzer& - MTrkDataPointer&))
MID$(MTrk$, (17 - LEN(TrackLenght$)), LEN(TrackLenght$)) = TrackLenght$
NewTrackPointer& = Wijzer&
Wijzer& = MTrkIDPointer&: ' reset pointer
WriteChunk MTrk$
'*************************************************************************
' here comes the code for the real musical data in the tracks...
DO
Nr% = Nr% + 1: ' starts at zero
' track 0 should be tempo track
LastEvent% = Stem(Nr%).TrackSize + 1: ' Adjust for loopcounter
Stem(Nr%).Ptr = 1
OldPtr% = 1
Wijzer& = NewTrackPointer&
MTrkIDPointer& = Wijzer& 'Pointer naar Track ID
WriteChunk MTrk$
MTrkDataPointer& = Wijzer& 'Pointer naar begin trackdata
' via het meta-event schrijven we de naam van de Track naar de file:
IF Stem(Nr%).PatchName <> "" THEN
l$ = MakeChunk$(Stem(Nr%).PatchName)
TrackNameEvent$ = "00" + "FF03" + l$
ELSE
TrackNameEvent$ = ""
END IF
WriteChunk TrackNameEvent$
' de eigenlijke midi-data:
PutByte 0: ' at zero delta time
PutByte &HC0 + Nr% ' set patches
PutByte Stem(Nr%).Patch
' gebeurlijke andere controllers en pitch wheel kunnen ook hier geinitialiseerd worden...
DO
dT& = Track(Nr%, Tim%, Stem(Nr%).Ptr) - Track(Nr%, Tim%, OldPtr%)
Wrd& = Track(Nr%, Msg%, Stem(Nr%).Ptr)
WriteDeltaT (dT&)
WriteMsg (Wrd&)
LOOP UNTIL Stem(Nr%).Ptr = LastEvent%
WriteChunk EndOfTrack$
' nu moeten we nog de werkelijke lengte schrijven op de plek waar we eerder nullen lieten staan:
TrackLenght$ = (HEX$(Wijzer& - MTrkDataPointer&))
' deze lengte moet naar een string gekonverteerd worden
MID$(MTrk$, (17 - LEN(TrackLenght$)), LEN(TrackLenght$)) = TrackLenght$
' we stellen de pointers opnieuw in:
NewTrackPointer& = Wijzer&
Wijzer& = MTrkIDPointer&
' en schrijven een nieuwe chunk:
WriteChunk MTrk$
LOOP UNTIL Nr% = NrTracks%
CLOSE #1
END SUB
SUB WriteMsg (Word&)
IF Word& > &HFFFFFF THEN
byte% = Word& \ &H1000000:
Word& = Word& AND &HFFFFFF
PutByte byte%
END IF
IF Word& > &HFFFF THEN
byte% = Word& \ &H10000:
Word& = Word& AND &HFFFF&
PutByte byte%
END IF
IF Word& > &HFF THEN
byte% = Word& \ &H100:
Word& = Word& AND &HFF
PutByte byte%
END IF
IF Word& >= 0 THEN
byte% = Word&
PutByte byte%
END IF
' tellerstand bijhouden:
OldPtr% = Stem(Nr%).Ptr
Stem(Nr%).Ptr = Stem(Nr%).Ptr + 1
END SUB
[File: 12.1996]
Terug naar inhoudtafel: <Index Kursus>
Homepage Dr.Godfried-Willem RAES