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 ==========================================================================================