From: Reinhold Kainhofer <reinhold@kainhofer.com>
Date: Wed, 28 Jul 2010 17:58:59 +0000 (+0200)
Subject: Part-combine: Add a way to override the part-combination decision
X-Git-Tag: release/2.13.35-1~9
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=3a8ec248ca3bd6bd04490f386949a95a4140338d;p=lilypond.git

Part-combine: Add a way to override the part-combination decision

Add functions partcombineApart[Once], partcombineChords[Once],
partcombineUnisono[Once], partcombineAutomatic[Once] etc. to tweak the
decision of the part-combiner.
Internally, they are implemented using PartCombineForceEvent

These events are not processed by an engraver as most other events,
but rather directly in Scheme by the part-combiner.
---

diff --git a/Documentation/changes.tely b/Documentation/changes.tely
index c6e1bb4790..f754c5111f 100644
--- a/Documentation/changes.tely
+++ b/Documentation/changes.tely
@@ -66,6 +66,14 @@ which scares away people.
 
 @end ignore
 
+@item
+The part-combiner's decision to combine/not combine notes can now be customized
+@lilypond[quote,relative=2]
+\partcombine
+\relative c' { c2 \partcombineApart c | \partcombineChordsOnce e' e }
+\relative c' { c2 \partcombineApart c | c c }
+@end lilypond
+
 @item
 Tablature staves show fret numbers only by default. To get the
 former style, @code{\tabFullNotation} is provided.
diff --git a/input/regression/part-combine-force-once.ly b/input/regression/part-combine-force-once.ly
new file mode 100644
index 0000000000..b2b30dce0e
--- /dev/null
+++ b/input/regression/part-combine-force-once.ly
@@ -0,0 +1,30 @@
+
+\header {
+  texidoc ="Overrides for the part-combiner, affecting only one moment.
+  The @code{partcombine...Once} override applies only to one moment, after which the
+  old override -- if any -- is in effect again.
+"
+}
+
+\layout { ragged-right = ##t }
+
+\version "2.13.35"
+
+mI = \relative c' {
+	e4 e \partcombineApartOnce c c |
+	\partcombineApart c \partcombineChordsOnce e e e |
+	c \partcombineUnisonoOnce c c c |
+	\partcombineAutomatic \partcombineSoloIOnce r2 c4 c |
+	\partcombineSoloIIOnce R1 |
+}
+mII = \relative c' {
+	c4 \partcombineApartOnce c c c |
+	c c \partcombineAutomaticOnce e e |
+	c c c c |
+	R1 |
+	r2 c4 c |
+}
+
+\score {
+	\new Staff \partcombine \mI \mII
+}
diff --git a/input/regression/part-combine-force.ly b/input/regression/part-combine-force.ly
new file mode 100644
index 0000000000..b66d1b71b5
--- /dev/null
+++ b/input/regression/part-combine-force.ly
@@ -0,0 +1,34 @@
+
+\header {
+  texidoc ="Overrides for the part-combiner. All functions like
+  @code{\partcombineApart} and @code{\partcombineApartOnce} are internally implemented
+  using a dedicated @code{PartCombineForceEvent}.
+"
+}
+
+\layout { ragged-right = ##t }
+
+\version "2.13.35"
+
+mI = \relative c' {
+	e4 e c2 |
+	\partcombineApart c^"apart" e |
+	e e |
+	\partcombineChords e'^"chord" e |
+	\partcombineAutomatic c c\> |
+	\partcombineUnisono c^"unisono" c |
+	\partcombineAutomatic c\! c^"V1 longer" |
+}
+mII = \relative c' {
+	c4 c c2 |
+	c c |
+	\partcombineAutomatic e^"auto" e |
+	a, c |
+	c c' |
+	c c |
+	c
+}
+
+\score {
+	\new Staff \partcombine \mI \mII
+}
diff --git a/ly/music-functions-init.ly b/ly/music-functions-init.ly
index 0e5093e8a5..8ac1deda01 100644
--- a/ly/music-functions-init.ly
+++ b/ly/music-functions-init.ly
@@ -599,6 +599,28 @@ that they share a staff.")
    (make-part-combine-music parser
                             (list part1 part2)))
 
