rem Guitar Simulator B ......... Rev 7.2
      rem A J Tooth // January 2005
      rem Revised April 2005 to include the "pointing finger" mouse pointer
      
      on close proc_close
      
      rem Set screen format
      proc_setup
      
      rem Section A
      rem =============
      repeat
        proc_boxes(0)
        if (ChorNt&=0 or ChorNt&=3) then proc_chornot
        case ChorNt& of
          when 1:
            proc_celect : rem Select a WHOLE Chord
            proc_select : rem Permits altering the base chord
          when 2: proc_select : rem Select separate notes for single chord
          when 3: rem Do Nothing
          when 4: rem Do Nothing
        endcase
        mouse x%,y%,b&
        if Ind%>0 then
          rem Mouse pointer control
          if (x%>=400 and x%<=550 and y%>=400 and y%<=550) or mc&=1 then mc&=1 else mc&=0
          if (x%>=1200 and x%<=1350 and y%>=400 and y%<=550) or mc&=1 then mc&=1 else mc&=0
          if (x%>=800 and x%<=950 and y%>=400 and y%<=550) or mc&=1 then mc&=1 else mc&=0
          if (x%>=1600 and x%<=1750 and y%>=400 and y%<=550 and Svd%=1) or mc&=1 then mc&=1 else mc&=0
          if mc&=1 then mouse on 137 else mouse on 0
          rem PLAY button pressed
          if (x%>=400 and x%<=550 and y%>=400 and y%<=550 and b&=4) then
            proc_boxes(1)
            proc_speed : rem Set the play speed
            sys "midiOutOpen",^hMidiOut%, -1, 0, 0, 0 to ret%
            if ret% error 100,"Failed to open MIDI output device"
            proc_ChangeInst(CInst%)
            proc_NewChord(0,0)
            sys "midiOutClose",hMidiOut%
          endif
          rem SAVE button pressed
          if (x%>=1200 and x%<=1350 and y%>=400 and y%<=550 and b&=4) then
            if Sav%=0 then
              proc_boxes(3)
              Ch%+=1
              if Ch%>10 then
                print tab(10,5);"Maximum number of chords saved."
                sys "MessageBeep",48
              else
                proc_temp
                for  i&=1 to 6
                  chord%(Ch%,i&)=temp%(i&)
                next  i&
              endif
              Ind%=0 : oc%()=0
              chnt%()=0
              proc_fretboard
            endif
            Sav%=1 : Svd%=1 : ChorNt&=3
          endif
        endif
        
        a$=inkey$ (1)
        rem Mouse pointer control
        if ChorNt& =4 then
          if (x%>=800 and x%<=950 and y%>=400 and y%<=550) then mc&=1 else mc&=0
        else
          if (x%>=800 and x%<=950 and y%>=400 and y%<=550) or mc&=1 then mc&=1 else mc&=0
        endif
        if (x%>=1600 and x%<=1750 and y%>=400 and y%<=550 and Svd%=1) or mc&=1 then mc&=1 else mc&=0
        if mc&=1 then mouse on 137 else mouse on 0
        
        rem QUIT button pressed
        if  (x%>=800 and  x%<=950 and  y%>=400 and  y%<=550 and  b&=4) then
          proc_boxes(2)
          a$="x"
        endif
        if Svd%=1 then
          rem CONT_inue button pressed
          if  (x%>=1600 and  x%<=1750 and  y%>=400 and  y%<=550 and  b&=4) then
            proc_boxes(4)
            a$="c"
          endif
        endif
      until  (a$="x" or  a$="c")
      if  (a$="x") then  b$=inkey$ (30) : quit
      mc&=0 : mouse on 0
      
      rem Section B
      rem =============
      cls :clg
      lun%=1000
      repeat
        if  Pl%=1 then
          rem Print the instrument name
          proc_printInst
        endif
        mouse x%,y%,b&
        rem Mouse pointer control
        if (x%>=400 and x%<=550 and y%>=400 and y%<=550) then mc&=1 else mc&=0
        if (x%>=1600 and x%<=1750 and y%>=400 and y%<=550) or mc&=1 then mc&=1 else mc&=0
        if (x%>=800 and x%<=950 and y%>=400 and y%<=550) or mc&=1 then mc&=1 else mc&=0
        if (x%>=1200 and x%<=1350 and y%>=400 and y%<=550) or mc&=1 then mc&=1 else mc&=0
        if mc&=1 then mouse on 137 else mouse on 0
        
        if a$<>"c" then
          if (x%>=1600 and x%<=1750 and y%>=400 and y%<=550 and b&=4) then
            proc_boxes(6)
            *REFRESH ON
            i$=inkey$ (50)
            proc_newInst
            *REFRESH OFF
            colour  128:cls
            rem Print the instrument name
            proc_printInst
          endif
        else
          b$=inkey$(50) : a$=""
        endif
        if (x%>=400 and x%<=550 and y%>=400 and y%<=550 and b&=4) then
          proc_boxes(1)
          mc&=0 : mouse on 0
          proc_upoct : rem Raise all notes up an octave
          mc&=0 : mouse on 0
          proc_speed
          sys "midiOutOpen",^hMidiOut%, -1, 0, 0, 0 to ret%
          if ret% error 100, "Failed to open MIDI output device"
          proc_ChangeInst(CInst%)
          for s%=1 to Ch%
            proc_NewChord(1,s%)
          next s%
          sys "midiOutClose",hMidiOut%
          Pl%=1
        endif
        
        a$=inkey$(1)
        if (x%>=800 and x%<=950 and y%>=400 and y%<=550 and b&=4) then
          proc_boxes(2)
          a$="x"
        endif
        if  (x%>=1200 and x%<=1350 and y%>=400 and y%<=550 and b&=4) then
          proc_boxes(5)
          a$="r"
        endif
      until (a$="x" or a$="r")
      
      b$=inkey$(30)
      if  a$="r" then run
      quit
      end
      rem End of Program +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      rem ========================================================================
      
      rem Ensures MIDI channel closed on closing main window by user
      def proc_close
      sys "midiOutClose",hMidiOut%
      quit
      endproc
      rem ========================================================================
      
      rem Set screen format
      def proc_setup
      local a&, f&, h&
      
      mode 22 : off
      *REFRESH OFF
      
      rem Set up customised colour scheme
      colour 6,170,125,40  : colour 134,170,125,40
      colour 5,185,175,150 : colour 8,205,185,145 : colour 137,200,200,200
      colour 9,200,200,200
      colour 10,0,150,0
      
      dim st$(5),st%(5),fretpos%(12),nts$(11)
      dim chnt%(6,2),oc%(5),chord%(10,6),temp%(6)
      dim Inst$(120)
      dim Chrd$(13), Chrdata%(13,14), Mg$(20)
      
      restore
      for a&=0 to 119
        read Inst$(a&)
      next a&
      st$()="E","A","D","G","B","E" : rem Names of guitar strings
      st%()=7,0,5,10,2,7
      nts$()="A","A#/Bb","B","C","C#/Db","D","D#/Eb","E","F","F#/Gb","G","G#/Ab"
      
      for f&=1 to 13
        read Chrd$(f&)
        for h&=1 to 14
          read Chrdata%(f&,h&)
        next h&
      next f&
      
      rem Initial screen setup
      proc_fretboard
      proc_boxes(0)
      
      oldfret%=0 : oldstr%=0 : rem Last fret and string position selected. Initially zero.
      Ind%=0  : rem Indicates how many notes selected so far. Maximum 6 (one per string...)
      nmn%=0  : rem Set to 1 if no more notes allowed
      mvd%=0  : rem Set to 1 if the mouse has moved to a different fret/string combination
      Once%=0 : rem Indicates whether note selected on current string yet
      Tnce%=0 : rem Indicates that an existing note is to be de-selected
      Out%=0
      cnc%=0
      Ch%=0   : rem Number of chords entered so far
      Sav%=1  : rem Set to 0 if SAVE allowed
      Svd%=0  : rem Number of chords actually saved so far
      Pl%=1
      CInst%=25 : rem Current instrument. Default set to "Steel string acoustic guitar"
      Up%=0
      ChorNt&=0 : rem Indicate whether Chord(1) or Note(2) level is selected. Initially ZERO.
      lun%=2000
      mc&=0
      endproc
      rem ========================================================================
      
      rem Draw a BLANK fretboard
      def  proc_fretboard
      local  f&,s&,dd%,tt%,ss%
      
      gcol 6 : rectangle  fill 100,800,1800,300
      gcol 7 : rectangle  fill 80,800,20,300
      gcol 5 : tt%=100
      fretpos%(0)=tt%
      for f&=0 to 11
        dd%=200-10*f&
        tt%+=dd%
        rectangle fill tt%,800,10,300
        fretpos%(f&+1)=tt%
      next f&
      gcol 8 : ss%=25 : vdu 5
      for s&=0 to 5
        move 40,815+ss% : print st$(s&)
        rectangle fill 80,800+ss%,1820,5
        ss%+=50
      next  s&
      *REFRESH
      vdu 4
      endproc
      rem ========================================================================
      
      rem Print existing chosen notes to the fretboard
      def proc_exist
      local st%,fr%,i%
      
      vdu 5
      for i%=1 to Ind%
        st%=chnt%(i%,1) : fr%=chnt%(i%,2)
        gcol 0 : circle fill fretpos%(fr%)-40,825+st%*50,20
        gcol 4: print;i%;
        gcol 1: rectangle fill fretpos%(fr%),825+st%*50,1900-fretpos%(fr%),5
      next i%
      vdu 4
      *REFRESH
      endproc
      rem ========================================================================
      
      rem Select notes on the fretboard
      def proc_select
      local x%,y%,b%
      
      mouse x%,y%,b%
      chk%=-(x%>=40)*(x%<=1840)*(y%>=800)*(y%<1100)
      if chk% then
        Out%=0
        mc&=1 : mouse on 137
        str%=int((y%-800)/50) : rem Identify string
        rem Identify fret
        fret%=0
        for f%=0 to 12
          if x%>fretpos%(f%) then fret%=f%+1
        next f%
        if (fret%<>oldfret% or str%<>oldstr%) then mvd%=1 : Once%=0 : Tnce%=0
        if  mvd%=1 then
          proc_fretboard : rem Draw a BLANK fretboard
          if Ind%>0 then proc_exist
        endif
        rem Identify the note from the string/fret combination
        nt%=st%(str%) + fret%
        if nt%>11 then nt%-=12
        rem Keep a tab on which note/string/fret the mouse is nearest
        colour 6:print tab(10,3);"Press the LEFT Mouse Button to place a finger."
        print tab(10,4);"Press the RIGHT Mouse Button to remove a finger."
        colour 4:print tab(10,6);"Note  = ";
        colour 3:print tab(20,6);nts$(nt%);"     ";
        colour 4:print tab(10,8);"String = ";
        colour 3:print tab(20,8);6-str%;"     ";
        colour 4:print tab(10,10);"Fret   = ";
        colour 3:print tab(20,10);fret%;"     ";
        gcol 1: rectangle fill fretpos%(fret%),825+str%*50,1900-fretpos%(fret%),5
        if  (b%=4 and Once%=0) then
          Once%=1 : Tnce%=0
          Ind%+=1
          if (Ind%>6 or oc%(str%)=1) then
            nmn%=1 : sys "MessageBeep",64 : Ind%-=1
          else
            rem oc% indicates which string is free (0) and which occluded (1)
            oc%(str%)=1 : Sav%=0
            sys "MessageBeep",0
            chnt%(Ind%,1)=str% : chnt%(Ind%,2)=fret%
            rem Print a black dot at the string/fret position selected
            gcol 0 : circle fill fretpos%(fret%)-40,825+str%*50,20
          endif
        endif
        if (b%=1 and Tnce%=0) then
          Tnce%=1 : cnc%=0 : Once%=0
          for  k%=1 to Ind%
            if (str%=chnt%(k%,1) and fret%=chnt%(k%,2)) then  cnc%=k%
          next k%
          if cnc%>0 then
            oc%(str%)=0 : Sav%=0
            sys "MessageBeep",0
            if cnc%<Ind% then
              for p%=cnc% to (Ind%-1)
                chnt%(p%,1)=chnt%(p%+1,1)
                chnt%(p%,2)=chnt%(p%+1,2)
              next p%
            endif
            chnt%(Ind%,1)=0 : chnt%(Ind%,2)=0 : Ind%-=1
            proc_fretboard
            if Ind%>0 then proc_exist
          else
            sys "MessageBeep",64
          endif
        endif
        oldstr%=str%
        oldfret%=fret%
        mvd%=0
      else
        mc&=0 : mouse on 0
        if Out%=0 then
          print tab(10,3);"                                                 ";
          print tab(10,4);"                                                 ";
          print tab(10,6);"                   ";
          print tab(10,8);"                   ";
          print tab(10,10);"                   ";
          proc_fretboard
          if Ind%>0 then proc_exist
        endif
        Out%=1
        if ChorNt&=1 then
          proc_fretboard
          if Ind%>0 then proc_exist
        endif
      endif
      ChorNt&=2
      *REFRESH
      endproc
      rem ========================================================================
      
      rem Controls various button options
      def proc_boxes(Cnt&)
      vdu 5
      
      case Cnt& of
        when 0 : proc_box(5,400,400,"PLAY",0,1,0) : proc_box(5,800,400,"QUIT",1,0,0)
          proc_box(5,1200,400,"SAVE",0,0,1) : proc_box(5,1600,400,"CONT",1,1,0)
        when 1 : proc_box(3,400,400,"PLAY",0,1,0) : sys "MessageBeep",0
        when 2 : proc_box(3,800,400,"QUIT",1,0,0) : sys "MessageBeep",64
        when 3 : proc_box(3,1200,400,"SAVE",0,0,1): sys "MessageBeep",0
        when 4 : proc_box(3,1600,400,"CONT",1,1,0): sys "MessageBeep",0
        when 5 : proc_box(3,1200,400," RUN",1,0,1): sys "MessageBeep",0
        when 6 : proc_box(3,1600,400,"INST",0,1,1): sys "MessageBeep",0
        when 7 : proc_box(5,400,400,"PLAY",0,1,0) : proc_box(5,800,400,"QUIT",1,0,0)
          proc_box(5,1200,400," RUN",1,0,1) : proc_box(5,1600,400,"INST",0,1,1)
      endcase
      vdu 4
      *REFRESH
      endproc
      rem ========================================================================
      
      rem Prints a coloured button to the screen
      def proc_box(Mul%,Xpos%,Ypos%,Msg$,re%,gr%,bl%)
      local h&
      
      for h&=0 to 30
        colour 2,Mul%*h&*re%,Mul%*h&*gr%,Mul%*h&*bl%
        gcol 2 : rectangle fill (Xpos%+2*h&),(Ypos%+2*h&),(150-4*h&),(150-4*h&)
      next h&
      gcol 6 : move (Xpos%+40),(Ypos%+90) : print;Msg$;
      endproc
      rem ========================================================================
      
      def proc_ChangeInst(voice%)
      local event%,velocity%,low%,hi%,dwMsg%
      
      event%=192
      velocity%=80
      low%=(voice%*256)+event%
      hi%=velocity%<<16
      dwMsg%=low%+hi%
      sys "midiOutShortMsg",hMidiOut%, dwMsg%
      endproc
      rem ========================================================================
      
      def proc_NewChord(Cnt%,Sl%)
      
      event%=176
      subevent%=127
      dwMsg%=subevent%*256 + event%
      sys "midiOutShortMsg", hMidiOut%, dwMsg%
      proc_PlayNewNotes(Cnt%,Sl%)
      if (Cnt%=1 and Sl%=Ch%) then sys "Sleep",2*lun%
      proc_StopPlay
      endproc
      rem ========================================================================
      
      def proc_PlayNewNotes(Cnt&,Sl%)
      local t%
      
      case Cnt& of
        when 0
          proc_temp
          for t%=1 to Ind%
            nn%=temp%(t%)
            proc_Note(nn%)
          next t%
          sys "Sleep",lun%
        when 1
          for t%=1 to 6
            if chord%(Sl%,t%)>0 then nn%=Up%+chord%(Sl%,t%) else nn%=0
            if nn%>0 then proc_Note(nn%)
          next t%
          sys "Sleep",lun%
      endcase
      endproc
      rem ========================================================================
      
      def proc_StopPlay
      local event%,dwMsg%
      
      event%=176
      subevent%=123
      dwMsg%=subevent%*256 + event%
      sys "midiOutShortMsg", hMidiOut%, dwMsg%
      endproc
      rem ========================================================================
      
      def proc_Note(Nn%)
      local event%,low%,velocity%,hi%,dwMsg%
      
      event%=144
      low%=(256*Nn%)+event%
      velocity%=80
      hi%=velocity%<<16
      dwMsg%=low%+hi%
      sys "midiOutShortMsg",hMidiOut%,dwMsg%
      sys "Sleep",del%
      endproc
      rem ========================================================================
      
      rem Select the play speed using a slider
      def proc_speed
      local  u%,v%,z%
      
      vdu 5
      gcol 6
      move 250,250 : print;"Use the slider to select a playing speed. Click the RIGHT Mouse Button."
      move 100,150 : print;"Slow"
      move 1450,150 : print;"Fast"
      gcol 7 : rectangle fill 200,100,1200,50
      *REFRESH
      repeat
        mouse u%,v%,z&
        if (v%>=100 and v%<=150) then
          if (u%>=200 and u%<=1400) then
            mouse on 137
            gcol 7 : rectangle fill 200,100,u%-200,50
            gcol 0 : rectangle fill (u%+1),100,1400-u%,50
            *REFRESH
            del%=4*int(120-((u%-200)/10))
          else
            mouse on 0
          endif
        else
          mouse on 0
        endif
      until z&=1
      
      mouse on 0
      a$=inkey$(50)
      gcol 0 : rectangle fill 0,0,2048,300
      *REFRESH
      vdu 4
      endproc
      rem ========================================================================
      
      rem Instrument data
      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 Change the instrument
      def proc_newInst
      local Stp%,Row%,k%,p%,Lim%,Ind%,Sel%,x%,y%,z&
      
      colour 128:cls
      colour 3:print tab(1,1);"Select an Instrument (Click on the list)"
      Stp%=0 : Row%=4 : Sel&=0
      for k%=0 to 119
        if CInst%=k% then Sel&=1
        case Sel& of
          when 0
            colour 1:print tab(Stp%,Row%);k%;" "
            colour 7:print tab(Stp%+4,Row%);Inst$(k%)
          when 1
            colour 1:print tab(Stp%,Row%);k%;" "
            colour 10:print tab(Stp%+4,Row%);Inst$(k%)
        endcase
        Stp%+=35 : if Stp%=140 then Stp%=0 : Row%+=1
        Sel&=0
      next k%
      mouse rectangle 0,448,2048,959
      StprO%=-1 : StpO%=-1 : RowO%=-1
      Swp%=1 : off
      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 CInst%=kO% then Sel&=1
            case Sel& of
              when 0
                colour 1:print tab(StpO%,RowO%);kO%;" "
                colour 7:print tab(StpO%+4,RowO%);Inst$(kO%)
              when 1
                colour 1:print tab(StpO%,RowO%);kO%;" "
                colour 10:print tab(StpO%+4,RowO%);Inst$(kO%)
            endcase
          endif
        endif
        Sel&=0
        if  Swp%=1 then
          colour 3:print tab(Stp%,Row%);k%;" "
          colour 4:print tab(Stp%+4,Row%);Inst$(k%)
          Swp%=0
        endif
        StprO%=Stpr% : StpO%=Stp% : RowO%=Row% : kO%=k%
      until z&=4
      sys "MessageBeep",0
      CInst%=kO%
      mouse rectangle off
      endif
      a$=inkey$(50)
      endproc
      rem ========================================================================
      
      rem Option to raise all notes up one octave
      def proc_upoct
      local p%,q%,z%,m&,i$
      
      i$=inkey$(20)
      vdu 5
      move 100,600
      gcol 6:print ;"Raise Octave?";
      proc_box(5,0,400," NO",1,0,0)
      proc_box(5,200,400," YES",0,1,0)
      *REFRESH
      
      m&=0 : repeat
      mouse p%,q%,z&
      rem Mouse pointer control
      if (p%>=0 and p%<=150 and q%>=400 and q%<=550) then mc&=1 else mc&=0
      if (p%>=200 and p%<=350 and q%>=400 and q%<=550) or mc&=1 then mc&=1 else mc&=0
      if mc&=1 then mouse on 137 else mouse on 0
      
      if (p%>=0 and p%<=150 and q%>=400 and q%<=550 and z&=4) then
        proc_box(3,0,400," NO",1,0,0) : sys "MessageBeep",0 : Up%=0
        m&=1
        *REFRESH
      endif
      if (p%>=200 and p%<=350 and q%>=400 and q%<=550 and z&=4) then
        proc_box(3,200,400," YES",0,1,0) : sys "MessageBeep",0 : Up%=12
        m&=1
        *REFRESH
      endif
      until m&=1
      move 100,600
      gcol 0 : print ;"Raise Octave?";
      gcol 0 : rectangle fill 0,400,350,150
      vdu 4
      i$=inkey$(50)
      endproc
      rem ========================================================================
      
      rem Sets up a temporary array being the translation of string/fret position
      rem into MIDI-format note codes
      def proc_temp
      local t%
      
      temp%()=0
      for t%=1 to Ind%
      Str%=chnt%(t%,1) : Frt%=chnt%(t%,2)
      nn%=40+5*Str%+Frt% : if Str%>=4 then nn%-=1
      temp%(t%)=nn%
      next t%
      endproc
      rem ========================================================================
      
      rem Prints the backdrop for the instrument name
      def proc_back(Xs%,Ys%,Ws%,Hs%,Rr&,Gg&,Bb&)
      local h%,Rf%,Gf%,Bf%
      
      for h&=0 to 30
      Rf&=Rr&*h&/30 : Gf&=Gg&*h&/30 : Bf&=Bb&*h&/30
      colour 9,Rf&,Gf&,Bf& : gcol 9
      rectangle fill Xs%+h&,Ys%+h&,Ws%-2*h&,Hs%-2*h&
      next h&
      endproc
      rem ========================================================================
      
      rem Choose whether to select at note or chord level
      def proc_chornot
      local p%,q%,z&,m&,i$
      
      i$=inkey$(20)
      vdu 5
      move 50,600
      gcol 6:print ;"Choose Chord or Notes?";
      proc_box(5,0,400,"CHRD",1,0,0)
      proc_box(5,200,400,"NOTE",0,1,0)
      if ChorNt&=3 then proc_box(5,100,200,"STOP",1,1,0)
      
      *REFRESH
      m&=0 : repeat
      mouse p%,q%,z&
      sys "Sleep",5
      rem Mouse pointer control
      if (p%>=0 and p%<=150 and q%>=400 and q%<=550) then mc&=1 else mc&=0
      if (p%>=200 and p%<=350 and q%>=400 and q%<=550) or mc&=1 then mc&=1 else mc&=0
      if (p%>=100 and p%<=250 and q%>=200 and q%<=350) or mc&=1 then mc&=1 else mc&=0
      if mc&=1 then mouse on 137 else mouse on 0
      
      if (p%>=0 and p%<=150 and q%>=400 and q%<=550 and z&=4) then
        proc_box(3,0,400,"CHRD",1,0,0) : sys "MessageBeep",0 : ChorNt&=1
        m&=1
        *REFRESH
      endif
      if (p%>=200 and p%<=350 and q%>=400 and q%<=550 and z&=4) then
        proc_box(3,200,400,"NOTE",0,1,0) : sys "MessageBeep",0 : ChorNt&=2
        m&=1
        *REFRESH
      endif
      if (p%>=100 and p%<=250 and q%>=200 and q%<=350 and z&=4) then
        proc_box(3,100,200,"STOP",1,1,0) : sys "MessageBeep",0 : ChorNt&=4
        m&=1 : mc&=0 : mouse on 0
        *REFRESH
      endif
      until m&=1
      
      move 50,600
      gcol 0 : print ;"Choose Chord or Notes?";
      gcol 0 : rectangle fill 0,400,350,150
      gcol 0 : rectangle fill 100,200,150,150
      vdu 4
      i$=inkey$(50)
      endproc
      rem ========================================================================
      
      rem Select an entire Chord
      def proc_celect
      local i%,Sl%,st%,nd%,Sh%,Typ%,rr%
      
      Mg$()=""
      *REFRESH ON
      colour 3: print tab(5,2);"i) Choose a chord type. ii) Select a base guitar-chord shape for this type."
      print tab(5,4);"iii) Shift the pattern up the neck by up to 9 frets."
      
      rem Choose base type
      Mg$()="Major","Minor","Dom. 7th"
      proc_StrGt(100,1200,200,3,Mg$(),Typ%)
      colour 134: colour 3: print tab(5,25);Mg$(Typ%);
      k$=inkey$(50)
      
      rem Choose a usual guitar-playable shape
      case Typ% of
      when 0 : st%=1 : nd%=5 : nm%=5
      when 1 : st%=6 : nd%=8 : nm%=3
      when 2 : st%=9 : nd%=13: nm%=5
      endcase
      for i%=st% to nd%
      Mg$(i%-st%)=Chrd$(i%)
      next i%
      proc_StrGt(100,1200,200,nm%,Mg$(),Sl%)
      colour 134: colour 3: print tab(25,25);Mg$(Sl%);" shape";
      k$=inkey$(50)
      
      rem Shift the whole playable chord shape up by a number of frets
      Mg$()="0","1","2","3","4","5","6","7","8","9"
      proc_StrGt(100,1200,100,10,Mg$(),Sh%)
      colour 134: colour 3: print tab(45,25);" moved up ";Mg$(Sh%);" frets"
      k$=inkey$(50)
      
      rem Kill dialog boxes
      colour 128: colour 0: print tab(5,25);"                                                                       ";
      print tab(5,2);"                                                                                ";
      print tab(5,4);"                                                                         ";
      *REFRESH OFF
      dex%=st%+Sl%
      rr%=Chrdata%(dex%,2)
      for i%=1 to rr%
      chnt%(i%,1)=Chrdata%(dex%,i%+2)
      chnt%(i%,2)=Sh%+Chrdata%(dex%,i%+rr%+2)
      next i%
      
      for i%=1 to rr%
      h%=Chrdata%(dex%,i%+2)
      oc%(h%)=1
      next i%
      Ind%=rr% : Sav%=0
      endproc
      
      rem Chord data
      data "Cmaj",4,6,0,1,2,3,4,5,3,3,2,0,1,0
      data "Amaj",1,6,0,1,2,3,4,5,0,0,2,2,2,0
      data "Gmaj",11,6,0,1,2,3,4,5,3,2,0,0,3,3
      data "Emaj",8,6,0,1,2,3,4,5,0,2,2,1,0,0
      data "Dmaj",6,5,1,2,3,4,5,0,0,2,3,2,0,0
      
      data "Amin",1,6,0,1,2,3,4,5,0,0,2,2,1,0
      data "Dmin",6,5,1,2,3,4,5,0,0,2,3,1,0,0
      data "Emin",8,6,0,1,2,3,4,5,0,2,2,0,0,0
      
      data "A7",1,6,0,1,2,3,4,5,0,0,2,0,2,0
      data "G7",11,6,0,1,2,3,4,5,3,2,0,0,0,1
      data "E7",8,6,0,1,2,3,4,5,0,2,0,1,3,0
      data "D7",6,5,1,2,3,4,5,0,0,2,1,2,0,0
      data "C7",4,4,1,2,3,4,3,2,3,1,0,0,0,0
      rem ========================================================================
      
      rem String / Mouse selection routine
      def proc_StrGt(Xpos%,Ypos%,Wd%,mg%,Mg$(),return Sel%)
      local x%,y%,b%,k%,tb%
      
      tb%=int(Wd%/16)
      
      mouse rectangle Xpos%,Ypos%,Wd%*mg%,75
      gcol 6 : rectangle fill Xpos%,Ypos%,Wd%*mg%,75
      colour 134
      for k%=0 to (mg%-1)
      print tab(10+k%*tb%,9);Mg$(k%);
      next k%
      
      repeat
      mouse x%,y%,b%
      mc&=1 : mouse on 137
      for k%=0 to mg%
        tstl%=100+k%*Wd% : tsth%=100+Wd%+k%*Wd%
        if x%>tstl% and x%<tsth% then colour 4 : Sel%=k% else colour 3
        print tab((10+k%*tb%),9);Mg$(k%)
      next k%
      until b%=4
      mc&=0 : mouse on 0
      sys "MessageBeep",0
      gcol 0 : rectangle fill Xpos%,Ypos%,Wd%*mg%,75
      mouse rectangle off
      endproc
      rem ========================================================================
      
      rem Print the instrument name
      def proc_printInst
      
      proc_boxes(7)
      *FONT Desdemona,16
      proc_back(250,950,1200,150,200,200,200)
      colour 137:colour 6: print tab(15,10);"INSTRUMENT:    ";Inst$(CInst%);"                  ";
      *REFRESH
      *FONT
      @vdu%!216 = 8
      @vdu%!220 = 16
      Pl%=0
      endproc
      rem ========================================================================