X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fpart-combiner.scm;h=58f7b303a8620ac63279d571aa577b3a8698828b;hb=47db9a3883d726ca53e2133a3b2298f78dd6a32e;hp=dd3152cbb7125bfd025e2a85cefdd95f4fa73b5f;hpb=82bc9ad690e201aaa55694f8b92261ae7338f56a;p=lilypond.git diff --git a/scm/part-combiner.scm b/scm/part-combiner.scm index dd3152cbb7..58f7b303a8 100644 --- 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--2014 Han-Wen Nienhuys +;;;; Copyright (C) 2004--2015 Han-Wen Nienhuys ;;;; ;;;; LilyPond is free software: you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -44,6 +44,12 @@ (ly:in-event-class? x 'note-event)) (filter f? (events vs))) +(define-method (rest-and-skip-events (vs )) + (define (f? x) + (or (ly:in-event-class? x 'rest-event) + (ly:in-event-class? x 'skip-event))) + (filter f? (events vs))) + (define-method (previous-voice-state (vs )) (let ((i (slot-ref vs 'vector-index)) (v (slot-ref vs 'state-vector))) @@ -253,7 +259,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 +272,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 @@ -311,9 +319,11 @@ LilyPond version 2.8 and earlier." (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)) + (evts (if (synced? now-state) + (append + (part-combine-events (car (voice-states now-state))) + (part-combine-events (cdr (voice-states now-state)))) + '())) ;; result is (once-state permament-state): (state (fold forced-result (cons 'automatic prev-res) evts)) ;; Now let once override permanent changes: @@ -378,15 +388,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 @@ -432,18 +440,64 @@ Only set if not set previously. (let* ((now-state (vector-ref result result-idx)) (vs1 (car (voice-states now-state))) (vs2 (cdr (voice-states now-state)))) - (if (and (equal? (configuration now-state) 'chords) - vs1 vs2) - (let ((notes1 (note-events vs1)) - (notes2 (note-events vs2))) - (cond ((and (= 1 (length notes1)) + + (define (analyse-silence) + (let ((rests1 (if vs1 (rest-and-skip-events vs1) '())) + (rests2 (if vs2 (rest-and-skip-events vs2) '()))) + (cond + + ;; multi-measure rests (probably), which the + ;; part-combine iterator handles well + ((and (synced? now-state) + (= 0 (length rests1)) + (= 0 (length rests2))) + (set! (configuration now-state) 'unisilence)) + + ;; equal rests or equal skips, but not one of each + ((and (synced? now-state) + (= 1 (length rests1)) + (= 1 (length rests2)) + (equal? (ly:event-property (car rests1) 'class) + (ly:event-property (car rests2) 'class)) + (equal? (ly:event-property (car rests1) 'duration) + (ly:event-property (car rests2) 'duration))) + (set! (configuration now-state) 'unisilence)) + + ;; rests of different durations or mixed with + ;; skips or multi-measure rests + ((synced? now-state) + ;; TODO When one part has a rest and the other has a + ;; multi-measure rest, tell the part-combine + ;; iterator to route the part with the rest to the + ;; shared voice. Until there is a way to do this, + ;; we print them both; it does not look very good, + ;; but failing to print the rest is misleading. + ;; + ;; Maybe do something similar for skips; route + ;; the rest to the shared voice and the skip to + ;; the voice for its part. + (set! (configuration now-state) 'apart-silence)) + + ;; TODO At a multi-measure rest, return to unisilence + ;; even after having been apart. The results are not + ;; good now because of the deficiency mentioned + ;; above. + ))) + + (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? + (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))) (set! (configuration now-state) 'unisono)) ((and (= 0 (length notes1)) (= 0 (length notes2))) - (set! (configuration now-state) 'unisilence))))) + (analyse-silence))))) (analyse-a2 (1+ result-idx))))) (define (analyse-solo12 result-idx)