rem Celestial .... Rev 4.1
      rem A J Tooth // February 2005
      rem Revised to use single-byte variables January 2007
      
      rem =================================================================
      rem Plays examples of nearly all guitar chords on a chosen instrument
      rem =================================================================
      
      rem =================================================================
      on error then sys "midiOutClose", Channel% : quit
      install @lib$+"MyUtils.bbc"
      install @lib$+"MIDI_Utils.bbc"
      rem =================================================================
      
      rem Setup
      proc_setup
      
      rem Main Repeat routine
      proc_Main
      
      rem Resolve with a Maj7 chord in the final key
      proc_finale
      
      quit
      rem End of Program +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      rem ========================================================================
      
      rem Setup
      def proc_setup
      
      rem Go to fullscreen
      proc_fullscreen(xscreen%,yscreen%) : mouse on
      
      dim Key$(11), Mg$(11), FSseq&(11)
      dim ChName$(45), Chrdata&(45,6), Inst$(120), InstOct&(120), nt&(6)
      
      rem Set key names
      proc_Set_Keys(Key$())
      
      FSseq&()=1,2,1,1,2,1,2,1,3,2,1,2
      lag%=500 : rem Gap between Chords
      del%=200 : rem Gap between single notes within a chord
      
      rem Load chord data
      proc_Load_Chord_Data(ChName$(),Chrdata&())
      
      rem Load Instruments
      proc_Load_MIDI_instruments(Inst$(),InstOct&())
      
      rem Select standard instrument
      Inst&=255 : proc_Selinst(Inst&,xscreen%,yscreen%)
      
      cls : mouse off
      rem Provides a celestial backdrop
      proc_backdrop
      
      rem Draw a treble clef based motif
      proc_motif(xscreen%/2,yscreen%,rnd(1),rnd(1),rnd(1))
      
      rem Display Title
      proc_Title("Celestial Music")
      
      rem Open MIDI Channel
      proc_MIDI_Open(^Channel%)
      
      rem Change the instrument
      proc_MIDI_ChangeInst(Channel%,Inst&)
      
      colour 6:print tab(10,10);"Now playing: ";
      Key&=rnd(12)-1 : rem Change the key
      
      endproc
      rem-----------------------------------------------------------------
      
      rem Main Repeat routine
      def proc_Main
      local ch, chord&, Chrd$, t&, b$
      
      repeat
        rem Change the key 10% of the time
        ch=rnd(1) : if ch<0.1 then Key&=rnd(12)-1
        if FSseq&(Key&)=2 then Key$=mid$(Key$(Key&),4,2) else Key$=left$(Key$(Key&),2)
        
        rem Choose one of 45 chords at random
        chord&=rnd(45)
        Chrd$=Key$+" "+ChName$(chord&)
        colour 3: print tab(25,10);Chrd$;"                ";
        
        rem Set the correct notes and play them
        proc_SetNotes(InstOct&(Inst&),chord&,nt&(),Chrdata&())
        
        rem Play the next chord
        proc_PlayChord(Channel%,nt&(),127,1,del%,lag%)
        
        b$=inkey$(1)
      until b$<>""
      endproc
      rem-----------------------------------------------------------------
      
      rem Resolve with a Maj7 chord in the final key
      def proc_finale
      local t&
      
      Chrd$=Key$+" "+ChName$(6)
      colour 3: print tab(25,10);Chrd$;"             ";
      
      proc_SetNotes(InstOct&(Inst&),6,nt&(),Chrdata&())
      del%=300
      
      rem Play the last chord
      proc_PlayChord(Channel%,nt&(),127,1,del%,lag%)
      
      a$=inkey$(200)
      rem Close MIDI Channel on exit
      proc_MIDI_Close(Channel%)
      endproc
      rem-----------------------------------------------------------------
      
      rem Provides a backdrop
      def proc_backdrop
      local x%,y%,u&,s&,Nm&
      local r&,g&,b&,rr&,gg&,bb&
      
      Nm&=40
      for s&=1 to 100
        x%=rnd(xscreen%)-1 : y%=rnd(yscreen%)-1
        r&=rnd(255)
        g&=rnd(255)
        b&=rnd(255)
        for u&=0 to Nm&
          rr&=int(r&*u&/Nm&)
          gg&=int(g&*u&/Nm&)
          bb&=int(b&*u&/Nm&)
          colour 7,rr&,gg&,bb& : colour 7
          circle fill 2*x%,2*y%,(Nm&-u&)
        next u&
      next s&
      endproc
      rem-----------------------------------------------------------------
      
      rem Draw a treble clef motif
      def proc_motif(Xd%,Yd%,F,G,H)
      local a%
      
      for a%=1 to 200
        Xc%=Xd%+5*a% : Yc%=Yd%+100*sin(a%*2*pi/127)
        rem Draw a treble clef
        proc_clef(a%,Xc%,Yc%,F,G,H)
      next a%
      endproc
      rem-----------------------------------------------------------------
      
      rem Display Title
      def proc_Title(Msg$)
      local a&
      
      *FONT Desdemona,36
      for a&=1 to 15
        colour 10,100+rnd(155),100+rnd(155),100+rnd(155) : colour 10
        print tab(5+2*a&,1);mid$(Msg$,a&,1)
      next a&
      *FONT Arial,12
      colour 2 : print tab(15,40);"Press any key to stop."
      endproc
      rem-----------------------------------------------------------------