From 9d84914cf1ffd71cca938952968e1be3d36944bf Mon Sep 17 00:00:00 2001 From: Dan Eble Date: Sat, 7 Feb 2015 10:30:05 -0500 Subject: [PATCH] Part combiner: allow a2 chords --- input/regression/part-combine-strings.ly | 26 +++++ scm/part-combiner.scm | 117 +++++++++++++---------- 2 files changed, 92 insertions(+), 51 deletions(-) create mode 100644 input/regression/part-combine-strings.ly diff --git a/input/regression/part-combine-strings.ly b/input/regression/part-combine-strings.ly new file mode 100644 index 0000000000..2ab2c0d7e4 --- /dev/null +++ b/input/regression/part-combine-strings.ly @@ -0,0 +1,26 @@ +\version "2.19.19" +\header { + texidoc = "Test some transitions that might be found in string parts produced with \\partcombine." +} + +vone = \relative a' { a2 | r2 | r r | r2 a4 r4 | g2 r | } +vtwo = \relative a' { e2 | r2 r | r | r2 f4 r4 | g2 r | } +combined = \partcombine \vone \vtwo + +% The part combiner does not yet support all of these labels. +expectedText = \relative c' { + s2_"div." s2_"unis." | s2 s2_"solo" | s2_"solo 2" s2 | + s2 s4_\markup \column { tutti, div. } s4 | s2_"unis." s | s_"div." +} + +\layout { ragged-right = ##t } + +\new Staff \with { + aDueText = "unis." + soloText = "solo" + soloIIText = "solo 2" +} << + \set Score.skipBars = ##t + \combined + \expectedText +>> diff --git a/scm/part-combiner.scm b/scm/part-combiner.scm index ae51d0539b..8fe293e947 100644 --- a/scm/part-combiner.scm +++ b/scm/part-combiner.scm @@ -44,6 +44,25 @@ (ly:in-event-class? x 'note-event)) (filter f? (events vs))) +; Return a list of note events which is sorted and stripped of +; properties that we do not want to prevent combining parts. +(define-method (comparable-note-events (vs )) + (define (note)) (define (f? x) (or (ly:in-event-class? x 'rest-event) @@ -381,49 +400,49 @@ Only set if not set previously. (define (analyse-notes now-state) (let* ((vs1 (car (voice-states now-state))) (vs2 (cdr (voice-states now-state))) - (notes1 (note-events vs1)) - (durs1 (sort (map (lambda (x) (ly:event-property x 'duration)) - notes1) - ly:duration (length notes1) 1) (put 'apart)) - ((> (length notes2) 1) (put 'apart)) - ((= 1 (+ (length notes2) (length notes1))) (put 'apart)) - ((and (= (length durs1) 1) - (= (length durs2) 1) - (not (equal? (car durs1) (car durs2)))) - (put 'apart)) - (else - (if (and (= (length pitches1) (length pitches2))) - (if (and (pair? pitches1) - (pair? 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 - (if (previous-voice-state vs1) - (copy-state-from voice-state-vec1 - (previous-voice-state vs1))) - (if (previous-voice-state vs2) - (copy-state-from voice-state-vec2 - (previous-voice-state vs2))) - (if (and (null? (span-state vs1)) (null? (span-state vs2))) - (put 'chords))))))))) + (notes1 (comparable-note-events vs1)) + (notes2 (comparable-note-events vs2))) + (cond + ;; if neither part has notes, do nothing + ((and (not (pair? notes1)) (not (pair? notes2)))) + + ;; if one part has notes and the other does not + ((or (not (pair? notes1)) (not (pair? notes2))) (put 'apart)) + + ;; if either part has a chord + ((or (> (length notes1) 1) + (> (length notes2) 1)) + (if (and (<= chord-min-diff 0) ; user requests combined unisons + (equal? notes1 notes2)) ; both parts have the same chord + (put 'chords) + (put 'apart))) + + ;; if the durations are different + ;; TODO articulations too? + ((and (not (equal? (ly:event-property (car notes1) 'duration) + (ly:event-property (car notes2) 'duration)))) + (put 'apart)) + + (else + ;; Is the interval outside of chord-range? + (if (let ((diff (ly:pitch-steps + (ly:pitch-diff + (ly:event-property (car notes1) 'pitch) + (ly:event-property (car notes2) 'pitch))))) + (or (< diff chord-min-diff) + (> diff chord-max-diff) + )) + (put 'apart) + ;; copy previous split state from spanner state + (begin + (if (previous-voice-state vs1) + (copy-state-from voice-state-vec1 + (previous-voice-state vs1))) + (if (previous-voice-state vs2) + (copy-state-from voice-state-vec2 + (previous-voice-state vs2))) + (if (and (null? (span-state vs1)) (null? (span-state vs2))) + (put 'chords)))))))) (if (< result-idx (vector-length result)) (let* ((now-state (vector-ref result result-idx)) @@ -508,15 +527,11 @@ Only set if not set previously. ))) (if (or vs1 vs2) - (let ((notes1 (if vs1 (note-events vs1) '())) - (notes2 (if vs2 (note-events vs2) '()))) - ; Todo: What about a2 chords, e.g. string multi-stops? - ; Sort and compare notes1 and notes2? + (let ((notes1 (if vs1 (comparable-note-events vs1) '())) + (notes2 (if vs2 (comparable-note-events vs2) '()))) (cond ((and (equal? (configuration now-state) 'chords) - (= 1 (length notes1)) - (= 1 (length notes2)) - (equal? (ly:event-property (car notes1) 'pitch) - (ly:event-property (car notes2) 'pitch))) + (pair? notes1) + (equal? notes1 notes2)) (set! (configuration now-state) 'unisono)) ((synced? now-state) -- 2.39.5