' *************************************************************************** ' * <> * ' * Written with united forces by: * ' * Dr.Godfried-Willem Raes * ' *************************************************************************** ' 30.09.1994: First code attempts by Joachim Brackx ' 11.04.1995: First working model by Johan Vercruysse ' 11.11.1996: Modified and extended as a P(i%,j) TO midi-file translator ' by Godfried-Willem Raes ' 17.12.1996: Optimisation of Track-arrays. ' Typed array variables added (Spoor / Stem). ' 18.12.1996: Further clean-up in function of readability. ' 20.12.1996: dT-procedure improved. ' 28.02.1997: Tonal signatures added. ' 19.03.1997: modified for SEQ-file conversion. ' 08.12.1997: inserted in Zeno and Pollux ' 10.01.1998: re-used for Boxing ' 06.12.1998: translated in Power Pasic - debug to be done! ' 07.12.1998: there are problems witk the file-reading in PBcc, since it does not accept the space as a delimiter ' in our seq file format... ' 08.12.1998: *.SEQ file reading procedure completely rewritten. ' Works again, but there may still be some bugs... ' 20.08.1999: compiled under PBCC 2.0 ' 04.01.2000: recompiled. #DIM ALL #REGISTER ALL %TimeBase = 100: ' we work in centiseconds here! %Tim = 0 ' pointer in Track() to time information in track-array %Msg = 1 ' pointer in Track() to message information in track-array %False = 0 %NotFalse = NOT %False TYPE HarmType Vel AS STRING * 128 ' complete harmony descriptor C(0 TO 11) AS SINGLE ' fuzzy shepard chord descriptor Dis AS SINGLE ' fuzzy dissonance of the harmony Kon AS SINGLE ' fuzzy consonance of the harmony Iprop(0 TO 6) AS SINGLE ' interval property strenghts END TYPE TYPE Spoor Channel AS BYTE ' midi-kanaal PatchName AS STRING * 10 ' midi-patchname Patch AS BYTE ' midi-patchnumber poort AS BYTE ' midi-port Volume AS BYTE ' channel-volume midi number Panning AS BYTE ' channel-panning midi number Aanwijzer AS DWORD ' pointer OldPtr AS DWORD ' previous pointer TrackSize AS DWORD ' size of the track END TYPE GLOBAL NrTracks AS BYTE GLOBAL Tempo% GLOBAL Maatteller AS BYTE GLOBAL Maatnoemer AS BYTE GLOBAL Marker$ GLOBAL Author$ GLOBAL Wijzer& GLOBAL OldPtr AS DWORD GLOBAL Nr AS BYTE GLOBAL Stem() AS Spoor GLOBAL track() AS LONG ' 3 dimensional complete score array in dT GLOBAL acc AS BYTE ' accidentals, -7 -> + 7 GLOBAL modus AS BYTE ' modus:0 = major, 1 = minor GLOBAL HarArray() AS STRING * 128 ' copy of a track in a seq file GLOBAL TikArray() AS DWORD DECLARE SUB FillArray (TrackNr AS BYTE, Time&, duur%, StatusByte AS BYTE, Dat1 AS BYTE, Dat2 AS BYTE) DECLARE SUB RedimTrack (TrackNr AS BYTE, Size AS DWORD) : ' dynamic array dimensioning... DECLARE SUB WriteMid (f$) DECLARE SUB WriteChunk (mifilenr%, chunk$) : ' writes a midi-chunk$ to the midi file ' used only by procedure WriteMid() DECLARE SUB PutByte (mifilenr%, mbyte AS BYTE) DECLARE FUNCTION MakeTempoChunk$ (Tempo%) DECLARE FUNCTION MakeChunk$ (a$) DECLARE FUNCTION B2S$ (BYTE) : ' converts bytes to 2-digit hex-strings DECLARE FUNCTION MakeTimeSigString$ (teller AS BYTE, noemer AS BYTE) DECLARE FUNCTION MakeKeySigString$ (acc AS BYTE, modus AS BYTE) DECLARE FUNCTION MakeTempoString$ (Tempo%) DECLARE SUB GetParameters () DECLARE SUB WriteDeltaT (mifilenr%, dT&) DECLARE SUB WriteMsg (mifilenr%, mWord&) DECLARE SUB ReadHar2Array (fin$, TrackNr AS BYTE) ' new version DECLARE FUNCTION GetDuur (Tick&, note AS BYTE,velo AS BYTE) AS LONG ' new version DECLARE FUNCTION InputString$ () DECLARE FUNCTION InputNumber% () FUNCTION PBMAIN() AS LONG LOCAL cnt AS DWORD LOCAL fin$, MidiFile$ LOCAL Tick& LOCAL Mikan AS BYTE LOCAL ncnt AS BYTE LOCAL velo AS BYTE LOCAL oldvelo AS BYTE LOCAL nootduur& LOCAL duur% LOCAL Nr AS BYTE ' voorlopige dimensionering der dynamische arrays... DIM Stem(0 TO 1) AS GLOBAL Spoor DIM track(0 TO 1, 0 TO 1, 0) AS GLOBAL LONG DIM Har AS HarmType Har.vel = STRING$(128, 0) DIM OldHar AS HarmType OldHar.vel = STRING$(128, 0) ' konversieprogramma: CLS CONSOLE SCREEN 48,80 LOCATE 1,10 PRINT "LogoSoft - *.SEQ to *.MID file conversion utility"; LOCATE 10, 10 PRINT "SEQ - File to convert?"; fin$ = InputString$ fin$ = UCASE$(fin$) IF RIGHT$(fin$, 4) <> ".SEQ" THEN fin$ = fin$ + ".SEQ" LOCATE 10,10 PRINT "Seq file that will be converted= ";fin$; " "; GetParameters ' nu vertalen we de tracks ' Track0 is reserved for tempo and general information. FOR Nr = 1 TO NrTracks Tick& = 0 ' reset counter for each track... Mikan = (Nr - 1) MOD 16 ' midi channel FillArray Nr, Tick&, 0, &HB0 + Mikan, 7, Stem(Nr).Volume ' mastervolume FillArray Nr, Tick&, 0, &HB0 + Mikan, 10, Stem(Nr).Panning ' panning Har.vel = STRING$(128, 0) OldHar.vel = STRING$(128, 0) ReadHar2Array fin$, Nr-1 ' copy the track from the file into memory... LOCATE 2, 10 : PRINT "Converting track nr.="; Nr - 1; " "; cnt = 0 DO Tick& = TikArray(cnt) Har.vel = HarArray(cnt) LOCATE 2, 35 : PRINT "tick= "; Tick&; " "; ncnt = 1 DO velo = ASC(MID$(Har.vel, ncnt, 1)) oldvelo = ASC(MID$(OldHar.vel, ncnt, 1)) nootduur& = -1 ' LOCATE 2, 60 :PRINT "Note=";ncnt%; " / ";velo%; " "; SELECT CASE velo CASE %False ' if oldvelo% was set then we have a note-off ' We should do nothing, but make sure we reset oldhar.vel. MID$(OldHar.vel, ncnt, 1) = CHR$(0) CASE > %False ' the action depends on the value of oldvelo% SELECT CASE oldvelo CASE velo ' the note continues... we do nothing! CASE ELSE ' in case oldvelo was %False we have a new note. ' in case oldvelo was a different value, we have a new attack ' we have to find its duration... nootduur& = Getduur(Tick&, ncnt-1, velo) 'LOCATE 2, 60: PRINT "Duur=";nootduur&;" "; END SELECT MID$(OldHar.vel, ncnt, 1) = CHR$(velo) IF nootduur& > %False THEN IF nootduur& <= &H7FFF THEN duur% = nootduur& ELSE duur% = &H7FFF: ' limit... END IF FillArray Nr, Tick&, duur%, &H90 + Mikan, ncnt-1, velo ' check this -1 !!! END IF END SELECT INCR ncnt '= ncnt% + 1 LOOP UNTIL ncnt > 128 INCR cnt ' no more har$'s found... ' close array, and read a new one if more tracks to convert... LOOP UNTIL cnt > UBOUND(TikArray) NEXT Nr ' track-counter LOCATE 24, 10 PRINT "Output file name?"; MidiFile$ = InputString$ WriteMid MidiFile$ CLOSE END FUNCTION ' -------------- procedures ----- FUNCTION B2S$ (b AS BYTE) ' converts a byte to a 2-digit hex string ' beveiliging IF b < &H10 THEN FUNCTION = "0" + HEX$(b) ELSE FUNCTION = HEX$(b) END IF END FUNCTION SUB FillArray (Nr AS BYTE, Time&, duur%, StatusByte AS BYTE, Dat1 AS BYTE, Dat2 AS BYTE) ' tracknummer tick duur statusbyte note velo LOCAL Mssg& Mssg& = VAL("&H" + B2S$(StatusByte) + B2S$(Dat1) + B2S$(Dat2)) INCR Stem(Nr).aanwijzer RedimTrack Nr, Stem(Nr).aanwijzer: ' lets Track() array grow by resizing with ' preservation of old contents ' doorschuifoperatie: invoegen is mogelijk! ' Niet strikt nodig bij konversie van P(i,j) of HAR$.SEQ formaat omdat ' daarbij nooit noten tussengevoegd worden... ' Ook resizing 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 zware ' snelheids-penalty aan vast, vergeleken dan met een vast geheugenblok. ' In deze toepassing speelt het echter niet echt een rol. ' P(ij) konversie voor een file van 60kB neemt 3" in beslag op een Pentium. ' Har$ conversie duurt wel heel wat langer... 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 ' schrijf de event (noot) - ON gegevens naar de track: track(Nr, %Tim, Stem(Nr).OldPtr + 1) = Time& track(Nr, %Msg, Stem(Nr).OldPtr + 1) = Mssg& Stem(Nr).OldPtr = Stem(Nr).aanwijzer ' invoegen van de midi-note OFF informatie: (hier alleen:144+ k%...) ' na de opgegeven tijdsduur: IF StatusByte >= &H90 AND StatusByte <= &H9F THEN 'Mssg& = Mssg& - Dat2: '= note off Mssg& = Mssg& AND &HFFFF00 Time& = Time& + duur% INCR Stem(Nr).aanwijzer RedimTrack Nr, Stem(Nr).aanwijzer 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 ' write note-off event to track: track(Nr, %Tim, Stem(Nr).OldPtr + 1) = Time& track(Nr, %Msg, Stem(Nr).OldPtr + 1) = Mssg& Stem(Nr).OldPtr = Stem(Nr).aanwijzer END IF END SUB FUNCTION GetDuur (Tick&, note AS BYTE, velo AS BYTE) AS LONG ' note% = 0 to 127 LOCAL i AS DWORD, BeginPointer AS DWORD ' works on memory image of seq file track. FOR i = 0 TO UBOUND(TikArray) IF TikArray(i)=Tick& THEN BeginPointer = i : EXIT FOR NEXT i FOR i = BeginPointer + 1 TO UBOUND(TikArray) IF ASC(MID$(HarArray(i),note+1,1)) <> velo THEN FUNCTION = TikArray(i) - Tick& EXIT FUNCTION END IF NEXT i FUNCTION = -1 END FUNCTION SUB GetParameters ' this procedure lets the user specify conversion parameters ' for the HAR to Midi file conversion. LOCAL Startline AS BYTE, regel AS BYTE, i AS BYTE Startline = 12 regel = Startline LOCATE regel, 10 PRINT "Teller maatcijfer ?"; Maatteller =InputNumber% INCR regel LOCATE regel, 10 PRINT "Noemer maatcijfer ?"; Maatnoemer = InputNumber% INCR regel LOCATE regel, 10 PRINT "Tempo (MM) ?"; Tempo% = InputNumber% INCR regel LOCATE regel, 10 PRINT "Aantal te konverteren stemmen? "; NrTracks = InputNumber% ' reminder: in midi-files, track 0 is used for tempo information! INCR regel IF NrTracks =< 0 THEN NrTracks = 1 LOCATE regel, 10 PRINT "Signature ? (-7 -> +7)"; acc = InputNumber% INCR regel LOCATE regel, 10 PRINT "Major/Minor (0/1)"; modus = InputNumber% INCR regel LOCATE regel, 10 PRINT "Marker ?"; Marker$ = InputString$ INCR regel LOCATE regel, 10 PRINT "Komponist ?"; Author$ = InputString$ INCR regel REDIM Stem(0 TO NrTracks) AS Spoor FOR i = 1 TO NrTracks Stem(i).Channel = (i - 1) MOD 16 Stem(i).PatchName = "Patch" + HEX$(i) Stem(i).Patch = i MOD 128 Stem(i).Poort = 0 ' default is one single midi-port device Stem(i).Panning = 64 Stem(i).Volume = 127 Stem(i).aanwijzer = 0 Stem(i).OldPtr = 0 Stem(i).TrackSize = 0 NEXT i REDIM track(0 TO NrTracks, 0 TO 1, 0) AS LONG ' dynamisch... ' herdimensionering in de loop van het programma LOCATE regel, 10 END SUB FUNCTION MakeChunk$ (a$) LOCAL Instring$, Naam$, NameLen$, i% ' converts a string to the format required by midi-files: ' lenght followed by 7-bit numbers in hex. Instring$ = "" FOR i% = 1 TO LEN(a$) Instring$ = Instring$ + HEX$(ASC(MID$(a$, i%, 1))) NEXT i% Naam$ = Instring$ 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 FUNCTION = Namelen$ + Naam$ END FUNCTION FUNCTION MakeKeySigString$ (acc AS BYTE, modus AS BYTE) LOCAL sf$, mi$ ' parameter= +7= 7 sharps, -7 = 7 flats, 0= no accidentals) ' modus=0 major, modus=1 = minor. IF acc > -1 THEN sf$ = B2S$(acc) ELSE sf$ = B2S$(256 + acc) END IF mi$ = B2S$(modus) FUNCTION = "00" + "FF5902" + sf$ + mi$ END FUNCTION FUNCTION MakeTempoChunk$ (Tempo%) LOCAL Temp$, TempoString$ Temp$ = HEX$(60000000 / Tempo%) TempoString$ = "FF5103" + "000000" MID$(TempoString$, 13 - LEN(Temp$), LEN(Temp$)) = Temp$ FUNCTION = "78" + TempoString$ END FUNCTION FUNCTION MakeTempoString$ (Tempo%) LOCAL tmp$ ' 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 "ERROR: Illegal tempo !" WAITKEY$ EXIT FUNCTION END IF FUNCTION = "00" + "FF5103" + tmp$ END FUNCTION FUNCTION MakeTimeSigString$ (Maatteller AS BYTE, Maatnoemer AS BYTE) LOCAL maattell$, maatnoem$, n AS BYTE ' , cc$, bb$ ' maatcijfer meta-event - koderingsdokumentatie: ------------------------ ' dit komt alleen in Track0 te staan. 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 255 :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) 'FUNCTION = "00" + "FF5804" + maattell$ + maatnoem$ + cc$ + bb$ FUNCTION = "00" + "FF5804" + maattell$ + maatnoem$ + B2S$(24) + B2S$(8) END FUNCTION SUB PutByte (mifilenr%, b?) INCR Wijzer& PUT #mifilenr%, Wijzer&, b? END SUB SUB ReadHar2Array (fin$, track AS BYTE) ' read a track from a seq file in a memory array LOCAL debugthis AS INTEGER, Tick& STATIC oldtrack AS BYTE, Size AS DWORD LOCAL filnr AS WORD, trk AS BYTE, dummy$, tmp$ IF (track <> oldtrack) OR (track = %False) THEN Size=0 REDIM HarArray (0 TO Size) AS GLOBAL STRING * 128 :' HarmType not needed REDIM TikArray (0 TO Size) AS GLOBAL DWORD filnr = FREEFILE OPEN fin$ FOR BINARY AS #filnr oldtrack = track END IF debugthis = %False ' -1 ' start the read procedure: LOCATE 3,10: PRINT "Reading track "; track; " from file..."; WHILE NOT EOF(filnr) tmp$="" DO GET$ filnr,1 ,tmp$ SELECT CASE tmp$ CASE "0" TO "9" EXIT DO CASE ELSE tmp$="" END SELECT LOOP UNTIL EOF(filnr) IF ISTRUE EOF(filnr) THEN EXIT LOOP DO GET$ filnr,1,dummy$ IF dummy$ = CHR$(0) THEN EXIT DO IF dummy$ = "," THEN EXIT DO tmp$ = tmp$ + dummy$ LOOP UNTIL dummy$ = " " trk = VAL(tmp$) IF ISTRUE debugthis THEN IF trk =track THEN LOCATE 3,5: PRINT "track=";trk ; END IF END IF ' now we should have the tracknumber... ' read the tick count now: tmp$="" DO GET$ filnr,1, tmp$ LOOP UNTIL tmp$ <> " " DO GET$ filnr,1,dummy$ IF dummy$ = CHR$(0) THEN EXIT DO IF dummy$ = "," THEN EXIT DO tmp$ = tmp$ + dummy$ IF ISTRUE EOF(filnr) THEN EXIT DO LOOP UNTIL dummy$ = " " tick& = VAL(tmp$) IF ISTRUE EOF(filnr) THEN EXIT LOOP IF ISTRUE debugthis THEN IF trk = track THEN LOCATE 3, 15: PRINT "Tick="; tick&; END IF END IF ' now we should read the harmony string... DO GET$ filnr,1,tmp$ LOOP UNTIL tmp$="H" IF ISTRUE EOF(filnr) THEN EXIT LOOP IF ISTRUE debugthis THEN IF trk = track THEN LOCATE 3, 30: PRINT tmp$; END IF END IF dummy$= STRING$(128,0) GET$ filnr,128,dummy$ IF ISTRUE EOF(filnr) THEN EXIT LOOP IF (trk = track) AND (tmp$ = "H") THEN HarArray(Size) = dummy$ TikArray(Size)= tick& INCR Size REDIM PRESERVE HarArray (0 TO Size) AS GLOBAL STRING * 128 REDIM PRESERVE TikArray (0 TO Size) AS GLOBAL DWORD END IF WEND CLOSE filnr 'IF ISTRUE debugthis THEN LOCATE 3,10: PRINT "Track "; track; " read successfully... "; 'END IF END SUB SUB RedimTrack (Nr AS BYTE, Size AS DWORD) ' 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 AS DWORD IF Size > OldSize THEN REDIM PRESERVE track(0 TO NrTracks, 0 TO 1, 0 TO Size) AS GLOBAL 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 (mifil%, chunk$) LOCAL j AS DWORD , b AS DWORD FOR j = 1 TO LEN(chunk$) STEP 2 b = VAL("&H" + (MID$(chunk$, j, 2))) INCR Wijzer& ' = Wijzer& + 1 PUT #mifil%, Wijzer&, b NEXT j END SUB SUB WriteDeltaT (mifilenr%, dT&) LOCAL b% ' realizes the compressed 7-bit midi-time format (cfr. kursus gwr) DO SELECT CASE dT& CASE > &H1FFFFF b% = dT& \ &H200000 dT& = dT& AND &H1FFFFF CASE > &H3FFF b% = dT& \ &H4000 dT& = dT& AND &H3FFF CASE > &H7F b% = dT& \ &H80 dT& = dT& AND &H7F END SELECT PutByte mifilenr%, b% OR &H80: ' set bit 8, as long as more bytes follow LOOP UNTIL dT& <= &H7F PutByte mifilenr%, INT(dT&): ' LSB, 7-bit code END SUB SUB WriteMid (fl$) LOCAL Mthd$ LOCAL MThdData$ LOCAL Header$ LOCAL Mtrk$ LOCAL AuthorEvent$ LOCAL TimeSig$ LOCAL KeySig$, tekst$, MsgSx$, SqSx$ LOCAL TempoString$, MarkerEvent$, EndOfTrack$ LOCAL mfil% LOCAL MTrkIDPointer&, MTrkDataPointer&, TrackLenght$, NewTrackPointer& ' 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! ' Hence NrTracks%+1 ' 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 ' meta-event Auteurschap: -- (Copyright notice metaevent nr. 3) ----------- IF Author$ <> "" THEN AuthorEvent$ = "00" + "FF02" + MakeChunk$(Author$) ELSE AuthorEvent$ = "" END IF ' meta-event sequence/track name - metaevent nr.4 ' SeqNam$= "00" + "FF03" + lengte + tekst$ TimeSig$ = MakeTimeSigString$(Maatteller, Maatnoemer) KeySig$ = MakeKeySigString$(acc, modus) TempoString$ = MakeTempoString$(Tempo%) ' marker-event: ----------------------------------------------------------- ' komt alleen voor in Track0 en geeft analyze informatie ' mbt. couplet, refrein, reprise etc... IF Marker$ <> "" THEN MarkerEvent$ = "00" + "FF06" + MakeChunk$(Marker$) ELSE MarkerEvent$ = "" END IF ' sequencer specific event: ----------------------------------------------- tekst$ = "Experimental Music Lab" MsgSx$ = MakeChunk$(tekst$) SqSx$ = "00" + "FF7F" + MsgSx$ ' end-of track event:--(metaevent nr.10)----------------------------------- ' Dit meta-event moet in elk geval in de file staan en moet elke ' Trk% afsluiten. EndOfTrack$ = "00" + "FF2F00" ' here starts the real midi-file making procedure... mfil% = FREEFILE OPEN fl$ FOR BINARY AS #mfil% '******************************************* 'Write global Track-information into Track 0 '******************************************* WriteChunk mfil%, Header$ MTrkIDPointer& = Wijzer& ' save Pointer& naar Track ID WriteChunk mfil%, MTrk$ MTrkDataPointer& = Wijzer& ' save Pointer& naar begin trackdata WriteChunk mfil%, TimeSig$ + KeySig$ + TempoString$ + MarkerEvent$ + AuthorEvent$ WriteChunk mfil%, EndOfTrack$ TrackLenght$ = (HEX$(Wijzer& - MTrkDataPointer&)) MID$(MTrk$, (17 - LEN(TrackLenght$)), LEN(TrackLenght$)) = TrackLenght$ NewTrackPointer& = Wijzer& Wijzer& = MTrkIDPointer&: ' reset pointer WriteChunk mfil%, MTrk$ '*************************************************************************** ' here comes the code for the real musical data in the tracks 1 to NrTracks) '*************************************************************************** Nr = 0 LOCAL LastEvent%, l$, TrackNameEvent$, poort$, MiChannel$ DO Nr = Nr + 1: ' starts at 1 ' track 0 should be tempo track LastEvent% = Stem(Nr).TrackSize + 1: ' Adjust for loopcounter Stem(Nr).aanwijzer = 1 OldPtr = 1 Wijzer& = NewTrackPointer& MTrkIDPointer& = Wijzer& 'Pointer naar Track ID WriteChunk mfil%, 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$(BYCOPY Stem(Nr).PatchName) TrackNameEvent$ = "00" + "FF03" + l$ ELSE TrackNameEvent$ = "" END IF WriteChunk mfil%, TrackNameEvent$ ' meta-event voor midi-port mapping----------------------------------- ' this detail is based on documentation found and used by Vercruysse Poort$ = "00" + "FF2101" + B2S$(Stem(Nr).Poort) WriteChunk mfil%, Poort$ ' midi-channel prefix event:----------------------------------------------- MiChannel$ = "00" + "FF2001" + B2S$(Stem(Nr).Channel) WriteChunk mfil%, MiChannel$ ' de eigenlijke midi-data: PutByte mfil%, 0: ' at zero delta time PutByte mfil%, &HC0 + Stem(Nr).Channel: '&HC0 + (Nr% - 1) ' set patches PutByte mfil%, Stem(Nr).Patch ' gebeurlijke andere controllers en pitch wheel kunnen ook hier ' geinitialiseerd worden... ' Data staan in de SEQ file met andere prefixen dan 'H' LOCAL dT&, Wrd& DO dT& = track(Nr, %Tim, Stem(Nr).aanwijzer) - track(Nr, %Tim, OldPtr) Wrd& = track(Nr, %Msg, Stem(Nr).aanwijzer) WriteDeltaT mfil%, (dT&) WriteMsg mfil%, (Wrd&) LOOP UNTIL Stem(Nr).aanwijzer = LastEvent% WriteChunk mfil%, 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 mfil%, MTrk$ LOOP UNTIL Nr = NrTracks CLOSE #mfil% END SUB SUB WriteMsg (mifilenr%, mWord&) LOCAL mByte AS BYTE IF mWord& > &HFFFFFF THEN mByte = mWord& \ &H1000000: mWord& = mWord& AND &HFFFFFF PutByte mifilenr%, mByte END IF IF mWord& > &HFFFF THEN mByte = mWord& \ &H10000: mWord& = mWord& AND &HFFFF& PutByte mifilenr%, mByte END IF IF mWord& > &HFF THEN mByte = mWord& \ &H100: mWord& = mWord& AND &HFF PutByte mifilenr%, mByte END IF IF mWord& >= 0 THEN mByte = mWord& PutByte mifilenr%, mByte END IF ' tellerstand bijhouden: OldPtr = Stem(Nr).aanwijzer Stem(Nr).aanwijzer = Stem(Nr).aanwijzer + 1 END SUB FUNCTION InputString$ ' replaces failing INPUT$ LOCAL k$, ans$ DO k$=INKEY$ IF k$=CHR$(13) THEN EXIT DO SELECT CASE k$ CASE "0" TO "9", "A" TO "Z", "a" TO "z" ans$= ans$ + k$ : PRINT k$; CASE "_","-","." ans$= ans$ + k$ : PRINT k$; END SELECT LOOP FUNCTION = ans$ END FUNCTION FUNCTION InputNumber% ' replaces failing INPUT LOCAL tmp$ tmp$ = InputString$ FUNCTION = VAL(tmp$) END FUNCTION