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