Issue 4112: Add internal chord-range option to part combiner

Add a number-pair parameter to make-part-combine-music to replace the
previously hard-coded minimum and maximum intervals that may be
combined into a chord or unison in the shared voice.

There is no user interface for this enhancement because it is not easy
to agree on one, but there is a regression test showing how it might
be used at one's own risk.

diff --git a/input/regression/part-combine-chord-range.ly b/input/regression/part-combine-chord-range.ly
new file mode 100644 (file)
index 0000000..146b31c
--- /dev/null
+++ b/input/regression/part-combine-chord-range.ly
@@ -0,0 +1,27 @@
+\header {
+  texidoc ="The part combiner has an internal option to set the range
+of intervals that may be combined into chords."
+}
+
+\version "2.19.16"
+
+\layout { ragged-right = ##t }
+
+vone = \relative e' {
+  d4 e f fisis | g geses b' bisis | b2 beses
+}
+
+vtwo = \relative e' {
+  e4 e e e | e eisis d deses | c2 cisis
+}
+
+customcombine =
+#(define-music-function (parser location part1 part2) (ly:music? ly:music?)
+   (make-part-combine-music parser (list part1 part2) #f '(2 . 12)))
+
+comm = { s1_"apart" s1_"chords" s1_"apart" }
+
+\new Staff <<
+  \customcombine \vone \vtwo
+  \comm
+>>

diff --git a/ly/music-functions-init.ly b/ly/music-functions-init.ly
index 6bb98c6c801f3c024eb3fce3c43755fd7376e5ab..daf2b93a6ff804443365b0a2b4e6c57cfe60da7f 100644 (file)
--- a/ly/music-functions-init.ly
+++ b/ly/music-functions-init.ly
@@ -1131,26 +1131,28 @@ parenthesize =
        (set! (ly:music-property arg 'parenthesize) #t))
    arg)
 
+#(define partcombine-chord-range '(0 . 8))
+
 partcombine =
 #(define-music-function (parser location part1 part2) (ly:music? ly:music?)
    (_i "Take the music in @var{part1} and @var{part2} and typeset so
 that they share a staff.")
    (make-part-combine-music parser
-                            (list part1 part2) #f))
+                            (list part1 part2) #f partcombine-chord-range))
 
 partcombineUp =
 #(define-music-function (parser location part1 part2) (ly:music? ly:music?)
    (_i "Take the music in @var{part1} and @var{part2} and typeset so
 that they share a staff with stems directed upward.")
    (make-part-combine-music parser
-                            (list part1 part2) UP))
+                            (list part1 part2) UP partcombine-chord-range))
 
 partcombineDown =
 #(define-music-function (parser location part1 part2) (ly:music? ly:music?)
    (_i "Take the music in @var{part1} and @var{part2} and typeset so
 that they share a staff with stems directed downward.")
    (make-part-combine-music parser
-                            (list part1 part2) DOWN))
+                            (list part1 part2) DOWN partcombine-chord-range))
 
 partcombineForce =
 #(define-music-function (location parser type once) (symbol-or-boolean? boolean?)

diff --git a/scm/part-combiner.scm b/scm/part-combiner.scm
index dd3152cbb7125bfd025e2a85cefdd95f4fa73b5f..e4ca227e2d46adc0d06e91d43c020d85fe36fd64 100644 (file)
--- a/scm/part-combiner.scm
+++ b/scm/part-combiner.scm
@@ -253,7 +253,7 @@ LilyPond version 2.8 and earlier."
      global)
     context-list))
 
-(define-public (make-part-combine-music parser music-list direction)
+(define-public (make-part-combine-music parser music-list direction chord-range)
   (let* ((m (make-music 'PartCombineMusic))
          (m1 (make-non-relative-music (context-spec-music (first music-list) 'Voice "one")))
          (m2  (make-non-relative-music  (context-spec-music (second music-list) 'Voice "two")))
@@ -266,17 +266,19 @@ LilyPond version 2.8 and earlier."
     (set! (ly:music-property m 'split-list)
           (if (and (assoc "one" evs1) (assoc "two" evs2))
               (determine-split-list (reverse! (assoc-get "one" evs1) '())
-                                    (reverse! (assoc-get "two" evs2) '()))
+                                    (reverse! (assoc-get "two" evs2) '())
+                                    chord-range)
               '()))
     m))
 
-(define-public (determine-split-list evl1 evl2)
-  "@var{evl1} and @var{evl2} should be ascending."
+(define-public (determine-split-list evl1 evl2 chord-range)
+  "@var{evl1} and @var{evl2} should be ascending. @var{chord-range} is a pair of numbers (min . max) defining the distance in steps between notes that may be combined into a chord or unison."
   (let* ((pc-debug #f)
-         (chord-threshold 8)
          (voice-state-vec1 (make-voice-states evl1))
          (voice-state-vec2 (make-voice-states evl2))
-         (result (make-split-state voice-state-vec1 voice-state-vec2)))
+         (result (make-split-state voice-state-vec1 voice-state-vec2))
+         (chord-min-diff (car chord-range))
+         (chord-max-diff (cdr chord-range)))
 
     ;; Go through all moments recursively and check if the events of that
     ;; moment contain a part-combine-force-event override. If so, store its
@@ -378,15 +380,13 @@ Only set if not set previously.
                  (if (and (= (length pitches1) (length pitches2)))
                      (if (and (pair? pitches1)
                               (pair? pitches2)
-                              (or
-                               (< chord-threshold (ly:pitch-steps
-                                                   (ly:pitch-diff (car pitches1)
-                                                                  (car pitches2))))
-
-                               ;; voice crossings:
-                               (> 0 (ly:pitch-steps (ly:pitch-diff (car pitches1)
-                                                                   (car pitches2))))
-                               ))
+                              ; Is the interval outside of chord-range?
+                              (let ((diff (ly:pitch-steps
+                                           (ly:pitch-diff (car pitches1)
+                                                          (car pitches2)))))
+                                (or (< diff chord-min-diff)
+                                    (> diff chord-max-diff)
+                                    )))
                          (put 'apart)
                          ;; copy previous split state from spanner state
                          (begin