+#(define (symbol-or-boolean? x) (or (symbol? x) (boolean? x)))
+partcombineForce =
+#(define-music-function (location parser type once) (symbol-or-boolean? boolean?)
+   (_i "Override the part-combiner.")
+   (make-music 'EventChord
+	       'elements (list (make-music 'PartCombineForceEvent
+					   'forced-type type
+					   'once once))))
+partcombineApart = \partcombineForce #'apart ##f
+partcombineApartOnce = \partcombineForce #'apart ##t
+partcombineChords = \partcombineForce #'chords ##f
+partcombineChordsOnce = \partcombineForce #'chords ##t
+partcombineUnisono = \partcombineForce #'unisono ##f
+partcombineUnisonoOnce = \partcombineForce #'unisono ##t
+partcombineSoloI = \partcombineForce #'solo1 ##f
+partcombineSoloIOnce = \partcombineForce #'solo1 ##t
+partcombineSoloII = \partcombineForce #'solo2 ##f
+partcombineSoloIIOnce = \partcombineForce #'solo2 ##t
+partcombineAutomatic = \partcombineForce ##f ##f
+partcombineAutomaticOnce = \partcombineForce ##f ##t
+
+
 pitchedTrill =
 #(define-music-function
    (parser location main-note secondary-note)
diff --git a/scm/define-event-classes.scm b/scm/define-event-classes.scm
index 4de8c5d97b..e1f3b4aa33 100644
--- a/scm/define-event-classes.scm
+++ b/scm/define-event-classes.scm
@@ -24,18 +24,19 @@
     (StreamEvent .
 		 (RemoveContext ChangeParent Override Revert UnsetProperty
 				SetProperty music-event OldMusicEvent CreateContext Prepare
-				OneTimeStep Finish)) 
+				OneTimeStep Finish))
     (music-event . (annotate-output-event
 		    arpeggio-event breathing-event extender-event span-event
       rhythmic-event dynamic-event break-event label-event percent-event
-      key-change-event string-number-event stroke-finger-event tie-event part-combine-event
+      key-change-event string-number-event stroke-finger-event tie-event
+      part-combine-event part-combine-force-event
       beam-forbid-event script-event
       tremolo-event bend-after-event fingering-event glissando-event
       harmonic-event hyphen-event laissez-vibrer-event mark-event
-      multi-measure-text-event note-grouping-event 
+      multi-measure-text-event note-grouping-event
       pes-or-flexa-event repeat-tie-event spacing-section-event
       layout-instruction-event completize-extender-event break-span-event))
-    
+
     (layout-instruction-event . (apply-output-event))
     (script-event . (articulation-event text-script-event))
     (part-combine-event . (solo-one-event solo-two-event unisono-event))
@@ -43,7 +44,7 @@
     (dynamic-event . (absolute-dynamic-event))
     (span-event . (span-dynamic-event beam-event episema-event ligature-event
 			 pedal-event phrasing-slur-event slur-event staff-span-event
-			 text-span-event trill-span-event tremolo-span-event 
+			 text-span-event trill-span-event tremolo-span-event
 			 tuplet-span-event))
     (span-dynamic-event . (decrescendo-event crescendo-event))
     (break-span-event . (break-dynamic-span-event))
