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

[lilypond.git] / scm / part-combiner.scm

diff --git a/scm/part-combiner.scm b/scm/part-combiner.scm
index dadce948634ccae8db3a4eef0d17e4fd7828bbf3..e4ca227e2d46adc0d06e91d43c020d85fe36fd64 100644 (file)
--- a/scm/part-combiner.scm
+++ b/scm/part-combiner.scm
@@ -1,6 +1,6 @@
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;; Copyright (C) 2004--2012 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; Copyright (C) 2004--2014 Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -198,6 +198,13 @@ Voice-state objects
 
   (helper 0 '()))
 
+(define recording-group-functions
+  ;;Selected parts from @var{toplevel-music-functions} not requiring @code{parser}.
+  (list
+   (lambda (music) (expand-repeat-chords! '(rhythmic-event) music))
+   expand-repeat-notes!))
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define-public (recording-group-emulate music odef)
   "Interpret @var{music} according to @var{odef}, but store all events
@@ -240,10 +247,13 @@ LilyPond version 2.8 and earlier."
     (ly:add-listener new-context-listener
                      (ly:context-events-below global) 'AnnounceNewContext)
     (ly:add-listener mom-listener (ly:context-event-source global) 'Prepare)
-    (ly:interpret-music-expression (make-non-relative-music music) global)
+    (ly:interpret-music-expression
+     (make-non-relative-music
+      (fold (lambda (x m) (x m)) music recording-group-functions))
+     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")))
@@ -256,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
@@ -275,9 +287,9 @@ LilyPond version 2.8 and earlier."
     (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))
+        (and (ly:in-event-class? x 'part-combine-force-event)
+             (cons (ly:event-property x 'forced-type)
+                   (ly:event-property x 'once))))
       (define (part-combine-events vs)
         (if (not vs)
             '()
@@ -338,7 +350,7 @@ Only set if not set previously.
                  (prev (configuration prev-ss)))
             (if (symbol? prev)
                 (put prev))))
-        (map copy-one-state (span-state vs)))
+        (for-each copy-one-state (span-state vs)))
 
       (define (analyse-notes now-state)
         (let* ((vs1 (car (voice-states now-state)))
@@ -368,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