rem Random Music ... Rev 2.0
      rem A J Tooth // March 2004
      
      dim Sc$(24,2),MajMin%(7,2),Base%(4),Chrd$(7,2)
      mode(22)
      off
      colour 3
      rem Load Musical Scales data
      proc_setup
      
      rem Picks a key at random
      proc_randpick
      
      proc_clef(512,700,rnd(1),rnd(1),rnd(1))
      
      print tab(10,10);"Currently playing in the Scale of "
      colour 13 : print tab(45,10);Sc$(key%,sf%);" ";Mood$
      
      colour 3 : print tab(10,14);"The notes of this scale are:"
      rem Display names of notes for the chosen scale
      colour 9
      proc_disnotes
      
      rem Play Maj/Min scales
      proc_majminplay(key%,lh%)
      
      colour 3 : print tab(10,35);"Press any key to continue."
      a$=get$
      print tab(10,35);"Press any key to finish with the Coda."
      rem Play random-generated tune in current key
      proc_ranchord
      
      c$=inkey$(200) : rem Pause for 2 seconds
      cls:colour 10:print tab(10,10);"Playing My Coda. Close the window to STOP."
      rem Plays My Coda
      proc_mycoda
      
      end
      rem End of Program ================================
      
      rem Musical Scales Base Data
      rem +++++++++++++++++++++++++++++++++++++++++++++++
      data C,C#,D,D#,E,F,F#,G,G#,A,A#,B
      data C,Db,D,Eb,E,F,Gb,G,Ab,A,Bb,B
      data 1,3,5,6,8,10,12
      data 1,3,4,6,8,9,11
      data 1,3,5,7
      data maj7,min7,min7,maj7,dom7,min7,dim7
      data min7,dim7,maj7,min7,min7,maj7,dom7
      rem Tune Data
      data 5,-1,5,0,7,0,3,1,5,1,5,1,5,1,3,1,7,0,7,0,7,0,3,1,5,1,3,1,7,0,5,0
      data 1,0,5,0,1,1,3,1,6,1,6,1,6,1,3,1,5,1,5,1,5,1,3,1,5,1,3,1,1,1,5,0
      data 7,1,7,1,7,1,7,1,7,1,7,1,7,1,1,2,7,1,5,1,5,1,5,1,5,1,5,1,5,1,4,1
      data 3,1,3,1,5,1,5,1,5,1,3,1,6,1,3,1,5,1,5,1,5,1,3,1,5,1,3,1,1,1,5,0
      data 5,-1,5,0,7,0,3,1,5,1,5,1,5,1,3,1,7,0,7,0,7,0,3,1,3,1,4,1,3,1,2,1
      data 1,1,1,1,1,1,1,1,1,0,1,0,1,0,1,0,3,1,3,1,3,1,3,1,1,1,1,1,1,1,1,1
      rem +++++++++++++++++++++++++++++++++++++++++++++++
      
      def proc_setup
      local a%,b%,c%,d%,g%,h%,j%
      
      rem Load notes
      restore
      for b%=1 to 2
        for a%=1 to 12
          read Sc$(a%,b%)
          Sc$((a%+12),b%)=Sc$(a%,b%)
        next a%
      next b%
      
      rem Load Maj/Min scale points
      for d%=1 to 2
        for c%=1 to 7
          read MajMin%(c%,d%)
        next c%
      next d%
      
      rem Load Base-Chord sequence
      for g%=1 to 4
        read Base%(g%)
      next g%
      
      rem Load extended Triad Chord names
      for j%=1 to 2
        for h%=1 to 7
          read Chrd$(h%,j%)
        next h%
      next j%
      endproc
      rem +++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Play Maj/Min scales. nte%=100 represents Middle C
      def proc_majminplay(s%,Lh%)
      local a%,nte%
      for a%=1 to 8
        if a%<=7 then
          nte%=100-48*Lh% + 4*(s%-1) + (4*(MajMin%(a%,m%)-1))
          sound 1,-15,nte%,5
        else
          nte%=148-48*Lh% + 4*(s%-1) + (4*(MajMin%((a%-7),m%)-1))
          sound 1,-15,nte%,10
        endif
      next a%
      endproc
      rem +++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Plays a single note (or a rest)
      def proc_noteplay(Nt%,Oct%,Key%,Lh%,Dur%,Ld%,Ch%)
      local nte%
      nte%=100-48*(Lh%-Oct%) + 4*(Key%-1) + (4*(MajMin%(Nt%,m%)-1))
      sound Ch%,Ld%,nte%,Dur%
      endproc
      rem +++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Picks Key at random
      def proc_randpick
      key%=rnd(12)
      m%=rnd(2) : rem Major=1, Minor=2
      
      rem sf% determines whether to use the # or b nomenclature
      case m% of
        when 1:
          case key% of
            when 2,4,6,9,11      : sf%=2
            when 1,3,5,7,8,10,12 : sf%=1
          endcase
        when 2:
          case key% of
            when 1,4,6,8,11      : sf%=2
            when 2,3,5,7,9,10,12 : sf%=1
          endcase
      endcase
      
      lh%=rnd(2)-1 : rem 1=down an octave, 0=don't change
      case m% of
        when 1 : Mood$="Major"
        when 2 : Mood$="Minor"
      endcase
      endproc
      rem +++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Display notes of the scale
      def proc_disnotes
      local a%
      for a%=0 to 6
        print tab((10+4*a%),16);Sc$((key%+MajMin%((a%+1),m%)-1),sf%)
      next a%
      endproc
      rem +++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Draws a Treble Clef
      def proc_clef(Xd%,Yd%,F,G,H)
      
      for a%=0 to 200
        colour 15,int(F*a%),int(G*a%),int(H*a%)
        gcol 15
        Xc%=Xd%+5*a% : Yc%=Yd%+100*sin(a%*2*pi/127)
        move Xc%,Yc% : move Xc%,Yc%+10
        plot 165,Xc%,Yc%-10
        move Xc%,Yc%-30
        plot 165,Xc%,Yc%+10
        move Xc%,Yc%-7 : move Xc%-20,Yc%+10
        plot 165,Xc%,Yc%-30
        move Xc%-20,Yc%+10
        draw Xc%+20,Yc%+50
        move Xc%,Yc%+60 : move Xc%+23,Yc%+50
        plot 165,Xc%+10,Yc%+70
        move Xc%,Yc%+70 : draw Xc%,Yc%-70
        move Xc%+10,Yc%+70 : move Xc%+20,Yc%+70
        plot 165,Xc%,Yc%+70
        move Xc%-10,Yc%-70 : move Xc%-20,Yc%-80
        plot 165,Xc%,Yc%-70
        circle fill Xc%-10,Yc%-70,5
      next a%
      endproc
      rem +++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Plays my Tune
      def proc_mycoda
      dim Tune%(100,2)
      Num%=96
      for v%=1 to Num%
        read Tune%(v%,1),Tune%(v%,2)
      next v%
      
      rem Choose key of A Major
      key%=10 : m%=1 : lh%=1 : ch%=1 : flp%=1
      repeat
        proc_clef(512,700,rnd(1),rnd(1),rnd(1))
        for y%=1 to Num%
          nt%=Tune%(y%,1) : oct%=Tune%(y%,2)
          envelope 1,1,0,0,0,0,0,0,5,-5,-5,-5,126,120
          proc_noteplay(nt%,oct%,key%,lh%,7,1,ch%)
          ch%=ch%+flp% : flp%=-flp%
        next y%
        a$=inkey$(1)
        cls
      until a$=" "
      endproc
      rem +++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Plays random sequences of chords in the relevant key
      def proc_ranchord
      print tab(10,18);"Present notes are from the chord: "
      colour 14
      go%=0
      repeat
        rem Set the root note for the next chord
        seld%=0 : ch%=1 : flp%=1
        root%=rnd(7)
        ref%=key% + MajMin%(root%,m%) - 1
        colour 14:print tab(10,20);Sc$(ref%,sf%);Chrd$(root%,m%);" ";
        rem Play 8 notes from the chord determined by root%
        for t%=1 to 8
          oct%=0
          if t%<=4 then
            sel%=t%
          else
            repeat
              sel%=rnd(4)
            until sel%<>seld%
          endif
          nt%=root% + Base%(sel%) - 1
          if nt%>7 then nt%=nt%-7 : oct%=oct%+1
          colour 10:print tab((10+4*(nt%-1)),15);"*"
          rem Envelope combined with dual channel play sounds like a harmonica
          envelope 1,1,0,0,0,0,0,0,15,-5,-5,-5,126,120
          proc_noteplay(nt%,oct%,key%,lh%,12,1,ch%)
          ch%=ch%+flp% : flp%=-flp%
          seld%=sel%
          if go%=1 then nt2%=nt1% :colour 0:print tab((10+4*(nt2%-1)),15);"*"
          nt1%=nt%
          go%=1
        next t%
        
        b$=inkey$(0)
      until b$=" "
      endproc