800 REMark MIDI Player 2.1 for Unix and Gnu Linux under UQLX 810 REMark Adaptations by Simon N. Goodwin, April..July 2003 820 REMark Delete lines 900 to 980 if loading with 830 REMark the original BOOT program which assigns these 840 REMark variables with DIY Toolkit SET commands. 850 : 860 REMark LRESPR TIMING_CODE rather than MIDIxx_CODE as 870 REMark this uses SuperBASIC PROCedures for the MIDI 880 REMark output and only needs DIY Timer extensions. 890 : 900 MidiDevDir$="flp1_" 910 MapDevDir$="flp1_" 920 PaperColor=0: InkColor=7 930 WTV 4 940 Lsize=0 950 StripColor=2: stripInk=7 960 SkipPrint=1:InitTime=1 970 StoreMsg$="NO":RunStatus$="NO" 980 : 990 OPEN #9,"/dev/midi00" 1000 IMPLICIT% event,Track,Event_Time,EventBytes,T,MoreChart,con,Meta,NumEvents:REMark Needed for Turbo 1010 MIDIPlayer:REMark allows running in interpreted SuperBasic with MERGED MIDIPlayer_boot 1020 DEFine PROCedure MIDIPlayer 1030 REMark MIDIPlayer version 2.1 Standard MIDI File Player Copyright A.Boehm 22 Jan 2000, 31 May 2001 1040 REMark Version 2.1 can play type 1 SMF files that use running status. The ram copy of the SMF file is changed so do not save it! 1045 REMark V2.1 is the same as V2 except misspellings in Find_Events and Next_Event have been corrected. 1050 REMark Many thanks to Simon N. Goodwin who not only developed the DIY_MIDI keywords but provided many helpful hints and sugestions. 1060 REMark All are welcome to use any or all of the procedures or functions in your own MIDI programs (even ones sold for profit), but please rename them if you modify them. I and others hope to write a series of freeware QL MIDI tools. However, chaos will result if routines with the same name do different things. Please notify me of any bugs or fixes or wishes. Email: boehm@ziplink.net Regular mail: Al Boehm, 2501 Ermine Drive, Huntsville, AL 35810, USA. My phone is 256 859-8051. God bless, Al 1070 REMark Most procedures use some global variables. These are listed in a REMark following the Def Proc statement. 1080 DIM choice$(2),text$(256),FileName$(50),Clock$(7),I$(256),devdir$(40),MapDD$(40),ext$(3),Track$(3) 1090 f256=256:f128=128:REMark float 256, 128 1100 devdir$=MidiDevDir$:REMark MidiDevDir$ SET in boot. devdir$ can be changed in program 1110 MapDD$=MapDevDir$ :REMark same as above 1120 dum=1:REMark dummy variable 1130 : 1140 Set_Up :REMark t_td 1150 : 1160 REPeat Select_and_Play 1170 Select_file :REMark Fstart,File_Length 1180 : 1190 REPeat Check_File 1200 SongLoaded=0:REMark Once a file is read, this is set. So if still 0, no file in yet. 1210 IF LEN(FileName$)=0 THEN EXIT Check_File 1220 IF StoreMsg$<>'NO' THEN MMsg=FOP_OVER(StoreMsg$):ELSE MMsg=-1:REMark file name SET in boot 1230 Initial_Chunk :REMark Fstart,NumTracks,Clock$,cpqn 1240 IF file$='BAD' THEN CLS#2:PRINT#2, TO 2*LM,'File no good. Press any key to continue.':choice$=INKEY$(-1):EXIT Check_File 1250 DIM times(NumTracks),Nbytes(NumTracks),Tstart(NumTracks),Tlen(NumTracks): REMark time is units of timer, e.g. 1/50 or 1/60 seconds, Nbytes is bytes in next event. 1260 Find_Track_Starts :REMark NumTracks,File_Length, Tstart,Tlen 1270 IF file$='BAD' THEN CLS#2:PRINT#2, TO 2*LM,'File no good. Press any key to continue.':choice$=INKEY$(-1):EXIT Check_File 1280 MaxEvents=File_Length/3:REMark this is a generous estimate, only close to this if nothing but running status. 1290 IF MaxEvents>32767 THEN MaxEvents=32767:REMark max value for array index 1300 DIM Event_Time(MaxEvents),EventBytes(MaxEvents),Event_At(MaxEvents) 1310 Find_Events :REMark NumTracks,NumEvents,SkipPrint,T_dt,TStart,Event_Time,EventBytes 1320 IF MapChange$='YES' THEN Patch_Change 1330 SongLoaded=1:EXIT Check_File 1340 END REPeat Check_File 1350 : 1360 IF MMsg>2:CLOSE#MMsg 1370 REPeat Song 1380 IF SongLoaded THEN Play :REMark NumEvents, Event_Time,EventBytes 1390 Title 1400 REPeat choose 1410 CLS:PRINT 1420 IF SongLoaded THEN 1430 PRINT' Play song again? ' 1440 PRINT:PRINT TO LM;' Y Yes.' 1450 END IF 1460 PRINT TO LM;" C Choose a new song." 1470 PRINT TO LM;' M Load a MIDI map' 1480 PRINT TO LM;' T Test MIDI hookup using "Twinkle.."' 1490 PRINT TO LM;' Q Quit.' 1500 choice$ = INKEY$(-1) 1510 choice=CODE(choice$) 1520 SELect ON choice 1530 =CODE('Y'),CODE('y'): IF MaxEvents=0 THEN BUZZZ:ELSE EXIT choose 1540 =CODE('C'),CODE('c'): EXIT choose 1550 =CODE('Q'),CODE('q'): EXIT choose 1560 =CODE('T'),CODE('t'): Twink 1570 =CODE('M'),CODE('m'): GetMIDIMap:IF ch >0 THEN Patch_Change 1580 =REMAINDER :BUZZZ 1590 END SELect 1600 END REPeat choose 1610 IF choice$ INSTR 'C' THEN EXIT Song 1620 IF choice$ INSTR 'Q' THEN EXIT Song 1630 CLS 1640 END REPeat Song 1650 IF SongLoaded THEN RECHP Fstart :CLS 1660 IF choice$ INSTR 'Q' THEN EXIT Select_and_Play 1670 END REPeat Select_and_Play 1680 WINDOW 256,220,256,0:WINDOW#2,256,220,0,0:WINDOW#0,512,36,0,220:PAPER 2:INK 7:PAPER#2,4:INK#2,0:PAPER#0,0:INK#0,4:CLS:CLS#2:CLS#0 1685 CLOSE #9 1690 STOP 1700 END DEFine MIDIPlayer 1710 : 1720 REMark * * * * * * * * * * * * * * * * * * * * * * * 1730 : 1740 DEFine PROCedure Set_Up :REMark T_dt, Lmargin 1750 REMark Print initial info, test or not using twink 1760 REMark Copyright 3 Nov 1999 by A.Boehm 1770 REMark All may use provided no change, or new name given to changed version. 1780 PAPER 0:CLS:REMark this is to clear larger screens if active. 1790 REMark Lsize set to 1 gives large characters 1800 DIM s$(2) 1810 WINDOW 512,220,0,0:PAPER PaperColor:CLS 1820 WINDOW 512-30,220-40,20,40:INK InkColor:REMark this smaller window has margins 1830 OPEN#2,con_512x40a0x0_230:REMark Only a scr is needed but con is kept for running it interpreted. 1840 WINDOW#2,512,40,0,0:PAPER#2,PaperColor:INK#2,InkColor:CLS#2 1850 WINDOW#0,512,36,0,220:PAPER#0,0:INK#0,4:CLS#0 1860 CSIZE#0,0,0:AT#0,1,81:AT#0,1,48:PRINT#0,'Use Ctrl C if no Blinking Cursor -->'; 1870 CURSEN#0:REMark for multtaking in compiled program 1880 CSIZE Lsize,Lsize 1890 Title:REMark prints Midi Player in window#2 1900 IF Lsize=0 THEN LM=4:s$=' ':ELSE LM=0:s$=CHR$(10)&' ':CSIZE#2,1,1:REMark LM= Left Margin, s$=newline for large print 1910 PRINT TO LM; "Plays Standard MIDI Files (SMF)";s$;"using Simon N. Goodwin's DIY_MIDI." 1920 PRINT TO LM;'A MIDI synth or keyboard must be connected';s$; 'to your QL via the NET port.' 1930 PRINT TO LM;'Toolkit II must be active.';s$;' MIDIPlayer_boot causes LRESPR MIDI2e_bin,' 1940 PRINT TO LM;'LRESPR SET_code and PIPES_code' 1950 PRINT:IF Lsize=1 THEN PRINT TO LM;'Press any key to continue':choice$=INKEY$(-1):CLS 1960 PRINT TO LM;'This version only plays SMF type 0 and 1';s$;'but not 2 which is rare.' 1970 IF Lsize=0 THEN PRINT 1980 PRINT TO LM;'MIDIPlayer is set up for a General MIDI synth.';s$;' If yours is not,';:IF Lsize=0 THEN PRINT 1990 PRINT TO LM;'voicings may be odd. ';s$;'The program MIDI_Map makes a MIDIMap_dat file' 2000 PRINT TO LM;'that can be loaded by MIDIPlayer to change voicings.' 2010 IF Lsize=0 THEN PRINT 2020 IF Lsize=1 THEN PRINT: PRINT TO LM;'Press any key to continue':choice$=INKEY$(-1):CLS 2030 PRINT TO LM;'Copyright Al Boehm, 17 February 2000' 2040 PRINT TO LM;'All may make a copy provided no changes are made.' 2050 SynthReset:REMark Reset$ is SET in MIDIPlayer_boot. 2060 PRINT:PRINT ' Checking Computer Speed.'; 2070 GetSpeed : REMark sets T_dt to 1/50 or 1/60 second 2080 PRINT ' Done: ';1/T_dt;' Hertz' 2090 IF Lsize=1 THEN PRINT: PRINT TO LM;'Press any key to continue.':choice$=INKEY$(-1):CLS 2100 DIM MapChange$(3): MapChange$='NO':REMark set default 2110 REPeat TestTwinkle 2120 PRINT TO LM; 'Press T for MIDI test of 1st 7 notes of Twinkle,...' 2130 PRINT TO LM;' M to load MIDI map for non-General MIDI Synths.'\TO LM;' Any other Key to go on.' 2140 choice$=INKEY$(-1) 2150 CLS 2160 IF choice$ INSTR 'T' THEN Twink:choice$='OK' 2170 IF choice$ INSTR 'M' THEN GetMIDIMap:IF choice<>ESC THEN MapChange$='YES':choice$='OK' 2180 CLS 2190 IF choice$<>'OK' THEN EXIT TestTwinkle 2200 END REPeat TestTwinkle 2210 END DEFine Set_Up 2220 REMark * * * * * * * * * * * * * * * * * * * * * * * 2230 : 2240 DEFine PROCedure Title 2250 REMark prints title in window#2. 22 Jan 2000 by A.Boehm 2260 CLS#2 2270 CSIZE #2,3,1:PRINT#2,TO 10;'MIDI Player'; 2280 CSIZE#2,0,0 2290 AT#2,2,32:PRINT#2,'Version 2'; 2300 END DEFine Title 2310 REMark * * * * * * * * * * * * * * * * * * * * * * * 2320 : 2330 DEFine PROCedure Select_file :REMark Fstart,File_Length,Lmargin 2340 REMark returns ram address of file and filelength 2350 REMark Copyright 6 Dec 1999 by A.Boehm 2360 REMark All may use provided no change, or new name given to changed version. 2370 : 2380 ext$='MID':Get_File :REMark ext$,devdir$, FileName$, returns ch 2390 IF ch<0 THEN RETurn :REMark null choice or invalid file 2400 PRINT TO 10; 'Loading ';FileName$; 2410 File_Length=FLEN(#ch) 2420 Fstart=ALCHP(File_Length) 2430 LBYTES FileName$,Fstart 2440 CLOSE#ch 2450 PRINT ' Loaded.' 2460 PRINT TO LM;'File_Length=';File_Length 2470 END DEFine Select_file 2480 REMark * * * * * * * * * * * * * * * * * * * * * * * 2490 : 2500 DEFine PROCedure Initial_Chunk :REMark (Fstart,NumTracks,Clock$,cpqn) 2510 REMark MIDI files consist of sections called chunks; one initial chunk and a chunk for each track. 2520 REMark returns numtracks, Clock$ [='cpqn' or 'seconds'] and initial cpqn 2530 REMark Copyright 8 Dec 1999 by A.Boehm 2540 REMark All may use provided no change, or new name given to changed version. 2550 DIM MThd$(4),file$(4) 2560 : 2570 REMark Initial chunk MThd i.e. 1st 4 bytes are MThd 2580 Bat=Fstart 2590 MThd$=PEEK$(Bat,4):Bat=Bat+4 2600 IF MThd$ <> 'MThd' THEN PRINT FileName$;' with 1st 4 bytes: '; MThd$;' is not Standard MIDI File':file$='BAD':RETurn 2610 Chunk = (((PEEK(Bat)*f256)+PEEK(Bat+1))*f256+PEEK(Bat+2))*f256+PEEK(Bat+3):Bat=Bat+4:REMark lenght = 4 bytes 2620 FType = PEEK(Bat)*256+PEEK(Bat+1):Bat=Bat+2 2630 NumTracks = PEEK(Bat)*256+PEEK(Bat+1):Bat=Bat+2 2640 text$='SMF File Type='&FType&' Number of tracks='&NumTracks 2650 IF MMsg>0 THEN PRINT#MMsg,' File name=';FileName$ 2660 PrintText 2670 T1= PEEK(Bat):Bat=Bat+1 2680 T2= PEEK(Bat):Bat=Bat+1 2690 IF T1<128 THEN 2700 Clock$='cpqn': cpqn=T1*256+T2: REMark clocks (tics) per quarter note 2710 IF cpqn=0 THEN cpqn=24: REMark 24 is default 2720 PRINT TO LM;'Time resolution ';cpqn;' clocks (tics) per quarter note' 2730 ELSE 2740 Clock$='seconds' 2750 frames=256-T1:subframes=T2 2760 seconds=frames*subframes: REMark time resolution in fraction of a second 2770 PRINT TO LM;'Time resolution in ';seconds;' seconds' 2780 END IF 2790 file$='GOOD' 2800 END DEFine Initial_Chunk 2810 REMark * * * * * * * * * * * * * * * * * * * * * * * 2820 : 2830 DEFine PROCedure Find_Track_Starts :REMark NumTracks,filelength,Tstart,Tlen,LM 2840 REMark given numtracks and start of 1st track [tstart(1) finds lengths and starts for all tracks. 2850 REMark Copyright 8 Dec 1999 by A.Boehm 2860 REMark All may use provided no change, or new name given to changed version. 2870 DIM MTrk$(4) 2880 REMark Find start of Track Chunks 2890 FOR Track=1 TO NumTracks 2900 MTrk$=PEEK$(Bat,4):Bat=Bat+4 2910 IF MTrk$ <> 'MTrk' THEN PRINT 'Error ';MTrk$;' found instead of MTrk at';Bat :file$='BAD':RETurn 2920 Tlen(Track) = (((PEEK(Bat)*f256)+PEEK(Bat+1))*f256+PEEK(Bat+2))*f256+PEEK(Bat+3):Bat=Bat+4:REMark lenght = 4 bytes 2930 Tstart(Track)=Bat 2940 Bat=Bat+Tlen(Track) 2950 END FOR Track 2960 PRINT TO LM; 'Start of all tracks found.' 2970 IF MMsg>0 THEN PRINT#MMsg,'Start of all tracks found.' 2980 END DEFine Find_Track_Starts 2990 REMark * * * * * * * * * * * * * * * * * * * * * * * 3000 : 3010 DEFine PROCedure Find_Events :REMark NumTracks,NumEvents,T_dt,Tstart,Event_Time,EventBytes,MaxEvents 3020 REMark Find_Events use proc Nexttime to search through the tracks for MIDI events and saves their start time and number of bytes. Nexttime also prints optionally (SkipPrint>0) those MIDI Meta events which are comments such as the title, copyright, musical key, etc. 3030 REMark Running status means the first byte of the MIDI message is not a status byte (byte >127), instead use previous status. If a message occurs from another track inbetween the last message from current track, then status is POKEd into the time byte just before the message. This destroys the time byte. Do not save altered SMF file! Start of message is set to this new byte. This scheme allows fast playback in proc PLAY. 3040 REMark Copyright 30 Jan 2000, 31 May 2001 by A.Boehm 3050 REMark All may use provided no change, or new name given to changed version. 3060 DIM Tat(NumTracks),TrackStatus%(NumTracks),Note_On_Yet$(3),statusbytes(NumTracks) 3070 CLS#2:CSIZE#2,Lsize,Lsize 3080 PRINT#2, TO 2*LM;' Searching for MIDI events. Please wait.' 3090 MoreChart=1:REMark used to increment percent of events bar chart 3100 DoChart= 3 + MaxEvents/35 3110 : 3120 REMark Init time and locations 3130 time=0 3140 Set_E: REMark sets E(type) to number of bytes for each type control byte 3150 REMark mnemonic: small t for time variables, Large T for Track variables 3160 bpm=100:REMark default time units. See FuNction tunits. 3170 tupc=tunits(cpqn,bpm,T_dt):REMark default time units per clock (tic) 3180 MaxTime=1E400:REMark init value to find min and flag when all done 3190 FOR Track=1 TO NumTracks 3200 Tat(Track)=Tstart(Track) 3210 Bat=Tat(Track):time=0:bytes=Nbytes(Track) 3220 NextEvent:REMark <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 3230 Tat(Track)=Bat:times(Track)=time:Nbytes(Track)=bytes:REMark switch back scalers to array elements 3240 TrackStatus%(Track)=PEEK(Tstart(Track)):REMark INITIAL STATUS **************** 3250 END FOR Track 3260 event=1 3270 Note_On_Yet$='NO':REMark flag to signal first note on message 3280 Time_Offset=.1:REMark cumulative time to set up events. Initial .1 insures roundoff won't affect which frame is used. This is incremented in units of InitTime SET in boot. 3290 priortrack%=0:REMark allows check for running status. 0 here is initialization. 3300 REPeat events 3310 REMark find Track with next event 3320 Nexttime=MaxTime: REMark set high value to find min 3330 FOR T=1 TO NumTracks 3340 IF times(T)143 AND event_status<160 THEN 3420 Note_On_Yet$='YES':Time_Offset=Time_Offset+InitTime-Nexttime 3430 ELSE 3440 Nexttime=0:Time_Offset=Time_Offset+InitTime 3450 END IF 3460 END IF 3470 Event_Time(event)=Nexttime+Time_Offset 3480 Status=PEEK(EventStart):REMark check if running status i.e. use prior status 3490 IF Status < 128 THEN 3500 IF Track<>priortrack% OR RunStatus$='NO' THEN 3510 EventStart=EventStart-1 3520 POKE EventStart,TrackStatus%(Track):REMark put status in place of time code. 3530 Nbytes(Track)=Nbytes(Track)+1 3540 END IF 3550 ELSE 3560 TrackStatus%(Track)=Status 3570 END IF 3580 Event_At(event)=EventStart 3590 EventBytes(event)=Nbytes(Track) 3600 priortrack%=Track 3610 IF event>=MaxEvents THEN 3620 text$= ' Too many events for dimensioned arrays. Will play truncated song.':PrintText 3630 EXIT events 3640 END IF 3650 event=event + 1 3660 Tat(Track)=EventStart+Nbytes(Track) 3670 Bat=Tat(Track):time=times(Track):bytes=Nbytes(Track):REMark set arrays to scalers for Turbo 3680 NextEvent:REMark <<<<<<<<<<<<<<<<<<<<<< 3690 Tat(Track)=Bat:times(Track)=time:Nbytes(Track)=bytes:REMark switch back scalers to array elements 3700 MoreChart=MoreChart+1:REMark this and next line for printing "chart" (using BLOCK) of events found 3710 IF MoreChart>DoChart THEN MoreChart=1:BLOCK#2, event/MaxEvents*500,4,20,18,InkColor 3720 END REPeat events 3730 NumEvents=event -1 3740 IF NumEvents=0 THEN STOP 3750 END DEFine Find_Events 3760 REMark * * * * * * * * * * * * * * * * * * * * * * * 3770 : 3780 DEFine PROCedure NextEvent :REMark global:bat,time,bytes,SkipPrint,tupc,T_dt,LM,statusbytes,Track 3790 REMark using bytes starting at Bat, finds time in timer units to next event and number of bytes in event. Comment type events are printed (SkipPrint=1) or skipped. 3800 REMark Copyright 31 Jan 2000, 31 May 2001 by A.Boehm 3810 REMark All may use provided no change, or new name given to changed version. 3820 REPeat Event_or_Not 3830 REMark skip or only print comment type events (except tempo change) and get Nbytes of MIDI events 3840 text$='' 3850 Dclocks=VarPluck(dum):REMark delta time in clocks to next event 3860 time=time+Dclocks*tupc:REMark time is in units of T_functions 3870 BatStart=Bat 3880 con=PEEK(Bat):REMark get control byte 3890 IF con<128 THEN bytes=statusbytes(Track)-1:ELSE bytes=E(con):statusbytes(Track)=bytes 3900 REMark #bytes in event, neg means skip this event, 0 do something which also sets bytes 3910 IF bytes >0 THEN EXIT Event_or_Not 3920 Bat=Bat+1 3930 SELect ON con 3940 =240 3950 REPeat SysMsg 3960 m= PEEK(Bat):Bat=Bat+1 3970 IF m=247 THEN EXIT SysMsg 3980 END REPeat SysMsg 3990 bytes=Bat-BatStart:Bat=BatStart 4000 EXIT Event_or_Not 4010 =255 4020 REMark SMF Meta Event. In MIDI send code this would be a RESET 4030 Meta= PEEK(Bat):Bat=Bat+1 4040 DataBytes=VarPluck(dum):REMark bat 4050 DataStart=Bat 4060 SELect ON Meta 4070 ON Meta=0 4080 ON Meta=1 4090 text$=PEEK$(Bat,DataBytes) 4100 ON Meta=2 4110 text$='Copyright-' & PEEK$(Bat,DataBytes) 4120 ON Meta=3 4130 Track$=Track 4140 text$='TrackName '& Track$ &'=' & PEEK$(Bat,DataBytes) 4150 ON Meta=4 4160 text$='Instrument=' & PEEK$(Bat,DataBytes) 4170 ON Meta=5 4180 REMark Lyric$ not implemented in this version 4190 REMark Lyric$=pluck$(ch,DataBytes):PRINT 'Lyric=';Lyric$ 4200 REMark IF CODE(Lyric$(1))<32 THEN PRINT CODE(Lyric$(1)) 4210 ON Meta=6 4220 text$= ' Marker=' & PEEK$(Bat,DataBytes) & ' Not implemented!' 4230 ON Meta=7 4240 text$= ' CuePoint=' & PEEK$(Bat,DataBytes) & ' Not implemented!' 4250 ON Meta=33 4260 Port=PEEK(Bat):Bat=Bat+1:text$= 'Port=' & Port & ' Not implemented!' 4270 REMark ports not implemented 4280 ON Meta=47 4290 REMark end of track 4300 time=MaxTime 4310 EXIT Event_or_Not 4320 ON Meta=81 4330 IF DataBytes=3 THEN 4340 mSecPqn= (PEEK(Bat)*f256+PEEK(Bat+1))*f256+PEEK(Bat+2):Bat=Bat+3:REMark f256 is float =256 4350 bpm=6E7/mSecPqn:text$ = 'At' & FDEC$(time*T_dt,7,2) & ' seconds change to ' & bpm & ' Beats per minute.' 4360 REMark mSecPqn micro Seconds per quater note 4370 tupc = tunits(cpqn,bpm,T_dt):REMark T function time units per clock 4380 ELSE 4390 REMark this is a debug statement 4400 PRINT 'Tempo in ';DataBytes;' Bytes ?' 4410 END IF 4420 ON Meta=84 4430 REMark Shr=IN(ch):Smin=IN(ch):Ssec=IN(ch):Sframe=IN(ch):Ssubframe=IN(ch) 4440 REMark PRINT 'Start off set ';Shr,Smin,Ssec,Sframe,Ssubframe 4450 text$='Time in SMPTE not implemented.' 4460 ON Meta=88 4470 BeatsPerMea= PEEK(Bat):Bat=Bat+1 4480 BeatNote= 2^PEEK(Bat):Bat=Bat+1 4490 ClocksPerClick= PEEK(Bat):Bat=Bat+1 4500 N32notesPerMIDInote = PEEK(Bat):Bat=Bat+1 4510 text$='Meter ' & BeatsPerMea & '/' & BeatNote &' 32nd notes per MIDI beat=' & N32notesPerMIDInote & '. Clocks per beat ' & ClocksPerClick 4520 ON Meta=89 4530 Key=PEEK(Bat):Bat=Bat+1:IF Key>127 THEN Key=256-Key 4540 MajMin=PEEK(Bat):Bat=Bat+1 4550 SELect ON Key 4560 = -7 TO -2: text$=Key & ' flats' 4570 = -1: text$='1 flat' 4580 = 0: text$='No sharps/flats' 4590 = 1: text$ ='1 sharp' 4600 = 2 TO 7: text$=Key & ' sharps' 4610 END SELect 4620 text$= 'Key Signature=' & text$ & ' ' & key$(Key,MajMin) 4630 ON Meta=127 4640 text$=CDEC$(DataBytes,4,0) & ' bytes of Proprietary Data: ' & PEEK$(Bat,DataBytes) 4650 ON Meta=REMAINDER 4660 text$= 'On Track '&Track&', at byte '& BatStart-Tstart(Track) & 'Unused Meta Event='& Meta & ' ' & PEEK(BatStart):PrintText 4670 END SELect 4680 PrintText 4690 Bat=DataStart+DataBytes:REMark set bat to next event and repeat Event_or_Not 4700 =REMAINDER :PRINT 'On Track ';Track;' At '; BatStart-Tstart(Track);' Unknown message with code ';con:STOP 4710 END SELect 4720 END REPeat Event_or_Not 4730 END DEFine NextEvent 4740 REMark * * * * * * * * * * * * * * * * * * * * * * * 4750 : 4760 DEFine PROCedure Play :REMark M$,NumEvents,Event_Time,EventBytes,LM 4770 REMark sends MIDI bytes stored in ram at Event_At using Simon N. Goodwin's MIDI_BYTES 4780 REMark Copyright 16 Feb 2000 by A.Boehm 4790 REMark All may use provided no change, or new name given to changed version. 4800 DIM ESC$(1):ESC$=CHR$(27) 4810 Print_Start 4820 T_ON:T_START 4830 FOR event =1 TO NumEvents 4840 IF INKEY$(0)=ESC$ THEN PauseSong:IF choice$=CHR$(32) THEN EXIT event 4850 Nexttime=Event_Time(event) 4860 Bat=Event_At(event) 4870 bytes=EventBytes(event) 4880 IF Nexttime>T_COUNT THEN 4890 Nexttime1=Nexttime-1 4900 REPeat timer 4910 IF Nexttimetime$ THEN EXIT Tdt 5620 END REPeat Tdt 5630 time$=DATE$ 5640 T_START 5650 REPeat Tdt2 5660 IF DATE$<>time$ THEN EXIT Tdt2 5670 END REPeat Tdt2 5680 tcheck=T_COUNT 5690 one=1 5700 IF tcheck>55 THEN T_dt=one/60:ELSE T_dt=one/50 5710 T_STOP 5720 END DEFine GetSpeed 5730 REMark * * * * * * * * * * * * * * * * * * * * * * * 5740 : 5750 DEFine FuNction tunits(cpqn,bpm,T_dt) 5760 REMark time of a clock (tic) in timer function units. 5 Aug 1999 by A.Boehm 5770 REMark cpqn clocks per quarter note (or other note value if specified) 5780 REMark bpm beats per minute 5790 REMark T_dt timer unit, 1/50 or 1/60 seconds 5800 RETurn 1/(T_dt*cpqn*bpm/60) 5810 END DEFine tunits 5820 REMark * * * * * * * * * * * * * * * * * * * * * * * 5830 : 5840 DEFine PROCedure Set_E :REMark E 5850 REMark event length in bytes. Copyright 11 Aug 1999 by A.Boehm 5860 REMark All may use provided no change, or new name given to changed version. 5870 DIM E(255):REMark E=number of data bytes plus 1 for leading control byte 5880 FOR i=128 TO 191:E(i)=3 5890 FOR i=192 TO 223:E(i)=2 5900 FOR i=224 TO 239:E(i)=3 5910 REMark 240 start system message 5920 E(241)=1:REMark Midi timecode 5930 E(242)=3:REMark Song position 5940 E(243)=2:REMark Song No. 5950 FOR i=244 TO 254:E(i)=1:REMark 247 is end of system message, 255 is META event in SMF 5960 END DEFine Set_E 5970 REMark * * * * * * * * * * * * * * * * * * * * * * * 5980 : 5990 DEFine PROCedure Twink 6000 REMark plays 1st 7 notes of Twinkle, Twinkle, Little Start 6010 REMark 20 Aug 1999 by A.Boehm 6020 REMark All may use provided no change, or new name given to changed version. 6030 Nnotes=7 6040 DIM notes%(Nnotes) 6050 RESTORE 6060:FOR i=1 TO Nnotes:READ notes%(i):END FOR i 6060 DATA 70,70,77,77,79,79,77 6070 : 6080 speed=25 6090 duration=.9*speed 6100 between=.1*speed 6110 REPeat twinkle 6120 CLS 6130 AT 4,0:PRINT ' Now playing 1st 7 notes of Twinkle, Twinkle, Little Star' 6140 PRINT ' for testing DIY_MIDI. ' 6150 PRINT 6160 PRINT ' TIMING_CODE must have been LRESPRed beforehand. ' 6170 PRINT ' A synth or MIDI keyboard must be connected via /dev/midi00.' 6180 PRINT 6190 : 6200 FOR i=1 TO Nnotes 6210 MIDI_NOTE notes%(i) 6220 PAUSE duration 6230 MIDI_MUTE notes%(i) 6240 PAUSE between 6250 NEXT i 6260 CLS:PRINT\\ ' Twinkle test complete. Repeat test? (Y/N)' 6270 choice$=INKEY$(-1) 6280 IF choice$ INSTR 'N' THEN EXIT twinkle 6290 END REPeat twinkle 6300 END DEFine Twink 6310 REMark * * * * * * * * * * * * * * * * * * * * * * * 6320 : 6330 DEFine FuNction key$(Key,MajMin) 6340 REMark returns musical key given key=number of sharps(-for flats) and MajMin=0 for major,1 for minor 6350 REMark Copyright 21 Aug 1999 by A.Boehm 6360 REMark All may use provided no change, or new name given to changed version. 6370 IF ABS(Key)>7 THEN PRINT 'key ';Key;' out of range':RETurn 'No. sharps/flats '&Key&' is too many.' 6380 IF Key=0 THEN 6390 IF MajMin =0 THEN RETurn 'C major' :ELSE RETurn 'A minor' 6400 ELSE 6410 index1=ABS(Key)*2 6420 index=index1-1:REMark index picks two character strings out of sharp or flats 6430 IF Key>0 THEN 6440 IF MajMin=0 THEN RETurn 'G D A E B F#C#'(index TO index1) & ' major':ELSE RETurn 'E B F#C#G#D#A#'(index TO index1) & ' minor' 6450 ELSE 6460 IF MajMin=0 THEN RETurn 'F BbEbAbDbGbCb'(index TO index1) & ' major':ELSE RETurn 'D G C F BbEbAb'(index TO index1) & ' minor' 6470 END IF 6480 END IF 6490 END DEFine key$ 6500 REMark * * * * * * * * * * * * * * 6510 : 6520 DEFine PROCedure Get_File: REMark (ext$,devdir$) :REMark returns channel ch 6530 REMark Copyright 6 Dec 1999 by A.Boehm 6540 REMark All may use provided no change, or new name given to changed version. 6550 REPeat file_in 6560 Pick_File :REMark ext$,devdir$. Returns FileName$, selects from those with extension ext$ in directory devdir$ 6570 CLS:Title 6580 IF choice=ESC THEN ch=-1:RETurn 6590 ch=FOP_IN(FileName$) 6600 IF ch>0 THEN 6610 EXIT file_in 6620 ELSE 6630 PRINT:PRINT TO LM;'Error ';FileName$;' not found. Try again.' 6640 PRINT:PRINT TO LM;'Press any key to continue.' 6650 END IF 6660 END REPeat file_in 6670 REMark returns ch 6680 END DEFine Get_File 6690 REMark * * * * * * * * * * * * * * 6700 : 6710 DEFine PROCedure Pick_File :REMark ext$,devdir$,Lsize,LM,PaperColor,Inkcolor,StripColor,StripInk 6720 REMark list files in current directory with 3 out of the last 4 characters=ext$ and allows selection. Returns FileName$ 6730 REMark Copyright 22 Jan 2000 by A.Boehm 6740 REMark All may use provided no change, or new name given to changed version. 6750 DIM MidFile$(100,40),Last4$(4),f$(64),Newdevdir$(40) 6760 Enter=10:UpArrow=208:DownArrow=216:REMark these are key input. Not for printout! 6770 FileName$='':ESC=27:REMark code for key press ESC 6780 REPeat New_Directory_List 6790 REPeat file_Dir 6800 fch=FOP_DIR (devdir$) 6810 IF fch>0 THEN EXIT file_Dir 6820 PRINT TO LM;devdir$;' ? Input new device/directory'\ TO LM;'or use ENTER alone to escape back to menu. ';:CURDIS#0:INPUT Newdevdir$:CURSEN#0 6830 IF Newdevdir$='' THEN choice=ESC:RETurn :ELSE devdir$=Newdevdir$ 6840 END REPeat file_Dir 6850 CLOSE #fch 6860 REMark System-friendly directory reader 6870 REMark Recoded by SNG to use WDIR, CONNECT and PIPE 6880 OPEN #15,"pipe_8000" :REMark enough for 200+ filenames 6890 WDIR #15,devdir$ 6900 CONNECT #15 TO #14 : CLOSE #15 6910 NumMidFiles=0 6920 REPeat getdir 6930 IF EOF(#14) THEN EXIT getdir 6940 INPUT #14;f$ 6950 a=LEN(f$) 6960 IF a>3 THEN 6970 Last4$=f$(a-3 TO a):REMark check for ext$ in the last 4 letters e.g. .MID or _mid or midi 6980 IF ext$ INSTR Last4$ THEN 6990 NumMidFiles=NumMidFiles + 1 7000 MidFile$(NumMidFiles)=f$ 7010 END IF 7020 END IF 7030 END REPeat getdir 7040 CLOSE#14 7050 : 7060 CLS#2:PRINT#2,TO 2*LM; 'Use ';CHR$(190);' ';CHR$(191);' to change choice. ESC = back to memu';\TO 2*LM;'ENTER selects file or activates type in.' 7070 TopItem=-1 7080 IF NumMidFiles>0 THEN Hotitem=1 :ELSE Hotitem=-1 7090 IF Lsize=0 THEN Max=17:ELSE Max=8 7100 MaxItems=MIN(Max,NumMidFiles+2) 7110 STRIP PaperColor:INK InkColor 7120 Newdevdir=0:REMark switch =1 when new dev/dir entered 7130 REPeat List_from_a_Directory 7140 CLS 7150 FOR i=1 TO MaxItems:ListItem TopItem+i-1 7160 IF NumMidFiles=0 THEN PRINT:PRINT TO LM;' In this directory, no files found with extension ';ext$;'.' 7170 BottomItem=TopItem+MaxItems-1 7180 IF BottomItem BottomItem THEN EXIT Get_Choice 7540 AT Hotitem-TopItem,0:ListItem Hotitem 7550 AT OldHot-TopItem,0:ListItem OldHot 7560 END REPeat Get_Choice 7570 IF FileName$<>'' THEN RETurn 7580 IF Newdevdir THEN EXIT List_from_a_Directory 7590 IF Hotitem>BottomItem THEN TopItem=TopItem+1 7600 IF Hotitem0 THEN PRINT ' ';MidFile$(item);' ' 7730 STRIP PaperColor:INK InkColor 7740 END DEFine ListItem 7750 REMark * * * * * * * * * * * * * * 7760 DEFine FuNction MIN(a,b) 7770 IF aGmMax THEN PRINT ' out of range. Not used.':RETurn 8290 PRINT gm;' TO ';:sy=M$(sy TO):PRINT sy; 8300 IF sy < ToMin OR sy >ToMax THEN PRINT ' out of range. Not used.':RETurn 8310 SELect ON ident 8320 =1:PatchMap(gm)=sy 8330 =2:DrumMap(gm)=sy 8340 =3:NewCh(gm)=sy 8350 END SELect 8360 END IF 8370 END DEFine DeCode 8380 REMark * * * * * * * * * * * * * * 8390 : 8400 DEFine PROCedure Patch_Change :REMark MapName$,PatchMap,DrumMap,NewCh,ChannelChange$ 8410 REMark change patches to new map numbers for non GM synths 8420 REMark changes notes assigned to drums 8430 REMark if required, changes assigned channel numbers. 8440 REMark Copyright 14 Sep 1999 by A. Boehm 8450 REMark All may use provided no change, or new name given to changed version. 8460 CLS#2:PRINT#2, TO LM;'Changing Patches, drums, and/or channels.'\TO LM;' Please wait.' 8470 FOR event =1 TO NumEvents 8480 Status_At=Event_At(event) 8490 Status=PEEK(Status_At) 8500 REMark Status 192 to 207 is change patch 8510 SELect ON Status 8520 =192 TO 207 8530 REMark Change Patch according to PatchMap 8540 Patch_At=Status_At+1: Patch=PEEK(Patch_At) 8550 NewPatch=PatchMap(Patch) 8560 IF PatchMap(Patch)<>Patch THEN POKE Patch_At,NewPatch 8570 =137,153 8580 REMark Change note used for Drum. Status 137 is ch 10 note off, 153 note on ch 10 8590 Note_At=Status_At+1:Note=PEEK(Note_At) 8600 NewDrumNote=DrumMap(Note) 8610 POKE Note_At,NewDrumNote 8620 END SELect 8630 IF ChangeChannel$='YES' AND Status <240 AND Status >127 THEN 8640 REMark change assigned channels to NewCh 8650 TypeCoded=INT(Status/16)*16:REMark status type with ch stripped off. 8660 MidiCh=INT(Status-typcoded)+1 8670 POKE Status_At, TypeCoded+NewCh(MidiCh)-1 8680 END IF 8690 END FOR event 8700 Title 8710 END DEFine Patch_Change 8720 REMark * * * * * * * * * * * * * * 8730 : 8740 DEFine PROCedure SynthReset 8750 REMark send a reset to your synth. Reset$ is SET in MIDIPlayer_boot 8760 REMark All may use provided no change, or new name given to changed version. 8770 MIDI_PLAY SynthReset$:REMark No pause needed since other lines are run before another MIDI call. 8780 END DEFine SynthReset 8790 : 8800 DEFine PROCedure PrintText 8810 REMark print text$ to SkipPrint (usually window 1) and optionally to MMsg which is a file (default is Ram1_MIDImessage_txt) 8820 REMark 17 Feb 2000 by A.Boehm 8830 IF SkipPrint>0 AND LEN(text$)>0 THEN 8840 PRINT#SkipPrint,TO LM;text$:REMark ordinarily this is to screen 8850 IF MMsg>0 THEN PRINT#MMsg,text$:REMark this is to file 8860 END IF 8870 END DEFine PrintText 8900 : 8910 REMark SuperBASIC versions of DIY MIDI commands - these 8920 REMark require #9 to be connected to a MIDI device. Do 8930 REMark not load DIY MIDI extensions or these will be 8940 REMark over-ridden. Simon Goodwin. 8940 : 9000 DEFine PROCedure MIDI_NOTE(a) 9010 PRINT #9;CHR$(144);CHR$(a);CHR$(64); 9020 END DEFine MIDI_NOTE 9025 : 9030 DEFine PROCedure MIDI_MUTE(a) 9040 PRINT #9;CHR$(144);CHR$(a);CHR$(0); 9050 END DEFine MIDI_MUTE 9060 : 9070 DEFine PROCedure MIDI_PLAY(t$) 9080 PRINT #9,t$; 9090 END DEFine MIDI_PLAY 9100 : 9110 DEFine PROCedure MIDI_BYTES(p,l) 9120 PRINT #9,PEEK$(p,l); 9130 END DEFine MIDI_BYTES