%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%
%%% Canon (minimal rule set ;-)
%%%

local
   %% The list of duration values permitted: corresponds to eighth note
   %% (2) up to whole note (16), as the timeUnit is beats(4).
   Durations = [2 4 8 16]
   %% Specify fundamental pitch class (i.e. dorian mode)
   FundamentalPC = 2
   %% Create all pitches between Min and Max which belong to the pitch
   %% classes in PCs
   fun {MakeWhiteKeyDomain Min Max}
      WhiteKeys = [0 2 4 5 7 9 11]
   in
      {Filter {List.number Min Max 1}
       fun {$ Pitch}
	  {Member (Pitch mod 12) WhiteKeys}
       end}
   end
   %%
   %% Rhythmic rules
   %%
   %% The voice starts and ends with notes of maximal
   %% duration. Besides, the last note starts on a full bar.
   proc {StartAndEndWithLongest MyVoice}
      Notes = {MyVoice getItems($)}
      FirstNote = Notes.1
      LastNote = {List.last Notes}
      MaxDur = {LUtils.accum Durations Max}
   in 
      {FirstNote getDuration($)} = MaxDur
      {LastNote getDuration($)} = MaxDur
      %% start on full bar
      {FD.modI {LastNote getStartTime($)} MaxDur} = 0
   end
   %% Neighbouring notes vary not too much in their rhythmic
   %% value. Possible duration relations are 1:1, 2:1, and 1:2.
   proc {SlowRhythmChanges Note}
      if {Note hasTemporalPredecessor($)}
      then
	 Dur1 = {{Note getTemporalPredecessor($)} getDuration($)}
	 Dur2 = {Note getDuration($)}
	 HalveDur1 = {FD.times $ 2 Dur1}
      in
	 Dur2 = {FD.times HalveDur1 {FD.int [1 2 4]}}
      end
   end
   %%
   %% Melodic rules
   %%
   %% The pitch class of this first and last note in the voice is the
   %% fundamental (applied only to the lowest voice).
   proc {StartAndEndWithFundamental MyVoice}
      Notes = {MyVoice getItems($)}
   in 
      {FD.modI {Notes.1 getPitch($)} 12} =: FundamentalPC 
      {FD.modI {{List.last Notes} getPitch($)} 12} =: FundamentalPC
   end
   %% Only intervals up to a major third are allowed, no pitch
   %% repetition.
   proc {NoBigJump Note}
      if {Note hasTemporalPredecessor($)}
      then
	 Pitch1 = {{Note getTemporalPredecessor($)} getPitch($)}
	 Pitch2 = {Note getPitch($)}
      in
	 %% all intervals between minor second and fourth are allowed
	 {FD.distance Pitch1 Pitch2 '>:' 0}
	 {FD.distance Pitch1 Pitch2 '<:' 5}
      end
   end
   %%
   %% Harmonic rule
   %%
   %% Constrains all simultaneous notes in Voice1 and Voice2 to be
   %% consonant, i.e. their interval is one of the intervals in
   %% ConsonantIntervals. Unisono is prohibited (the interval 0 is
   %% excluded). Voice1 is implicitly constrained to be the lower voice
   %% and voice crossing is prohibited.
   proc {NoDissonance Voice1 Voice2}
      ConsonantIntervals = [3 4 7 8 9 12 15 16]
   in
      {ForAll {Voice1 getItems($)}
       proc {$ Note1}
	  Pitch1 = {Note1 getPitch($)}
       in
	  {ForAll {Voice2 getItems($)}
	   proc {$ Note2}
	      %% !! Consonance does not necessarily get determined (if
	      %% notes are not simultaneous).
	      Pitch2 = {Note2 getPitch($)}
	      Consonance = {FD.int ConsonantIntervals}	
	   in
	      {FD.impl		
	       {Note1 isSimultaneousItemR($ Note2)}
	       (Pitch1 + Consonance =: Pitch2)
	       1}
	   end}
       end}
   end
   proc {DoCanon Voice1 Voice2 CanonNr}
      %% The first CanonNr notes of each voice form a canon in a
      %% fifth. Voice2 is a fifth higher than Voice1.
      for
	 Note1 in {List.take {Voice1 getItems($)} CanonNr}
	 Note2 in {List.take {Voice2 getItems($)} CanonNr}
      do
	 {Note1 getPitch($)} + 7 =: {Note2 getPitch($)}
	 {Note1 getDuration($)} =: {Note2 getDuration($)}
      end
   end
   %%
   %% Score constructor
   %%
   proc {SimpleCanon MyScore}
      EndTime 			% same endtime to share between voices
      %% make a score part which is combinable with other parts
      Alto = {Score.makeScore2 
	      seq(info:alto
		  items: {LUtils.collectN 17
			  fun {$}
			     note(duration: {FD.int Durations}
				  pitch: {FD.int {MakeWhiteKeyDomain 54 72}}
				  amplitude: 80)
			  end}
		  offsetTime:{LUtils.accum Durations Max}*2
		  endTime:EndTime)
	      unit}
      Tenor = {Score.makeScore2
	       seq(info:tenor
		   items: {LUtils.collectN 15
			   fun {$}
			      note(duration: {FD.int Durations}
				   pitch: {FD.int {MakeWhiteKeyDomain 50 68}}
				   amplitude: 80)
			   end}
		   offsetTime:0 % explicit default 
		   endTime:EndTime)
	       unit}
   in
      MyScore = {Score.makeSim [Alto Tenor]
		 unit(startTime: 0
		      offsetTime:0
		      timeUnit:beats(4))}
      %% finish initialisation (i.e. score will not be further extended)
      {Score.initScore MyScore}	
      %%
      %% Apply compositional rules:
      %%
      %% rules for all notes
      {MyScore forAll(test: isNote
		      proc {$ Note}
			 {NoBigJump Note}
			 {SlowRhythmChanges Note}
		      end)}
      %% rules for each voice
      {MyScore forAll(test:isSequential
		      proc {$ MyVoice}
			 {StartAndEndWithLongest MyVoice}
		      end)}
      %% restriction on a single note duration to force rhythmic diversity
   %{Nth {Tenor mapItems($ getDuration)} 7} = {LUtils.accum Durations Min}
      %% rule on lower voice
      {StartAndEndWithFundamental Tenor}
      %% rules on whole score
      {NoDissonance Tenor Alto}
      {DoCanon Tenor Alto 10}
   end
in 
   {SDistro.exploreOne SimpleCanon
    unit(order:startTime value:random)}
end