%%% *************************************************************
%%% Copyright (C) Torsten Anders (www.torsten-anders.de) 
%%% This program is free software; you can redistribute it and/or
%%% modify it under the terms of the GNU General Public License
%%% as published by the Free Software Foundation; either version 2
%%% of the License, or (at your option) any later version.
%%% This program is distributed in the hope that it will be useful,
%%% but WITHOUT ANY WARRANTY; without even the implied warranty of
%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%%% GNU General Public License for more details.
%%% *************************************************************


%%
%% TODO:
%%
%% - Kadenzen sind formelhaft -- kan ich die irgendwie formelhaft definieren, so dass nur Transpositionen von einer oder anderer Variante moeglich sind? Kann ich z.B. irgendwie Motif mit Constraints definieren so dass nur diese Varianten moeglich sind? Nicht ganz einfach: Kadenz-Motiv involviert mehrere Stimmen, verschiedene Kadenz-Motive sind moeglich, und Anzahl der Toene variiert zwischen den Kadenz-Motiven.
%% Idee: mehrstimmiges Motiv definieren mit den folgenden Parametern: Notendauern pro Stimme, resultierende Intervalle zwischen den Stimmen in ScaleDegrees, melodische Intervalle pro Stimme, Angabe wo Halbtoene und wo nicht.
%% Vereinfachung: nur "alte Diskantklausel" erlauben  
%%
%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% This example demonstrates Strasheela's capabilities for polyphonic
%% CSP where both the pitch structure as well as the rhythmical
%% structure is constrained by rules. The example was designed to be
%% relatively simple. Therefore, it compiles rules from various
%% sources instead of following a specific author closely (as did the
%% Fuxian first species counterpoint example). For example, some rules
%% are variants from Fuxian rules introduced before, but rhythmical
%% rules were inspired by Motte [1981]. Accordingly, the result does
%% also not imitate a particular historical style (but neither does
%% Fux, cf. Jeppesen).
%%
%%
%%
%% This example creates a two voice counterpoint as the Fuxian
%% example. The music representation is hence very similar to this
%% example. The representation consists in two parallel voices (Voice1
%% and Voice2) -- two sequential containers nested in a simultaneous
%% container -- as before. The Voice1 contains 17 and Voice2 15 notes.
%% 
%% The start time and end time of both voices is further
%% restricted. Voice1 begins a bar before Voice2. This is expressed by
%% setting the offset time of these two sequential containers
%% (contained in a simultaneous container) to different values (the
%% offset of Voice1 is 0, and the offset of Voice2 is a semibreve,
%% i.e. 16 as the temporal unit is beats(4), that is a quarter note
%% has duration 4). Besides, both voices end at the same time (the end
%% time of both sequential containers is unified).
%%
%% In contrast to the Fuxian example, all pitches but also all
%% durations are searched for. Each note duration has the domain [2 4
%% 8] (i.e. the set {eighth, quarter, halve note}). The pitch domain
%% for each note in Voice1 is set to 53#67 (i.e. {f3, ..., g4}, the
%% domain for the note pitches of Voice2 is slightly greater 53#72
%% (i.e. {f3, ..., c4}).
%% 
%% The example defines rules on various aspects of the music. The
%% example applies rhythmic rules, melodic rules, harmonic rules,
%% voice-leading rules and rules on the formal structure.
%%
%% Rhythmical rules constrain each voice to start and end with a halve
%% note value. Note durations may change only slowly across a voice:
%% neighbouring note values are either of equal length or differ by
%% 50% at maximum (e.g. a eighth can be followed by a quarter, but not
%% by a halve). Also, the last note of each voices must start with a
%% full bar.
%% 
%% Melodic rules restrict each note pitch to the diatonic pitches of
%% the C-major scale. The first and last note of Voice1 must start and
%% end with the root $c$. The melodic interval between neighbouring
%% pitches in a voice is limited to a minor third at maximum
%% (i.e. less than in the Fuxian example). In addition and most
%% importantly, one rule constrains melodic peaks: the maximum and
%% minimum pitch in a phrase occurs exactly once and it is not the
%% first or last note of the phrase. In this example, a phrase is
%% defined simply as half a melody. Finally, the pitch maxima and
%% minima of phrases must differ. This rule on the melodic contour --
%% inspired by Schoenberg -- has great influence on the personally
%% evaluated quality of the result but also on the combinatorial
%% complexity of the CSP.
%% 
%% Simultaneous notes must be consonant. The only exception permitted
%% here are passing tones, where Note1 is a passing tone (i.e. the
%% intervals to its predecessor and successor are steps and both steps
%% occur in the same direction) and the simultaneous Note2 started
%% more early than Note1, and this Note2 is consonant to predecessor
%% of Note1. Because the rhythmical structure of the result is
%% undetermined in the problem definition, the context of simultaneous
%% notes can not be accessed directly and is therefore constrained by
%% logical connectives.
%% 
%% Open parallel fifth and octaves are not allowed. Still, hidden
%% parallels are unaffected here -- in contrast to the previous
%% example.
%% 
%% Finally, both voices form a canon in the fifth: the first N notes
%% of both voices form (transposed) equivalents. In the case here,
%% N=10.
%%
%%


