100 REM Convert MIDI tracks to Music files 110 REM MJM - Mar 10, 2005 120 REM (Mar 14, 2005 - Working fine) 130 REM (Mar 17, 2005 - Note = 0 for RESTs) 140 REM (Mar 20, 2005 - Note codes = Key codes, pre-DEC dur) 150 REM (Mar 21, 2005 - Separate main T, unaffected by notes) 160 REM (Mar 22, 2005 - Zero-filled final music stream pages) 170 REM (Mar 24, 2005 - Implement MIDI running status) 180 REM (Mar 30, 2005 - Fix tempo-change time accounting) 190 REM (Apr 01, 2005 - Page MIDI file for unlimited length) 200 REM (Apr 09, 2005 - Changed REST back to command $81) 210 REM (Apr 11, 2005 - Reassign oscillators on overflow) 220 REM (Apr 12, 2005 - Add instrument/voice support) 230 REM (Apr 13, 2005 - Add all text meta events) 240 REM (Apr 16, 2005 - Implement Sustain control) 250 REM (Apr 29, 2005 - Moved music and MIDI buffers up $1000) 260 REM (Jul 03, 2008 - Increased max oscillators to 12) 270 REM (Jul 08, 2008 - Increased max oscillators to 16) 280 REM (Jul 08, 2008 - Stereo option: odd trks left, even right) 290 : 300 D$ = CHR$ (4) 310 DEF FN D3(X) = INT (X * 1000 + .5) / 1000: REM Round to 3 decimals 320 SBUF = 5 * 4096: REM Room for 16 Oscillator stream buffers 330 MBUF = 6 * 4096: REM MIDI buffer 340 MS = 2 * 4096: REM MIDI buffer size 350 DIR = MBUF + MS: REM Osc directory page buffer 360 NO = 16: REM Maximum number of Oscillators 370 LL = 0:LH = INT (NO / 2) - 1: REM Low and High left chan oscillators 380 RL = LH + 1:RH = NO - 1: REM Low and High right chan oscillators 390 DL = 6: REM Dir entry Length (bytes) 400 V0 = NO * DL: REM Dir voice table start (for osc 0) 410 VM = INT ((256 - V0) / NO) - 1: REM Dir Max Voices per osc 420 SU = 1.020400 / 92: REM Samples per microsecond 430 SS = SU * 1000000: REM Samples per second 440 TM = 120: REM Default tempo = 120 beats/minute 450 UQ = 60 / TM * 1000000: REM Microseconds per quarter note 460 INF = 999999999: REM "infinity" 470 QUIT = 128: REM Stop command byte 480 REST = 129: REM Rest command byte 490 VOICE = 130: REM Voice command byte 500 NM = 254 * 256 + 255: REM Note/Rest max duration 510 ID = 6: REM Instrument default (Piano) 520 PC = 9: REM Percussion channel 530 PN = 127: REM Percussion note (Freq = 1) 540 DIM EN$(7): REM Text Meta-event names 550 FOR I = 1 TO 7: READ EN$(I): NEXT 560 DATA "Misc text","Copyright","Trk Name","Instrument" 570 DATA "Lyric","Marker","Cue Point" 580 : 590 REM Oscillator state 600 OM = NO - 1: REM Oscillators 0..NO-1 610 DIM OTRK(OM): REM Associated Track 620 DIM OX(OM): REM Note/Rest start time 630 DIM OKEY(OM): REM Key 640 DIM OVEL(OM): REM Velocity (0 = Rest) 650 DIM OE(OM): REM 1 if Key Up seen (ends with sustain ctl) 660 DIM OI(OM): REM Oscillator instrument number 670 DIM OW(OM): REM Oscillator voice index 680 DIM OB(OM): REM Buffer byte pointer 690 DIM OP(OM): REM File page pointer 700 : 710 FOR I = 0 TO OM 720 OKEY(I) = REST: REM Initially resting 730 NEXT I 740 : 750 REM Initialize Oscillator Directory page 760 FOR I = 0 TO 255: POKE DIR + I,0: NEXT I: REM Clear to zero 770 FOR OS = 0 TO OM: REM Init Voice lists 780 DP = DIR + DL * OS: REM Osc(OS) directory entry 790 POKE DP + 1,V0 + (VM + 1) * OS: REM Osc(OS) Voice list offset 800 NEXT OS 810 : 820 INPUT "Debug output level (0-2): ";DX 830 IF DX THEN INPUT "Time to start (samples): ";DS 840 IF DS = 0 THEN DB = DX: REM Start now 850 : 860 REM Read in MIDI file 870 INPUT "MIDI file to convert: ";MF$ 880 IF MF$ = "" THEN PRINT D$"catalog,tbin": GOTO 870 890 CF$ = MF$ 900 LS = LEN (MF$) 910 IF MID$ (MF$,LS - 3,4) = ".mid" THEN CF$ = MID$ (MF$,1,LS - 4) 920 SF$ = CF$ + ".u": REM Uncompressed file 930 CF$ = CF$ + ".m": REM Synth Music file 940 PRINT D$"bload "MF$",a"MBUF",l14": REM Read Header 950 MP = MBUF:MX = MP + 14: REM Set to scan header 960 : 970 INPUT "Stereo track split? (y/n): ";A$ 980 ST = (A$ = "y" OR A$ = "Y") 990 : 1000 REM Analyze MIDI file 1010 S$ = "MThd": GOSUB 3590: REM Require match 1020 K = 4: GOSUB 3690: IF N < > 6 THEN PRINT "MThd length not 6.": STOP 1030 GOSUB 3850: GOSUB 3850:MTYP = B: REM MIDI type 1040 GOSUB 3850: GOSUB 3850:NTRK = B: REM Number of tracks 1050 GOSUB 3850:TQ = B: GOSUB 3850:TQ = TQ * 256 + B: REM Ticks / quarter note 1060 SPT = UQ * SU / TQ: REM Samples per tick at default tempo 1070 PRINT "Type "MTYP", "NTRK" tracks, "TQ" ticks per quarter note." 1080 : 1090 DIM TF(NTRK): REM Track buffer start 1100 DIM TP(NTRK): REM Track data Pointer 1110 DIM TX(NTRK): REM Track end pointer 1120 DIM TB(NTRK): REM Track file offset 1130 DIM TE(NTRK): REM Track end file offset 1140 DIM TNT(NTRK): REM Track Next event Time 1150 DIM TC(NTRK): REM Track channel 1160 DIM TI(NTRK): REM Track instrument 1170 DIM TR(NTRK): REM Track running status 1180 : 1190 BS = INT (MS / NTRK): REM Size of track buffers 1200 PRINT "Track buffer size = "BS 1210 : 1220 REM Locate Tracks and fill buffers 1230 FOR TK = 1 TO NTRK 1240 TF(TK) = MBUF + (TK - 1) * BS 1250 TX(TK) = TF(TK) + BS 1260 TP(TK) = TX(TK): REM Force initial buffer fill 1270 TI(TK) = ID: REM Default instrument 1280 IF TK = 1 THEN TB(TK) = MP - MBUF - BS 1290 IF TK > 1 THEN TB(TK) = TE(TK - 1) - BS 1300 MP = TP(TK):MX = TX(TK):TE(TK) = INF 1310 S$ = "MTrk": GOSUB 3590: REM Require match 1320 K = 4: GOSUB 3690:MS = MP: REM Get 4-byte big-endian track length 1330 TE(TK) = TB(TK) + (MP - TF(TK)) + N: REM File-relative Track end + 1 1340 EP = TE(TK) - TB(TK) + TF(TK) 1350 IF TX(TK) > EP THEN TX(TK) = EP:MX = EP: REM End ptr within buffer 1360 GOSUB 3770:TNT(TK) = V * SPT: REM Track first event time 1370 TP(TK) = MP: REM Track start 1380 PRINT "Track "TK" starts at "TB(TK)" and ends at "TE(TK) - 1 1390 NEXT 1400 : 1410 REM Process merged track streams 1420 T = INF 1430 FOR I = 1 TO NTRK 1440 IF T > TNT(I) THEN T = TNT(I):TK = I: REM Find track with earliest event 1450 NEXT 1460 IF DX THEN IF T > = DS THEN DB = DX: REM Turn on debug output 1470 IF T = INF GOTO 2840: REM All MIDI events processed. 1480 : 1490 REM Process next MIDI event 1500 MP = TP(TK):MX = TX(TK) 1510 SM = INT (TR(TK) / 16):CH = TR(TK) - 16 * SM: REM Decode running status 1520 GOSUB 3850 1530 IF B < > 255 GOTO 1750 1540 : 1550 REM Process Meta event 1560 TR(TK) = 0: REM Cancel running status 1570 GOSUB 3850:EV = B 1580 IF EV < > 81 GOTO 1660: REM Tempo change 1590 GOSUB 3850:K = B: GOSUB 3690:PSPT = SPT:SPT = N * SU / TQ 1600 GOSUB 4140: PRINT "Tempo change: SPT = "SPT 1610 FOR I = 1 TO NTRK: REM Adjust next times on other tracks 1620 IF I < > TK THEN TNT(I) = T + (TNT(I) - T) * SPT / PSPT 1630 NEXT I 1640 GOTO 2060 1650 : 1660 IF 1 < = EV AND EV < = 7 THEN GOSUB 4140: PRINT EN$(EV)": ";: GOSUB 3960: GOTO 2060 1670 IF EV = 47 THEN TNT(TK) = INF: GOTO 1410: REM End of track 1680 GOSUB 4140: PRINT "Skipping Meta event "EV": "; 1690 GOSUB 3850:L = B 1700 FOR I = 1 TO L: GOSUB 3850: PRINT B" ";: NEXT I: REM Pass event data 1710 PRINT 1720 GOTO 2060 1730 : 1740 REM Process ordinary event 1750 IF B < 128 THEN B1 = B: GOTO 1800: REM Use current STatus/CHannel 1760 SM = INT (B / 16):CH = B - 16 * SM: REM MIDI status & MIDI channel 1770 TR(TK) = B: REM Save running status 1780 TC(TK) = CH: REM Save channel 1790 GOSUB 3850:B1 = B: REM Load first data byte 1800 IF SM = 12 THEN TI(TK) = (B1 > 0) * B1 + (B1 = 0) * ID: GOSUB 4140: PRINT "Ch "CH" Patch change: "TI(TK): GOTO 2060 1810 IF SM = 13 THEN B2 = - 99: GOTO 2050: REM Skip 1-byte events 1820 GOSUB 3850:B2 = B: REM Load second data byte 1830 KY = B1: REM Save key 1840 IF SM = 9 AND B2 > 0 GOTO 2100: REM Key Down 1850 IF SM = 8 OR (SM = 9 AND B2 = 0) GOTO 2640: REM Key Up 1860 IF SM < > 11 GOTO 2050: REM Not a Control Change 1870 : 1880 GOSUB 4140: PRINT "Ch "CH" Control "B1" set to "B2 1890 IF B1 < > 64 GOTO 2060: REM Not the Sustain control 1900 IF B2 > 63 THEN SC = 1: GOTO 2060: REM Set Sustain control 1910 IF SC = 0 GOTO 2060: REM Ignore multiple releases 1920 SC = 0: REM Sustain released 1930 FOR OS = 0 TO OM: REM Emit notes on sustained, sounding osc's 1940 IF NOT (OE(OS) AND OVEL(OS)) GOTO 2020 1950 OE(OS) = 0: REM Reset sustained flag 1960 TT = INT (T): REM Quantized time may be adjusted for notes 1970 DT = TT - OX(OS): REM Total Note time 1980 B = OKEY(OS): GOSUB 3260: REM Emit note 1990 OX(OS) = TT: REM Rest start time 2000 OKEY(OS) = REST: REM Rest 2010 OVEL(OS) = 0: REM Rest vel = 0 2020 NEXT OS 2030 GOTO 2060 2040 : 2050 GOSUB 4140: PRINT "Skipping event "SM":"CH", "B1" "B2 2060 GOSUB 3770:TNT(TK) = T + V * SPT: REM Full precision time 2070 TP(TK) = MP 2080 GOTO 1410 2090 : 2100 REM Process Key down event 2110 IF TC(TK) = PC THEN TI(TK) = B1 + 128:B1 = PN: REM Percussion inst 2120 REM Allocate an oscillator 2130 IF NOT ST THEN SL = 0:SH = OM: GOTO 2160: REM No stereo mapping 2140 SL = LL:SH = LH: REM Left channel if TK odd 2150 IF TK / 2 = INT (TK / 2) THEN SL = RL:SH = RH: REM Right chan if TK even 2160 I = SL:VC = 0: REM Any osc playing same note, same inst? 2170 IF I < = SH THEN IF OKEY(I) < > B1 OR OI(I) < > TI(TK) THEN I = I + 1: GOTO 2170 2180 IF I < = SH THEN OS = I:OZ = OZ + 1: GOTO 2310: REM Yes, re-sound note 2190 I = SL: REM Nope, find resting osc w/ same Inst 2200 IF I < = SH THEN IF OVEL(I) OR OI(I) < > TI(TK) THEN I = I + 1: GOTO 2200 2210 IF I < = SH THEN OS = I: GOTO 2380: REM Found resting osc, same Inst 2220 I = SL:VC = 1: REM Nope, find resting osc (w/ voice on list) **** 2230 IF I < = SH THEN IF OVEL(I) THEN I = I + 1: GOTO 2230 2240 IF I < = SH THEN OS = I: GOTO 2350: REM Found a resting osc 2250 REM **** IF IL < = SH THEN OS = IL: GOTO 2070: REM Use resting osc w/ shortest list 2260 MT = T: REM None resting, must re-assign an osc. (at time T) 2270 REM Re-assign osc playing longest-sounding note 2280 FOR I = SL TO SH: IF OX(I) < MT THEN MT = OX(I):OS = I: NEXT I 2290 IF DB THEN GOSUB 4140: PRINT "Reassign Osc "OS" ("OTRK(OS)") ==> Tk "TK 2300 IF DB THEN PRINT SPC( 36)"Sounded Inst "OI(OS)" for " FN D3((T - MT) / SS)" sec." 2310 RT = T: REM Save last reassignment time 2320 OA = OA + 1: REM Count reassignments 2330 VC = (OI(OS) < > TI(TK)): REM Voice change? 2340 GOTO 2370 2350 REM -- Emit initial 2 sec rest if first use of oscillator 2360 IF OTRK(OS) = 0 THEN B = REST:DT = INT (2 * SS): GOSUB 3260 2370 OI(OS) = TI(TK) 2380 REM -- Process note 2390 OTRK(OS) = TK 2400 OE(OS) = 0 2410 IF DB > 0 THEN GOSUB 4140: PRINT "Key Down, Ch "CH": "KY" ("B2")" 2420 TT = INT (T): REM Quantized time may be adjusted for notes 2430 DT = TT - OX(OS): REM Total time for rest or note 2440 B = OKEY(OS): GOSUB 3260: REM Emit rest or note 2450 OX(OS) = TT: REM Note start time 2460 OKEY(OS) = B1: REM Note key 2470 OVEL(OS) = B2: REM Note velocity 2480 IF NOT VC GOTO 2060: REM No voice change 2490 : 2500 REM Voice change. Search Osc instrument list for voice 2510 VL = DIR + PEEK (DIR + DL * OS + 1): REM Voice list ptr 2520 VN = PEEK (VL): REM Number of entries 2530 J = 1 2540 IF J < = VN AND PEEK (VL + J) < > OI(OS) THEN J = J + 1: GOTO 2540 2550 IF J < = VN GOTO 2610: REM Found voice, emit change 2560 IF J > VM THEN E$ = "Osc voice list overflow": GOTO 4020 2570 POKE VL,J: REM Increase list size by 1 2580 POKE VL + J,OI(OS): REM Add new voice 2590 IF DB > 0 THEN GOSUB 4140: PRINT "Inst "OI(OS)" added. Index = "J - 1 2600 REM Emit Voice change 2610 BB = VOICE: GOSUB 3470:BB = J - 1: GOSUB 3470:BB = 0: GOSUB 3470 2620 GOTO 2060 2630 : 2640 REM Process Key up event 2650 IF TC(TK) = PC THEN B1 = PN: REM Percussion note (Freq = 1) 2660 I = 0: REM Find Osc playing key B1, Inst TI(TK) for track TK 2670 IF I < = OM THEN IF OKEY(I) < > B1 OR OTRK(I) < > TK OR OI(I) < > TI(TK) THEN I = I + 1: GOTO 2670 2680 OS = I 2690 SC$ = "": IF SC THEN SC$ = " Sustained" 2700 IF DB > 0 THEN GOSUB 4140: PRINT "Key Up, Ch "CH": "KY" ("B2")"SC$ 2710 IF OS > OM THEN GOSUB 4140: PRINT "Osc reused. " FN D3((T - RT) / SS)" sec trimmed": GOTO 2060 2720 REM Found oscillator 2730 IF SC THEN OE(OS) = 1: GOTO 2060: REM Note is Sustained 2740 OE(OS) = 0 2750 REM Emit pending note and go to Rest state 2760 TT = INT (T): REM Quantized time may be adjusted for notes 2770 DT = TT - OX(OS): REM Total Note time 2780 B = B1: GOSUB 3260: REM Emit note 2790 OX(OS) = TT: REM Rest start time 2800 OKEY(OS) = REST: REM Rest 2810 OVEL(OS) = 0: REM Rest vel = 0 2820 GOTO 2060 2830 : 2840 REM Finalize oscillators and flush final partial stream pages 2850 T = TT: REM Save final time 2860 FOR OS = 0 TO OM 2870 IF OTRK(OS) = O GOTO 2970: REM Skip unused oscillators 2880 OC = OC + 1: REM Count ocillators used 2890 TT = T: REM Ending time for final rests 2900 DT = TT - OX(OS): REM Total time to rest 2910 B = REST: GOSUB 3260 2920 DT = INT (2 * SS): GOSUB 3260: REM Add final 2 second rest 2930 BB = QUIT: GOSUB 3470: REM Emit Stop command 2940 LG = OB(OS) 2950 IF OB(OS) THEN GOSUB 3420: REM Zero-pad final page 2960 OB(OS) = LG: REM Restore used length of stream 2970 NEXT OS 2980 : 2990 GOSUB 4140: PRINT "MIDI processing complete" 3000 PRINT OC" oscillators used, "OA - OZ" reassignments, "OZ" restrikes" 3010 PRINT "Creating SYNTH file "CF$ 3020 FC = 256: REM initial byte pointer of SYNTH file 3030 : 3040 FOR OS = 0 TO OM 3050 IF OP(OS) = 0 GOTO 3190: REM Skip unused oscillator 3060 DP = DIR + DL * OS: REM Directory pointer 3070 POKE DP,OTRK(OS): REM Most recent Track 3080 POKE DP + 2,0: POKE DP + 3,FC / 256: REM Starting byte offset 3090 POKE DP + 4,OB(OS): POKE DP + 5,OP(OS) - (OB(OS) > 0): REM Byte length 3100 : 3110 FOR FP = 0 TO OP(OS) STEP 16 3120 FB = 100 * 256 * OS + 256 * FP: REM Sparse file byte pointer 3130 PL = OP(OS) - FP: IF PL > 16 THEN PL = 16 3140 PRINT D$"bload "SF$",a"SBUF",l"PL * 256",b"FB 3150 PRINT D$"bsave "CF$",a"SBUF",l"PL * 256",b"FC 3160 FC = FC + 256 * PL 3170 NEXT FP 3180 : 3190 NEXT OS 3200 : 3210 PRINT D$"bsave "CF$",l256,b0,a"DIR: REM Write out directory page 3220 PRINT D$"delete "SF$: REM Delete temp file 3230 PRINT "Done." 3240 END 3250 : 3260 REM Emit (possibly long) note or rest B of INT(DT) sample times 3270 IF DT < = NM THEN D = DT:BB = B: GOTO 3330: REM Emit one note or rest 3280 IF B < > REST THEN GOSUB 4140: PRINT "Padding "DT" sample note with rest" 3290 D = NM:BB = B: GOSUB 3330:DT = DT - NM: REM Emit max length note or rest 3300 IF DT > NM THEN D = NM:BB = REST: GOSUB 3330:DT = DT - NM: GOTO 3300 3310 D = DT:BB = REST: REM Emit final rest 3320 : 3330 REM Emit note or rest BB of INT(D) sample times 3340 IF D < 2 THEN TT = OX(OS): RETURN : REM Skip if below minimum 3350 GOSUB 3470: REM Emit note or rest BB 3360 D = D - 1: REM Compensate for SYNTH fetch time 3370 HI = INT (D / 256):LO = D - 256 * HI 3380 BB = LO: GOSUB 3470: REM Emit Duration Lo 3390 BB = HI: GOSUB 3470: REM Emit Duration Hi 3400 RETURN 3410 : 3420 REM Zero fill final Osc OS buf page and flush to disk 3430 BP = SBUF + 256 * OS 3440 FOR Z = BP + OB(OS) TO BP + 255: POKE Z,0: NEXT Z 3450 GOTO 3520 3460 : 3470 REM Emit byte BB for Osc OS 3480 IF DB > 1 THEN PRINT "Osc "OS" byte "OB(OS) + 256 * OP(OS)", emitting "BB 3490 BP = SBUF + 256 * OS 3500 POKE BP + OB(OS),BB 3510 IF OB(OS) < 255 THEN OB(OS) = OB(OS) + 1: RETURN 3520 REM Page buffer full, write it to file 3530 FB = 100 * 256 * OS + 256 * OP(OS): REM File page pointer 3540 PRINT D$"bsave "SF$",l256,a"BP",b"FB: REM Save page 3550 OP(OS) = OP(OS) + 1: IF OP(OS) > 99 THEN PRINT "Osc "OS" overflow": STOP 3560 OB(OS) = 0 3570 RETURN 3580 : 3590 REM Match string S$ at MP or fail 3600 L = LEN (S$) 3610 FOUND = 1 3620 FOR I = 1 TO L 3630 GOSUB 3850: REM Get next byte B 3640 IF B < > ASC ( MID$ (S$,I,1)) THEN FOUND = 0:I = L + 1 3650 NEXT 3660 IF NOT FOUND THEN E$ = "Missing " + S$: GOTO 4020 3670 RETURN 3680 : 3690 REM Collect K-byte big-endian number at MP 3700 GOSUB 3850:N = B 3710 FOR I = 1 TO K - 1 3720 GOSUB 3850 3730 N = 256 * N + B 3740 NEXT 3750 RETURN 3760 : 3770 REM Collect variable-length number at MP 3780 V = 0 3790 GOSUB 3850 3800 V = V * 128 3810 IF B < 128 THEN V = V + B: RETURN 3820 V = V + B - 128 3830 GOTO 3790 3840 : 3850 REM Get byte B at MP from track TK buffer, advancing MP 3860 IF MP < MX THEN B = PEEK (MP):MP = MP + 1: RETURN 3870 REM Load next buffer of track TK 3880 TB(TK) = TB(TK) + BS 3890 IF TB(TK) > = TE(TK) THEN E$ = "Track overflow": GOTO 4020 3900 MP = TF(TK) 3910 PRINT D$"bload "MF$",b"TB(TK)",a"MP",l"BS 3920 EP = TE(TK) - TB(TK) + TF(TK) 3930 IF TX(TK) > EP THEN TX(TK) = EP:MX = EP: REM End ptr within buffer 3940 GOTO 3850: REM Now return the byte 3950 : 3960 REM Print length-prefixed string at MP 3970 GOSUB 3850:L = B 3980 FOR I = 1 TO L: GOSUB 3850: PRINT CHR$ (B);: NEXT 3990 PRINT 4000 RETURN 4010 : 4020 REM Report error and stop 4030 GOSUB 4140: PRINT E$ 4040 FOR I = - 6 TO 6 4050 IF I = 0 THEN INVERSE 4060 PRINT PEEK (MP + I); 4070 NORMAL 4080 PRINT " "; 4090 NEXT 4100 PRINT 4110 GOSUB 4180 4120 STOP 4130 : 4140 REM print advisory prefix 4150 PRINT "T = " INT (T)", Tk "TK", MP "MP", Osc "OS": "; 4160 RETURN 4170 : 4180 REM Print Oscillator state 4190 FOR Z = 0 TO OM 4200 PRINT "Osc "Z": Trk "OTRK(Z)", Start "OX(Z)", Key "OKEY(Z)", Vel "OVEL(Z)",Byte "OB(Z)", Page "OP(Z) 4210 NEXT Z 4220 RETURN