rem MidiMod ........... Rev 7.1 rem Basic functionality version rem A J Tooth // June 2004 rem Modified to cater for Format 0 files 24th June 2004 rem Modified for better file selection June 2006 himem=lomem + 1000000 *FLOAT 64 mode 22 : colour 132,0,0,50 : colour 132 : colour 3 : cls : off rem Load Instruments proc_loadinst rem Choose the MIDI File required proc_midichoose(Name$, FulName$, pre$) rem Read in the .mid file and check the File Header proc_readcheck rem Make revisions to speed and instrument ensemble proc_revise rem PLAY the revise file colour 2:print:print " Tune now PLAYING ..... " *PLAY rev a$=get$ : quit end rem End of Program +++++++++++++++++++++++++++++++ rem ========================================================================================== rem Choose a MIDI file def proc_midichoose(return Name$, return FulName$, return Pre$) local g%,rn%,n$,Flg&,pic$,fullname$,command$,m& dim pq% 75, ff% 30, fm% 255 !pq%=76 pq%!4=@hwnd% pq%!12=ff% pq%!28=fm% pq%!32=256 pq%!52=6 $ff% ="MIDI Data"+chr$0+"*.mid"+chr$0+chr$0 sys "GetOpenFileName", pq% to result% if result%<>0 then fullname$ = $$fm% rn%=len(fullname$) g%=0 : pic$="" repeat n$=mid$(fullname$,rn%-g%,1) if n$<>"\" then pic$=n$+pic$ : g%+=1 until n$="\" Pre$=left$(fullname$,rn%-g%) rem Change the current Directory command$="CD "+chr$(34)+Pre$+chr$(34) oscli command$ Name$=pic$ : FulName$=Pre$+Name$ endproc rem ========================================================================================== rem Read in the .mid file and check the File Header def proc_readcheck local f%,x%,t% rem read in the .mid file to a file in memory f%=openin FulName$ lgth%=ext#f% dim pf% lgth% for x%=0 to lgth% ?(pf% + x%)=bget#f% next x% close#f% : rem File Closed Here rem Standard Header Data Head$="" for a&=0 to 3 Head$+=chr$(?(pf% + a&)) next a& Hlen&=?(pf% + 7) Form&=?(pf% + 9) Trks&=?(pf% +11) Pulses%=256*?(pf% + 12) + ?(pf% + 13) dim Tlen%(Trks&), Tloc%(Trks&+1), Instloc%(Trks&), Inst%(Trks&) rem Subsequent Track Lengths and Locations Tloc%(1)=8+Hlen& for b&=1 to Trks& Tlen%(b&)=65536*?(pf% + Tloc%(b&) + 5) + 256*?(pf% + Tloc%(b&) + 6) + ?(pf% + Tloc%(b&) + 7) Tloc%(b&+1)=8 + Tloc%(b&) + Tlen%(b&) next b& print:print colour 3:print " Header is: "; colour 1:print Head$; if Head$="MThd" then colour 0:print " as required." else colour 129:print "which us WRONG!" colour 3:print " Header length is: "; colour 1:print;Hlen&; if Hlen&=6 then colour 0:print " as normal." colour 3:print " Number of tracks is: "; colour 1:print;Trks& colour 3:print " Pulses per quarter note are presently: "; colour 1:print;Pulses% if Form&>0 then for j&=2 to Trks& proc_inst(j&) next j& else proc_inst(1) endif endproc rem ========================================================================================== rem Create revised .mid file def proc_create local h%,y% picr$="rev.mid" filr$=pre$+picr$ rem Save revised .mid file onto disc h%=openout filr$ print:print "Saving file. Please wait a few moments. " for y%=0 to lgth% bput#h%,?(pf% + y%) next y% close#h% : rem File Closed Here endproc rem ========================================================================================== rem Load Instruments def proc_loadinst local a% dim Inst$(120) restore for a%=1 to 120 read Inst$(a%) next a% endproc rem ========================================================================================== rem General MIDI Instrument List data "Acoustic Piano","Bright Acoustic Piano","Electric Grand Piano","Honky Tonk Piano" data "Electric Piano 1","Electric Piano 2","Harpsichord","Clavichord" data "Celesta","Glockenspiel","Music Box","Vibraphone" data "Marimba","Xylophone","Tubular Bells","Dulcimer" data "Drawbar Organ","Percussion Organ","Rock Organ","Church Organ" data "Reed Organ","Accordian","Harmonica","Tango Accordian" data "Nylon String Acoustic Guitar","Steel String Acoustic Guitar","Electric Jazz Guitar","Electric Guitar" data "Muted Electric Guitar","Overdriven Guitar","Distortion Guitar","Guitar Harmonics" data "Acoustic Bass","Electric Bass Guitar","Electric Bass Pick","Fretless Bass" data "Slap Bass 1","Slap Bass 2","Synth Bass 1","Synth Bass 2" data "Violin","Viola","Cello","Contra Bass" data "Tremelo Strings","Pizzicato Strings","Orchestral Strings","Timpani" data "String Ensemble 1","String Ensemble 2","Synth Strings 1","Synth strings 2" data "Choir Aaahs","Choir Ooohs","Synth Voice","Orchestra Hit" data "Trumpet","Trombone","Tuba","Muted Trumpet" data "French Horn","Brass Section","Synth Brass 1","Synth Brass 2" data "Soprano Sax","Alto Sax","Tenor Sax","Baritone Sax" data "Oboe","English Horn","Bassoon","Clarinet" data "Piccolo","Flute","Recorder","Pan Flute" data "Blown Bottle","Shakahuchi","Whistle","Ocarina" data "Lead 1 Square","Lead 2 Sawtooth","Lead 3 Calliope","Lead 4 Chiff" data "Lead 5 Charang","Lead 6 Voice","Lead 7 Fifths","Lead 8 Bass" data "Pad:New Age","Pad:Warm","Pad:Polysynth","Pad:Choir" data "Pad:Bowed","Pad:Metallic","Pad:Halo","Pad:Sweep" data "FX:Rain","FX:Soundtrack","FX:Crystal","FX:Atmosphere" data "FX:Brightness","FX:Goblins","FX:Echoes","FX:Sci-Fi" data "Sitar","Banjo","Shamisen","Koto" data "Kalimba","Bagpipe","Fiddle","Shanai" data "TinkerBell","Agogo","SteelDrums","Woodblock" data "TaikoDrum","MelodicDrum","SynthDrum","Reverse Cymbal" rem ========================================================================================== rem Select Instrument from List def proc_selinst(Tr&) local Stp&,Row&,k&,p&,Lim&,Swp& rem Prints entire Instrument list Stp&=0 : Row&=4 : Sel&=0 if Tr&<=Trks& then Lim&=Tr% else Lim&=Trks& for k&=1 to 120 if Form&>0 then for p&=2 to Lim& if Inst%(p&)=k& then Sel&=1 next p& else if Inst%(1)=k& then Sel&=1 endif case Sel& of when 0: rem Unselected Instruments are printed in CYAN colour 1:print tab(Stp&,Row&);k&;" " colour 6:print tab(Stp&+4,Row&);Inst$(k&) when 1: rem Selected Instruments are printed in GREEN colour 1:print tab(Stp&,Row&);k&;" " colour 2:print tab(Stp&+4,Row&);Inst$(k&) endcase Stp&+=35 : if Stp&=140 then Stp&=0 : Row&+=1 Sel&=0 next k& rem Mouse debounce repeat mouse x%,y%,z& until z&=0 if Tr&<=Trks& then rem Enables selection of each instrument from the list mouse rectangle 0,448,2048,959 StprO%=-1 : StpO%=-1 : RowO%=-1 Swp&=1 repeat mouse x%,y%,z& Stpr&=(x% div 512) : Stp&=35*Stpr& Row&=3+30-((y%-448) div 32) k&=4*(Row&-4) + Stpr& Sel&=0 if (StprO%>-1 and RowO%>-1) then if (StprO%<>Stpr& or RowO%<>Row&) then Swp&=1 if Form&>0 then for p&=2 to Tr& if Inst%(p&)=(kO%+1) then Sel&=1 next p& else if Inst%(1)=(kO%+1) then Sel&=1 endif case Sel& of when 0: rem Unselected revert to CYAN colour 1:print tab(StpO%,RowO%);(kO%+1);" " colour 6:print tab(StpO%+4,RowO%);Inst$(kO%+1) when 1: rem Selected revert to GREEN colour 1:print tab(StpO%,RowO%);(kO%+1);" " colour 2:print tab(StpO%+4,RowO%);Inst$(kO%+1) endcase endif endif Sel&=0 if Swp&=1 then rem Instrument where the mouse is, is coloured MAGENTA colour 3:print tab(Stp&,Row&);(k&+1);" " colour 5:print tab(Stp&+4,Row&);Inst$(k&+1) Swp&=0 endif StprO%=Stpr& : StpO%=Stp& : RowO%=Row& : kO%=k& until z&=4 rem BEEP when a selection is confirmed sys "MessageBeep",0 rem Determines Instrument Ref Inst%(Tr&)=kO%+1 mouse rectangle off endif endproc rem ========================================================================================== rem Make revisions to speed and instrument ensemble def proc_revise colour 3:print tab(5,15);"Enter revised number of pulses: "; colour 1: input;puls% Lsb%=puls% mod 256 ?(pf% + 13)=Lsb% Msb%=(puls%-Lsb%) div 256 ?(pf% + 12)=Msb% cls:colour 3:print tab(1,1);"Enter different Instrument reference (Click on the list)" if Form&>0 then for f&=2 to Trks& if Instloc%(f&)>0 then colour 3:input tab(1,35);"Enter new Instrument ref. for Track: "; colour 1:print;f&;" "; proc_selinst(f&) ?(pf% + Instloc%(f&))=Inst%(f&)-1 endif next f& else if Instloc%(1)>0 then colour 3:input tab(1,35);"Enter new Instrument ref. for Track: "; colour 1:print;1;" "; proc_selinst(1) ?(pf% + Instloc%(1))=Inst%(1)-1 endif endif proc_selinst(Trks&+1) rem Create a modified file proc_create rem Play the Modified File a$=inkey$(100):cls colour 3:print:print " You have chosen the following Instrument Set...." print:print if Form&>0 then for t&=2 to Trks& if Instloc%(t&)>0 then print " Track "; colour 1:print;t&;" "; colour 3:print Inst$(Inst%(t&)) endif next t& else if Instloc%(1)>0 then print " Track "; colour 1:print;1;" "; colour 3:print Inst$(Inst%(1)) endif endif endproc rem ========================================================================================== rem Check for a mouse click def proc_mclick(return b&) : local x,y repeat mouse x,y,b& sys "Sleep",10 until b&=0 repeat mouse x,y,b& sys "Sleep",10 until b&<>0 endproc rem ========================================================================================= rem Identifies Instrument selector byte, and enables alteration def proc_inst(Tr%) Ctrl$="a" : a$="" if Ctrl$="a" then rem Do Nothing else colour 0:print:print " Press -x- to move to the NEXT TRACK, or spacebar to CONTINUE, or -s- to SKIP the rest." a$=get$:print endif PtrSt%=8 + Tloc%(Tr%) Ptr%=PtrSt% Flg%=1 : Fnd%=0 repeat if Ctrl$<>"a" then if ((Ptr%-PtrSt%)mod 25)=0 then cls colour 0:print;Ptr%;": "; endif case Flg% of when 1: Delt%=?(pf% + Ptr%) if Ctrl$<>"a" then colour 1:print;?(pf% + Ptr%); colour 2:print " Delta time " endif if Delt%>=128 then Flg%=-Flg% : rem Causes Flg% NOT to switch if further byte expected when -1: PtrEnt%=Ptr% rem Handles all Meta, Midi and SysEx Event Codes rem and moves the file pointer on appropriately. if ?(pf% + PtrEnt%)=&FF then if Ctrl$<>"a" then colour 1:print;?(pf% + Ptr%); colour 2:print " Meta Event " endif Ptr%+=1 if Ctrl$<>"a" then colour 0:print;Ptr%;": "; colour 1:print;?(pf% + Ptr%); colour 2:print " Meta Event Code" endif Ptr%+=1 if Ctrl$<>"a" then colour 0:print;Ptr%;": "; colour 1:print;?(pf% + Ptr%); endif Mebl%=?(pf% + Ptr%) if Ctrl$<>"a" then colour 2:print " Meta Event Byte Length (will skip these bytes)" endif Ptr%=Ptr% + Mebl% endif if (?(pf% + PtrEnt%)=&F0 or ?(pf% + PtrEnt%)=&F7) then if Ctrl$<>"a" then colour 1:print;?(pf% + Ptr%); colour 2:print " SysEx Event " endif Ptr%+=1 if Ctrl$<>"a" then colour 0:print;Ptr%;": "; colour 1:print;?(pf% + Ptr%); endif Sebl%=?(pf% + Ptr%) if Ctrl$<>"a" then colour 2:print " SysEx Event Byte Length (will skip these bytes)" endif Ptr%=Ptr% + Sebl% endif if ?(pf% + PtrEnt%)>=128 and ?(pf% + PtrEnt%)<=143 then if Ctrl$<>"a" then colour 1:print;?(pf% + Ptr%); colour 2:print " Midi Event: Note OFF" endif Ptr%+=2 endif if ?(pf% + PtrEnt%)>=144 and ?(pf% + PtrEnt%)<=159 then if Ctrl$<>"a" then colour 1:print;?(pf% + Ptr%); colour 2:print " Midi Event: Note ON" endif Ptr%+=2 endif if ?(pf% + PtrEnt%)>=160 and ?(pf% + PtrEnt%)<=175 then if Ctrl$<>"a" then colour 1:print;?(pf% + Ptr%); colour 2:print " Midi Event: Key Pressure" endif Ptr%+=2 endif if ?(pf% + PtrEnt%)>=176 and ?(pf% + PtrEnt%)<=191 then if Ctrl$<>"a" then colour 1:print;?(pf% + Ptr%); colour 2:print " Midi Event: Controller Change" endif Ptr%+=2 endif if ?(pf% + PtrEnt%)>=192 and ?(pf% + PtrEnt%)<=207 then if Ctrl$<>"a" then colour 1:print;?(pf% + Ptr%); colour 5:print " Midi Event: INSTRUMENT Change" endif Ptr%+=1 if Ctrl$<>"a" then colour 0:print;Ptr%;": "; colour 1:print;?(pf% + Ptr%); colour 2:print;" current Instrument Code. Instrument =: "; colour 1:print;Inst$(?(pf% + Ptr%)+1) endif Fnd%=1 Instloc%(Tr%)=Ptr% endif if ?(pf% + PtrEnt%)>=208 and ?(pf% + PtrEnt%)<=223 then if Ctrl$<>"a" then colour 1:print;?(pf% + Ptr%); colour 2:print " Midi Event: Aftertouch" endif Ptr%+=1 endif if ?(pf% + PtrEnt%)>=224 and ?(pf% + PtrEnt%)<=239 then if Ctrl$<>"a" then colour 1:print;?(pf% + Ptr%); colour 2:print " Midi Event: Pitch Bend" endif Ptr%+=1 endif if ?(pf% + PtrEnt%)<128 then if Ctrl$<>"a" then colour 1:print;?(pf% + Ptr%); colour 2:print " RUNNING STATUS" endif Ptr%+=1 endif endcase if Ctrl$<>"a" then a$=get$ Flg%=-Flg% : rem Indicates switch between Delta Time and Event Code modes Ptr%+=1 until ((a$="x" or a$="s") or (Ptr%>lgth%)) or (Fnd%=1) or (Ptr%>=(Tloc%(Tr%)+Tlen%(Tr%))) endproc rem ==========================================================================================