declare
[ET12] = {ModuleLink ['x-ozlib://anders/strasheela/ET12/ET12.ozf']}
%% use default HS database


%%
%% Top-level definition (defines constraint script) 
%%

%%
%% NOTE: even single melody can result in long search. Can I further improve distro strategy?
%%

%% NOTE: example is unfinished -- I commented out rules and part of the music representation for testing
proc {Canon MyScore}
   EndTime Voice1 Voice2
 in
   MyScore =
   %% Score.makeScore transforms textual music representation into
   %% nested score object
   {Score.makeScore
    sim(items: [seq(%% when MyScore is created from this textual
                    %% representation, then Voice1 is bound to the
                    %% sequential object to which this arg handle
                    %% belongs
		    handle:Voice1  
		    items: {LUtils.collectN 33 % TMP 17
			    %% LUtils.collectN returns a list of 17
			    %% note specs with individual variables at the
			    %% parameters duration and pitch
			    fun {$}
			       note(duration: {FD.int Durations}
				    pitch: {FD.int 53#67}
				    amplitude: 80)
			    end}
		    offsetTime:0
		    %% Voice1 and Voice2 end at the same time (unified end times)
		    endTime:EndTime)
		%% TMP
% 		seq(handle:Voice2
% 		    items: {LUtils.collectN 15
% 			    fun {$}
% 			       note(duration: {FD.int Durations}
% 				    pitch: {FD.int 53#72}
% 				    amplitude: 80)
% 			    end}
% 		    %% start of Voice2 is delayed by {List.last
% 		    %% Durations}*2 (i.e. a semibreve)
% 		    offsetTime:{List.last Durations}*2
% 		    endTime:EndTime)
	       ]
	startTime: 0 
	timeUnit:beats(2))  % a beat has length 2 (i.e. 1 denotes an eigths note)
    %% use default score constructors (i.e. the constructor for seq,
    %% sim, and note are not overwritten by user)
    unit}
   %%
   %% Apply compositional rules:
   %%
   %% rules for al notes
%    {MyScore forAll(test: isNote
% 		   proc {$ Note}
% 		      {InCMajor Note}
% 		   end)}
%    %% rules for notes of first voice
%    {Voice1 forAll(test: isNote
% 		  proc {$ Note}
% 		     {StartAndEndWithFundamental Note}
% 		  end)}
   {StartAndEndWithBreveOrWhole Voice1}
   {UseRhythmicCells Voice1}
   {PreferDurationRepetitions Voice1}
%   {EndOnFullBar Voice1}
%   {SlowRhythmChanges Voice1}
   %% REVISE
%   {MaxAndMinPitchOnlyOnce Voice1}
   {BallisticMelody Voice1}
   {RestrictMelodicIntervals Voice1}
   %% TMP
%   {BallisticMelody Voice2}
%   {RestrictMelodicIntervals Voice2}
%   {MaxAndMinPitchOnlyOnce Voice2}
%   {ConstraintDissonance Voice1 Voice2}
%   {NoParallels Voice1 Voice2}
%   {IsCanon Voice1 Voice2}
end

/** %% Test case: only create a rhythmic structure of a single voice.
%% */
proc {RhythmicVoice Args MyScore}
   Defaults = unit(beatNumber:2	% can be 2 or 3 for 2/1 or 3/1
		  )
   As = {Adjoin Defaults Args}
   Voice1
   %% BUG: measure cannot be contained in MyScore, always results in fail
   UniMeasures = {Score.makeScore measure(n:{FD.decl} 	% ??
					  beatNumber:As.beatNumber
					  beatDuration:Whole
					 )
		  unit(measure:Measure.uniformMeasures)}
in
   
   MyScore =
   {Score.makeScore
    sim(items: [
		seq(handle:Voice1
		    info:lily("\\time "#As.beatNumber#"/1"
			      %% automatically split and tie notes
			     "\\new Voice \\with {\n\\remove \"Note_heads_engraver\"\n\\consists \"Completion_heads_engraver\"\n}")
		    items: {LUtils.collectN 34 % TMP 17
			    fun {$}
			       note(duration: {FD.int Durations}
				    pitch: 60
				    amplitude: 80)
			    end})
	
	       ]
	startTime: 0 
	timeUnit:beats(2))  
    add(measure:Measure.uniformMeasures)}
   %%
   %% Apply compositional rules:
   %%
   {MyScore forAll(test: isNote
		   proc {$ MyNote}
		      %% BUG: 
		      %% TreatNoteOverlappingBarline is probably too strict: with only EndOnBarline I found solutions 'by hand' for TreatNoteOverlappingBarline, but with this constraint no solution was found
		      %%
		      %% together with EndOnBarline and number of
		      %% notes this constraint is rather strict --
		      %% their may be no solution!
		      %% 
		      %% However, there are usually trivial solutions
		      %% like only breve. Only, these are not
		      %% found. Can I somehow improve propagation for
		      %% these?
		      %%
		      %% Yet -- there may be no other! I tried a few cases with only few notes and a solution consisting in breves only was found, if I require EndOnBarline and TreatNoteOverlappingBarline. Strange..
		      %% with up to 9 notes there was no other solution. Quite possibly there is some error here..
%		      {TreatNoteOverlappingBarline MyNote UniMeasures}
		      %%
		      {NoQuarterStartsOnBar MyNote UniMeasures}
		   end)}
   %% TODO: Einsatz kuerzerer rythmischer Werte beginnt auf leichterer Zeit der vorangegangenen Notendauer. Jedenfalls beginnt keine Viertelgruppe auf 1 des Taktes..
   {EndOnBarline Voice1 UniMeasures}
  {StartAndEndWithBreveOrWhole Voice1 UniMeasures}
  {UseRhythmicCells Voice1}
   {PreferDurationRepetitions Voice1}
end


/** %% Test case: only create pitch structure of a single voice.
%% */
proc {PitchVoice Args MyScore}
   Defaults = unit(voice1PitchDomain:55#72)
   As = {Adjoin Defaults Args}
   Voice1
   MyScale = {Score.makeScore scale(
				 %% root of the scale is not used, therefore major is fine
				 index:{HS.db.getScaleIndex 'major'}
				 transposition:{ET12.pc 'C'}
				 )
	      unit(scale:HS.score.scale)}
in
   
   MyScore =
   {Score.makeScore
    sim(items: [seq(handle:Voice1
		    items: {LUtils.collectN 60 % TMP 17
			    fun {$}
			       note(duration: Whole
				    pitch: {FD.int As.voice1PitchDomain}
				    % inScaleB:1 % ?? NOTE: too strict?
				    inScaleB:{FD.int 0#1}
				    %% only natural or sharps
				    scaleAccidental:{FD.int [{ET12.acc ''}
							     {ET12.acc '#'}]}
				    getScales:proc {$ Self Scales} Scales=[MyScale] end
				    amplitude: 80)
			    end})]
	startTime: 0 
	timeUnit:beats(2))
    %% NOTE: full note is not actually required..
    add(note:HS.score.scaleDegreeNote)}
   %%
   %% Apply compositional rules:
   %%
%    {MyScore forAll(test: isNote
% 		   proc {$ MyNote}
% 		      {...}
% 		   end)}
   {ResolvedAccidentals Voice1}
   {BallisticMelody Voice1}
   {RestrictMelodicIntervals Voice1}
   {RestrictIntervalsBetweenMelodicPeaks Voice1}
   %%
   %% TODO: hide tritonus
   %% TODO: soft overall contour: at least don't start with highest tone (hm -- this should be piece-specific)
end



%%
%% Rule definitions
%%

% Durations = [2 4 8]
% Durations = [4 8 16]
Longa = 32
Breve = 16
DottedWhole = 12
Whole = 8
DottedHalve = 6
Halve = 4
Quarter = 2
Eighth = 1
%% no Longa and no Eighth?
Durations = [Breve DottedWhole Whole DottedHalve Halve Quarter]

/** %% First and last note duration in MyVoice are a whole note or a full bar. Use this rule for a longer section.
%% */
%% TODO: rule for shorter section: Phrase schliessen mit laengstem Notenwert in Phrase (dieser kann schon zuvor vorkommen) ODER mit Ganzer oder laenger
proc {StartAndEndWithBreveOrWhole MyVoice UniMeasures}
   Notes = {MyVoice getItems($)}
   BarDur = {UniMeasures getMeasureDuration($)}
in
   {FD.disj ({Notes.1 getDuration($)} =: BarDur)
    ({Notes.1 getDuration($)} =: Whole)
    1}
   {FD.disj ({{List.last Notes} getDuration($)} =: BarDur)
    ({{List.last Notes} getDuration($)} =: Whole)
    1}
end
% /** %% [?? too simple -- assumes 2/1 bar?] Last note starts on full breve.
% %% */
% proc {EndOnFullBar MyVoice}
%    LastNote = {List.last {MyVoice getItems($)}}
% in
%    {FD.modI {LastNote getStartTime($)} Breve} = 0
% end
/** %% [??!! too strict] factor between neighbouring note durations in MyVoice is either 1/2, 1 or 2.
%% [?? possible alternative -- would be too loose?] The factor between neighbouring note durations in MyVoice is either 1/4, 1/3, 1/2, 1, 2, 3, or 4.
%%
%% Revision: in many / most cases two neighbouring notes have the same duration. 
%% .. in most cases is the factor between neighbouring note durations in {}
%%
%% Also: durations are either on a strong beat (depending on their value) or on a beat or have a beat of (for dotted notes it counts for the note without dot)
%% */
proc {SlowRhythmChanges MyVoice}
   {Pattern.for2Neighbours {MyVoice getItems($)}
    proc {$ N1 N2}
       Dur1 = {N1 getDuration($)}
       Dur2 = {N2 getDuration($)}
       HalveDur1 
    in
       {FD.times HalveDur1 2 Dur1}
       {FD.times HalveDur1 {FD.int [1 2 4]} Dur2}
    end}
end

/** %% In many cases, two neighbouring notes in MyVoice have the same duration.  
%% */
proc {PreferDurationRepetitions MyVoice}
   Bs = {Pattern.map2Neighbours {MyVoice mapItems($ getDuration)}
	 fun {$ Dur1 Dur2}
	    Dur1 =: Dur2
	 end}
in
   {Pattern.percentTrue_Range Bs 20 50}
end

/** %% Non-dotted note may overlap barline only exactly at its halve and dotted note "before" its dot.
%% */
%% BUG: this constraint seems to be more strict than necessary -- it seems to exclude solutions! 
%% TODO: this constraint defines very many variables and constraints -- per note! Try to reduce...
%% IDEA: instead use delayed constraint application until you know which notes are overlapping the barline. if 1 == {UniMeasures overlapsBarlineR($ {MyNote getStartTime($)} {MyNote getEndTime($)})}
proc {TreatNoteOverlappingBarline MyNote UniMeasures}
   IsDotted
   Aux = {FD.decl}
   HalveDur = {FD.decl}
   TripleDur = {FD.decl}
   OnMeasureStartIfNotDotted = {FD.decl}
   OnMeasureStartIfDotted = {FD.decl}
   DoesOverlapBarline = {UniMeasures overlapsBarlineR($ {MyNote getStartTime($)}
						      {MyNote getEndTime($)})}
in
   {FD.modI {MyNote getDuration($)} 3 Aux}
   IsDotted = (Aux =: 0)
   HalveDur = {FD.divI {MyNote getDuration($)} 2}
   TripleDur = {FD.divI {MyNote getDuration($)} 3}
   OnMeasureStartIfNotDotted =: {MyNote getStartTime($)} + HalveDur
   OnMeasureStartIfDotted =: {MyNote getStartTime($)} + TripleDur + TripleDur
   {FD.impl {FD.conj DoesOverlapBarline IsDotted}
    {UniMeasures onMeasureStartR($ OnMeasureStartIfDotted)}
    1}
   {FD.impl {FD.conj DoesOverlapBarline {FD.nega IsDotted}}
    {UniMeasures onMeasureStartR($ OnMeasureStartIfNotDotted)}
    1}
end

/** %% The last note of MyVoice ends with the bar.
%% */
proc {EndOnBarline MyVoice UniMeasures}
   {UniMeasures onMeasureStartR(1 {{List.last {MyVoice getItems($)}} getEndTime($)})}
end

/** %% Restrict duration sequence of MyVoice to style-typical rhythmic cells. In particular, the use of dotted notes and quarters is restricted this way.
%% NOTE: For Pattern.useMotifs use left-to-right variable ordering! 
%% */
%% TODO: rule: Quarter notes only stepwise in one direction (?)
%% TODO: ?? more or other rhythmic cells?
%%
%% NOTE: TMP editing to avoid that some motif instances are the beginning of another motif
%% TODO: either add some parameter to each notes to which Pattern.useMotifs indices are bound and distributed before durations, or instead use only duration motifs which are not "part of the beginning of another duration motif" (see Pattern.useMotifs doc)
proc {UseRhythmicCells MyVoice}
   {Pattern.useMotifs {MyVoice mapItems($ getDuration)}
    [[Breve]
     [Whole Whole]		% tmp edit because of Pattern.useMotifs bug
     [Halve]
     [DottedWhole Halve]
     [Whole Quarter Quarter]
     [DottedHalve Quarter Halve] % tmp edit
     [DottedHalve Quarter Quarter Quarter]]
    unit(workOutEven:true)}
end
% proc {UseRhythmicCells MyVoice}
%    {Pattern.useMotifs {MyVoice mapItems($ getDuration)}
%     [[Breve]
%      [Whole]
%      [Halve]
%      [DottedWhole Halve]
%      [Whole Quarter Quarter]
%      [DottedHalve Quarter]
%      [DottedHalve Quarter Quarter Quarter]]
%     unit(workOutEven:true)}
% end

/** %% [too strict, but better this rule than nothing] MyNote must note start with the measure if its duration is a quarter or shorter.
%% */
proc {NoQuarterStartsOnBar MyNote UniMeasures}
   {FD.impl ({MyNote getDuration($)} =<: Quarter)
    {FD.nega {UniMeasures onMeasureStartR($ {MyNote getStartTime($)})}}
    1}
end


/** %% All pitches in MyVoice are either diatonic scale pitches, or a raised 1st, 4th or 5th scale degree (scale is major). In case of a raised pitch, it must be preceeded and followed by the diatonic semitone above (i.e. 1#->2, 4#->5 5#->6).
%% NOTE: this rule is too strict for real Josquin, but is clear tendency (e.g., there might be some ornamentation before raised leading tone returns to the mode's root)
%% The total number of raised pitches is restricted (up to 5% in total). 
%% */
%% NOTE: this constraint is seemingly computationally expensive: combining it only with implicit scale degree note constraints results in almost 50% failed nodes. However, adding other melodic constraints does not necessarily make things worse..
%% TODO: leading tones primarily at the end of a phrase
%% TODO: there should be no [querstand] in close notes (nor in other voices)
%% TODO: same and different voices must note use close different leading tones 
proc {ResolvedAccidentals MyVoice}
   Notes = {MyVoice getItems($)}
   /** %% N1 is a semintone above N2 and is a diatonic pitch
   %% */
   proc {IsSemitoneAbove N1 N2 B}
      B = {FD.conj
	   ({N2 getScaleAccidental($)} =: {ET12.acc ''})
	   ({N2 getPitch($)} - {N1 getPitch($)} =: 1)}
   end
in
   {Pattern.forNeighbours Notes 3
    proc {$ [N1 N2 N3]}
       {FD.impl ({N2 getScaleAccidental($)} =: {ET12.acc '#'})
	{FD.conj
	 {FS.reified.include {N2 getScaleDegree($)} {FS.value.make [1 4 5]}}
	 {FD.conj {IsSemitoneAbove N2 N1}
	  {IsSemitoneAbove N2 N3}}}
	1}    
    end}
   %% first and last note always diatonic
   {Notes.1 getScaleAccidental($)} = {ET12.acc ''}
   {{List.last Notes} getScaleAccidental($)} = {ET12.acc ''}
   %%
   {Pattern.percentTrue_Range {Map Notes
			       fun {$ N} {N getScaleAccidental($)} =: {ET12.acc '#'} end}
    0 5}
end

% %% MIDI pitch domain reduction: only 'white keys' (c major)
% proc {InCMajor Note}
%    PitchClass = {FD.modI {Note getPitch($)} 12}
% in
%    {List.forAll [1 3 6 8 10]	% list of 'black key' pitch classes (c=0)
%     proc {$ BlackKey} PitchClass \=: BlackKey end}
% end

proc {StartAndEndWithFundamental Note}
   C = {Note getTemporalAspect($)}
in
   if {Note isFirstItem($ C)} orelse
      {Note isLastItem($ C)}
   then
      {Note getPitch($)} = 60
   end
end
% %% voice leading: only intervals up to a fifth, no pitch repetition
% %% (context dependent constraint -- getPredecessor -- but this
% %% context is predetermined by predetermined hierarchic structure)
% proc {NoBigJump Note}
%    C = {Note getTemporalAspect($)}
% in
%    if {Note hasPredecessor($ C)}
%    then
%       Pitch1 = {{Note getPredecessor($ C)} getPitch($)}
%       Pitch2 = {Note getPitch($)}
%    in
%       %% all intervals between minor second and minor third are allowed
%       {FD.distance Pitch1 Pitch2 '>:' 0}
%       {FD.distance Pitch1 Pitch2 '<:' 4}
%    end
% end

/** %% Melodic rule: 
%% */
proc {BallisticMelody MyVoice}
   proc {BallisticUp [Int1 Dir1] [Int2 Dir2]}
      %% Ascending intervals >= min third: either next interval is ascending but smaller, or next interval is descending
      {FD.impl {FD.conj
		 (Int1 >=: 3)
		 (Dir1 =: {Pattern.symbolToDirection '+'})}
	{FD.disj {FD.conj
		  (Dir1 =: Dir2)
		  (Int1 >: Int2)}
	 (Dir1 \=: Dir2)}
	1}
   end
   proc {BallisticDown [Int1 Dir1] [Int2 Dir2]}
      %% Descending intervals >= min third: either next interval is descending but larger, or next interval is ascending
      {FD.impl {FD.conj
		 (Int1 >=: 3)
		 (Dir1 =: {Pattern.symbolToDirection '-'})}
	{FD.disj {FD.conj
		  (Dir1 =: Dir2)
		  (Int1 <: Int2)}
	 (Dir1 \=: Dir2)}
	1}
   end
   proc {OppositeDirectionForLargeIntervals Dir1 [Int2 Dir2] Dir3}
      %% de la Motte, p. 69ff: movement in opposite direction before and after octave and sixth, and mostly also for fifth and fourth. My simplification: opposite direction before and after intervals > fifth.
      {FD.impl (Int2 >=: 7)
       {FD.conj (Dir1 \=: Dir2) (Dir2 \=: Dir3)}
       1}
   end
   proc {OppositeDirectionForLargeIntervals_1st [Int1 Dir1] Dir2}
      %% variant for first note
      {FD.impl (Int1 >=: 7)
       (Dir1 \=: Dir2) 
       1}
   end
   Pitches = {MyVoice mapItems($ getPitch)}
   %% NOTE: efficiency: interval variable accessed multiple times!! 
   Intervals = {Pattern.map2Neighbours Pitches GetInterval}
   Directions = {Pattern.map2Neighbours Pitches Pattern.direction}
   I1 = Intervals.1
   D1 = Directions.1
   I2 = Intervals.2.1
   D2 = Directions.2.1
in
   {Pattern.forNeighbours {LUtils.matTrans [Intervals Directions]} 3
    proc {$ [[Int1 Dir1] [Int2 Dir2] [Int3 Dir3]]}
       {OppositeDirectionForLargeIntervals Dir1 [Int2 Dir2] Dir3}
       {BallisticUp [Int2 Dir2] [Int3 Dir3]}
       {BallisticDown [Int2 Dir2] [Int3 Dir3]}
    end}
   %% treat skips between first three notes extra
   {OppositeDirectionForLargeIntervals_1st [I1 D1] D2}
   {BallisticUp [I1 D1] [I2 D2]}
   {BallisticDown [I1 D1] [I2 D2]}
end


/** %%
%% Simplification: no note repetitions permitted (this restriction related to RestrictIntervalsBetweenMelodicPeaks)
%% */
proc {RestrictMelodicIntervals MyVoice}
   /** %% Only intervals up to a 5th and octave up, no tritone. (min 6th and octave down are seldom and not supported here) 
   %% */
   proc {AllowedIntervals [X Dir]}
      X = {FD.int [1 2 3 4 5 7 12]} % [0 1 2 3 4 5 7 12]
      %% Octave only upwards
      {FD.impl (X =: 12)
       (Dir =: {Pattern.symbolToDirection '+'})
       1}
   end
   %% only 0-15% of the intervals are skips, 0-5% are note repetitions 
   proc {PreferSteps Ints}
      %% Note: if I enforce a minimum number of skips (e.g. 5 %), then CSP fails for small note number (i.e. everything for which max percent is < 1 note) 
      {Pattern.percentTrue_Range {Map Ints fun {$ X} X >: 2 end}
       0 15}
      {Pattern.percentTrue_Range {Map Ints fun {$ X} X =: 0 end}
       0 5}
   end
   Pitches = {MyVoice mapItems($ getPitch)}
   %% NOTE: efficiency: interval variable accessed multiple times!! 
   Intervals = {Pattern.map2Neighbours Pitches GetInterval}
   Directions = {Pattern.map2Neighbours Pitches Pattern.direction}
in
   {ForAll {LUtils.matTrans [Intervals Directions]}
    AllowedIntervals}
   {PreferSteps Intervals}
end

/** %% The interval between local pitch maxima should be a major second at most. 
%% */
%% NOTE: this rule only works for left-to-right variable ordering
%% NOTE: this rule is probably too strict, I need something more soft -- how?
%% Can I return 0/1 int for each local max interval which is =< major second -- then I could constrain that list with Pattern.percentTrue_Range
%% NOTE: repetition of melodic peak should be unlikely? Josquin does that all the time..
proc {RestrictIntervalsBetweenMelodicPeaks MyVoice}
   fun {IsLocalMax N2}
      P1 = {{N2 getTemporalPredecessor($)} getPitch($)}
      P2 = {N2 getPitch($)}
      P3 = {{N2 getTemporalSuccessor($)} getPitch($)}
   in
      {Pattern.localMaxR P1 P2 P3} == 1
   end
in
   {Pattern.forTail {Reverse {MyVoice getItems($)}}
    proc {$ Ns}
       %% process reversed list of notes in MyVoice, skip for less then 3 notes
       case Ns of N3 | N2 | N1 | Prevs then 
	  %% delayed constraint application for simplicity and to reduce number of propagators
	  thread 
	     if {IsLocalMax N2} andthen {Length Prevs} >= 2
	     then 
		%% Preceeding notes are already determined, therefore I can just use Find.
		%% Don't check last of Prevs -- has no predecessor
		PreceedingLocalMax = {LUtils.find {LUtils.butLast Prevs} IsLocalMax}
	     in
		if PreceedingLocalMax \= nil then 
		   %% max major 2nd distance
		   {FD.distance {N2 getPitch($)} {PreceedingLocalMax getPitch($)} '=<:' 2}
		end
	     end
	  end
       else skip
       end
    end}
end

proc {MaxAndMinPitchOnlyOnce Voice}
   proc {Aux Pitches}
      Max = {Pattern.max Pitches}
      Min = {Pattern.min Pitches}
   in
      %% the max/min pitch value occurs exactly once
      {FD.sum {Map Pitches
	       proc {$ X B}
		  B = (X =: Max)
	       end}
       '=:' 1}
      {FD.sum {Map Pitches
	       proc {$ X B}
		  B = (X =: Min)
	       end}
       '=:' 1}
      %% the first and last pitches are not max/min
      Pitches.1 \=: Max
      {List.last Pitches} \=: Max	 
      Pitches.1 \=: Min
      {List.last Pitches} \=: Min
   end
   Pitches = {Voice map($ getPitch test:isNote)}
   FirstHalfPitches
   SecondhalfPitches
in
   {List.takeDrop Pitches ({Length Pitches} div 2)
    FirstHalfPitches SecondhalfPitches}
   %% Aux applied to whole pitch sequence, but also to first and
   %% second subpart (this is a bit arbitrary, however...)
   %% NB: inefficient nesting: 'higher-level' application only needs
   %% to constraint max values of lower level
   {Aux Pitches} {Aux FirstHalfPitches} {Aux SecondhalfPitches} 
end



proc {ConstraintDissonance Voice1 Voice2}
   FirstVoiceNotes = {Voice1 getItems($)}
   SecondVoiceNotes = {Voice2 getItems($)}
in
   {List.forAllInd FirstVoiceNotes
    proc {$ I Note1}
       {List.forAllInd SecondVoiceNotes
	proc {$ J Note2}
	   IsSimultaneous = {Note1 isSimultaneousItemR($ Note2)}
	   IsConsonant = {IsConsonanceR Note1 Note2}
	in
	   %% for all notes with pre- and successor
	   if {Note1 hasPredecessor($ {Note1 getTemporalAspect($)})} andthen
	      {Note1 hasSuccessor($ {Note1 getTemporalAspect($)})} andthen
	      {Note2 hasPredecessor($ {Note2 getTemporalAspect($)})} andthen
	      {Note2 hasSuccessor($ {Note2 getTemporalAspect($)})}
	      %% if not passing note then consonant  
	   then 
	      {FD.impl IsSimultaneous
	       {Pattern.disjAll
		%% note1 is passing note, simultaneous note2 started
		%% more early, and note2 is consonant to predecessor of
		%% note1 (or the other way round)
		[{Pattern.conjAll
		  [{IsPassingNoteR Note1}
		   ({Note1 getStartTime($)} >: {Note2 getStartTime($)})
		   {IsConsonanceR {Note1 getTemporalPredecessor($)} Note2}]}
		 {Pattern.conjAll
		  [{IsPassingNoteR Note2}
		   ({Note2 getStartTime($)} >: {Note1 getStartTime($)})
		   {IsConsonanceR {Note2 getTemporalPredecessor($)} Note1}]}
		 IsConsonant]}
	       1}
	   else 
	      {FD.impl IsSimultaneous IsConsonant 1}
	   end
	end}
    end}
end
%%
proc {IsConsonanceR Note1 Note2 B}
   Pitch1 = {Note1 getPitch($)}
   Pitch2 = {Note2 getPitch($)}
   Consonances = {FS.value.make [0 3 4 7 8 9 12 15 16]}
      %Consonances = {FS.value.make [0 3 4 7 8 9 15 16]}	% alternative: no octave
   Interval = {FD.decl}
in   
   {FD.distance Pitch1 Pitch2 '=:' Interval}
   {FS.reified.include Interval Consonances B}
end
proc {IsPassingNoteR Note2 B}
   Pitch1 = {{Note2 getPredecessor($ {Note2 getTemporalAspect($)})}
	     getPitch($)}
   Pitch2 = {Note2 getPitch($)}
   Pitch3 = {{Note2 getSuccessor($ {Note2 getTemporalAspect($)})}
	     getPitch($)}
   proc {IsStepR Pitch1 Pitch2 B}
      {FD.disj
       %% ?? FD.reified.distance has problems? -- I use it elsewhere here...
       {FD.conj (Pitch1 - Pitch2 >: 0) (Pitch1 - Pitch2 =<: 2)}
       {FD.conj (Pitch2 - Pitch1 >: 0)(Pitch2 - Pitch1 =<: 2)}
       B}
   end
   proc {IsContinuousDirection Pitch1 Pitch2 Pitch3 B}
      %% all pitches either lead up or down
      B = {FD.disj
	   {FD.conj (Pitch1<:Pitch2) (Pitch2<:Pitch3)}
	   {FD.conj (Pitch1>:Pitch2) (Pitch2>:Pitch3)}}
   end
in
   {Pattern.conjAll    
    %% unused: Note2 is on an easy beat (startTime is odd)
    [%% all intervals between successive pitches must be steps in same direction
     {IsStepR Pitch1 Pitch2}
     {IsStepR Pitch2 Pitch3}
     {IsContinuousDirection Pitch1 Pitch2 Pitch3}]
    B}
end
%% two notes starting at the same time (ie. simultaneous),
%% interval is perfect consonance and interval between
%% predecessors has also been that very perfect consonance
proc {OpenParallelsR Note1 Note2 B}
   %% only two voices, i.e. only one simultaneous note
        %Note2 = {Note1 getSimultaneousItems($ test:isNote)}.1
   Pitch1 = {Note1 getPitch($)}
   Pitch2 = {Note2 getPitch($)}
   PrePitch1 = {{Note1 getPredecessor($ {Note1 getTemporalAspect($)})} getPitch($)}
   PrePitch2 = {{Note2 getPredecessor($ {Note2 getTemporalAspect($)})} getPitch($)}
   %% Do note1 and note2 start at the same time?
   B1 = ({Note1 getStartTime($)} =: {Note2 getStartTime($)})
   %% Is pitch1 and pitch2 interval fifth?
   B2 = {FD.reified.distance Pitch1 Pitch2 '=:' 7}
   %% Is pitch1 predecessor and pitch2 predecessor interval fifth?
   B3 = {FD.reified.distance PrePitch1 PrePitch2 '=:' 7}
   B4 = {FD.reified.distance Pitch1 Pitch2 '=:' 0}
   B5 = {FD.reified.distance PrePitch1 PrePitch2 '=:' 0}
   B6 = {FD.reified.distance Pitch1 Pitch2 '=:' 12}
   B7 = {FD.reified.distance PrePitch1 PrePitch2 '=:' 12}
in
   %% Conjunction of all three truth values must be false
   {FD.conj B1
    {FD.disj
     {FD.conj B2 B3}
     {FD.disj
      {FD.conj B4 B5}
      {FD.conj B6 B7}}}
    B}
end
proc {NoParallels Voice1 Voice2}
   FirstVoiceNotes = {Voice1 getItems($)}
   SecondVoiceNotes = {Voice2 getItems($)}
in
   {List.forAllInd FirstVoiceNotes
    proc {$ I Note1}
       {List.forAllInd SecondVoiceNotes
	proc {$ J Note2}
	   if {Note1 hasPredecessor($ {Note1 getTemporalAspect($)})} andthen
	      {Note2 hasPredecessor($ {Note2 getTemporalAspect($)})}
	   then {OpenParallelsR Note1 Note2 0}
	   end
	end}
    end}
end
proc {IsCanon Voice1 Voice2}
   %% The first CanonNo notes of each voice form a canon in a fifth
   CanonNo = 10
in
   for
      Note1 in {List.take {Voice1 getItems($)} CanonNo}
      Note2 in {List.take {Voice2 getItems($)} CanonNo}
   do
      {Note1 getPitch($)} + 7 =: {Note2 getPitch($)}
      {Note1 getDuration($)} =: {Note2 getDuration($)}
   end
end


%%
%% Aux defs
%%

/** %% Returns absolute distance between P1 and P2. The interval variable is implicitly declared. 
%% */
proc {GetInterval P1 P2 ?Interval}
   Interval = {FD.decl}
   Interval = {FD.distance P1 P2 '=:'}
end


%%
%% Call solver (A few different distribution strategies are proposed
%% to solve this CSP).
%%

/*

{Init.setTempo 100.0}

%% This special score distribution strategy takes about 4 secs on my machine (Pentium 4, 3.2 GHz machine with 512 MB RAM running Mozart 1.3.1 on Fedora Core 3) to find a solution
%% (slighly less than 2 secs without rule MaxAndMinPitchOnlyOnce).
{SDistro.exploreOne Canon
 unit(order:startTime
      value:mid)}


%% For full CSP, this standard distribution strategy (i.e. no special
%% score search) finds NO solution within 1 h of search! (about 14
%% secs without MaxAndMinPitchOnlyOnce)
{SDistro.exploreOne Canon
 unit(order:size
      value:mid)}

%% change random seed
{GUtils.setRandomGeneratorSeed 0}
%% Randomised solution
{SDistro.exploreOne Canon
 unit(order:startTime
      value:random)}




%% change random seed
{GUtils.setRandomGeneratorSeed 0}
%% Do test case
{SDistro.exploreOne {GUtils.extendedScriptToScript RhythmicVoice
		     unit(beatNumber:3)}
 unit(order:startTime
      value:random)}




%% change random seed
{GUtils.setRandomGeneratorSeed 0}
%% Do test case
{SDistro.exploreOne {GUtils.extendedScriptToScript PitchVoice
		     unit}
 unit(order:startTime
      value:random)}


*/