@@ -66,7 +67,7 @@
  (lambda (rel)
    (for-each
     (lambda (type)
-      (hashq-set! ancestor-lookup type 
+      (hashq-set! ancestor-lookup type
 		  (cons type (hashq-ref ancestor-lookup (car rel) '()))))
     (cdr rel)))
  event-classes)
@@ -100,7 +101,7 @@
 (define unlistened-music-event-classes
   '(harmonic-event line-break-event page-break-event page-turn-event label-event
 		   solo-one-event solo-two-event skip-event unisono-event
-		   break-dynamic-span-event))
+		   part-combine-force-event break-dynamic-span-event))
 
 ;; produce neater representation of music event tree.
 ;; TODO: switch to this representation for the event-classes list?
@@ -124,12 +125,12 @@
 
 ;; check that the music event tree corresponds well with the set of
 ;; available translators; print warnings otherwise.
-(map-tree (lambda (sym) 
+(map-tree (lambda (sym)
 	    (if (and (symbol? sym)
 		     (not (ly:is-listened-event-class sym))
 		     (not (assq sym event-classes))
 		     (not (memq sym unlistened-music-event-classes)))
-		(ly:programming-error (_ "event class ~A seems to be unused") sym)))	  
+		(ly:programming-error (_ "event class ~A seems to be unused") sym)))
 	  music-event-tree)
 
 (map (lambda (sym)
diff --git a/scm/define-music-properties.scm b/scm/define-music-properties.scm
index d7b602afe7..23faf5644a 100644
--- a/scm/define-music-properties.scm
+++ b/scm/define-music-properties.scm
@@ -84,6 +84,7 @@ a sequential iterator.  Takes a single music parameter.")
      (figure ,integer? "A bass figure.")
      (force-accidental ,boolean? "If set, a cautionary accidental should
 always be printed on this note.")
+     (forced-type ,symbol? "Override for the part-combiner.")
 
      (grob-property ,symbol? "The symbol of the grob property to set.")
      (grob-property-path ,list? "A list of symbols, locating a nested grob
diff --git a/scm/define-music-types.scm b/scm/define-music-types.scm
index 4b446d72b7..ac2e5f9723 100644
--- a/scm/define-music-types.scm
+++ b/scm/define-music-types.scm
@@ -349,11 +349,16 @@ Syntax: @code{\\override} [ @var{context} @code{.} ]
 	(types . (general-music break-event page-turn-event event))
 	))
 
+    (PartCombineForceEvent
+     . ((description . "Override the part-combiner's strategy.")
+	(types . (general-music part-combine-force-event event))
+	))
+
     (PartialSet
      . ((description . "Create an anacrusis or upbeat (partial measure).")
 	(iterator-ctor . ,ly:partial-iterator::constructor)
 	(types . (general-music partial-set))
-	))
+        ))
 
     (PartCombineMusic
      . ((description . "Combine two parts on a staff, either merged or
diff --git a/scm/part-combiner.scm b/scm/part-combiner.scm
index ad828b85b2..2a95e2083b 100644
--- a/scm/part-combiner.scm
+++ b/scm/part-combiner.scm
@@ -54,7 +54,10 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define-class <Split-state> ()
+  ;; The automatically determined split configuration
   (configuration #:init-value '() #:accessor configuration)
+  ;; Allow overriding split configuration, takes precedence over configuration
+  (forced-configuration #:init-value #f #:accessor forced-configuration)
   (when-moment #:accessor when #:init-keyword #:when)
   ;; voice-states are states starting with the Split-state or later
   ;;
@@ -263,6 +266,56 @@ list, similar to the Recording_group_engraver in 2.8 and earlier"
 	 (voice-state-vec2 (make-voice-states evl2))
 	 (result (make-split-state voice-state-vec1 voice-state-vec2)))
 
+    ;; Go through all moments recursively and check if the events of that
+    ;; moment contain a part-combine-force-event override. If so, store its
+    ;; value in the forced-configuration field, which will override. The
+    ;; previous configuration is used to determine non-terminated settings.
+    (define (analyse-forced-combine result-idx prev-res)
+
+      (define (get-forced-event x)
+	(if (ly:in-event-class? x 'part-combine-force-event)
+	    (cons (ly:event-property x 'forced-type) (ly:event-property x 'once))
+	    #f))
+      (define (part-combine-events vs)
+	(if (not vs)
+	    '()
+	    (filter-map get-forced-event (events vs))))
+      ;; end part-combine-events
+
+      ;; forced-result: Take the previous config and analyse whether
+      ;; any change happened.... Return new once and permanent config
+      (define (forced-result evt state)
+	;; sanity check, evt should always be (new-state . once)
+	(if (not (and (pair? evt) (pair? state)))
+	    state
+	    (if (cdr evt)
+		;; Once-event, leave permanent state unchanged
+		(cons (car evt) (cdr state))
+		;; permanent change, leave once state unchanged
+		(cons (car state) (car evt)))))
+      ;; end forced-combine-result
+
+      ;; body of analyse-forced-combine:
+      (if (< result-idx (vector-length result))
+	  (let* ((now-state (vector-ref result result-idx)) ; current result
+		 ;; Extract all part-combine force events
+		 (ev1 (part-combine-events (car (voice-states now-state))))
+		 (ev2 (part-combine-events (cdr (voice-states now-state))))
+		 (evts (append ev1 ev2))
+		 ;; result is (once-state permament-state):
+		 (state (fold forced-result (cons 'automatic prev-res) evts))
+		 ;; Now let once override permanent changes:
+		 (force-state (if (equal? (car state) 'automatic)
+				  (cdr state)
+				  (car state))))
+	    (set! (forced-configuration (vector-ref result result-idx))
+		  force-state)
+	    ;; For the next moment, ignore the once override (car stat)
+	    ;; and pass on the permanent override, stored as (cdr state)
+	    (analyse-forced-combine (1+ result-idx) (cdr state)))))
+    ;; end analyse-forced-combine
+
+
     (define (analyse-time-step result-idx)
       (define (put x . index)
 	"Put the result to X, starting from INDEX backwards.
@@ -488,14 +541,25 @@ the mark when there are no spanners active.
 	  (display "***\n")
 	  (display result)
 	  (display "***\n")))
+
+    ;; Extract all forced combine strategies, i.e. events inserted by
+    ;; \partcombine(Apart|Automatic|SoloI|SoloII|Chords)[Once]
+    ;; They will in the end override the automaically determined ones.
+    ;; Initial state for both voices is no override
+    (analyse-forced-combine 0 #f)
+    ;; Now go through all time steps in a loop and find a combination strategy
+    ;; based only on the events of that one moment (i.e. neglecting longer
+    ;; periods of solo/apart, etc.)
     (analyse-time-step 0)
     ;; (display result)
+    ;; Check for unisono or unisilence moments
     (analyse-a2 0)
     ;;(display result)
     (analyse-solo12 0)
     ;; (display result)
     (set! result (map
-		  (lambda (x) (cons (when x) (configuration x)))
+		  ;; forced-configuration overrides, if it is set
+		  (lambda (x) (cons (when x) (or (forced-configuration x) (configuration x))))
 		  (vector->list result)))
     (if #f ;; pc-debug
 	 (display result))