X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fpart-combiner.scm;h=94860cdf6fc5a56103e700abab7a6140a0d1f02a;hb=90e4d7057f3857da049dfda3d130017d4719bd6b;hp=85548030ecaddb33cde537a8c4d731d3b9afedaf;hpb=c962a0162c67d8b67593c848d08c9345c8b045f0;p=lilypond.git

diff --git a/scm/part-combiner.scm b/scm/part-combiner.scm
index 85548030ec..94860cdf6f 100644
--- a/scm/part-combiner.scm
+++ b/scm/part-combiner.scm
@@ -39,6 +39,20 @@
   (display (span-state x) file)
   (display "\n" file))
 
+;; Return the duration of the longest event in the Voice-state.
+(define-method (duration (vs <Voice-state>))
+  (define (duration-max event d1)
+    (let ((d2 (ly:event-property event 'duration #f)))
+      (if d2
+          (if (ly:duration<? d1 d2) d2 d1)
+          d1)))
+
+  (fold duration-max (ly:make-duration 0 0 0) (events vs)))
+
+;; Return the moment that the longest event in the Voice-state ends.
+(define-method (end-moment (vs <Voice-state>))
+  (ly:moment-add (moment vs) (ly:duration-length (duration vs))))
+
 (define-method (note-events (vs <Voice-state>))
   (define (f? x)
     (ly:in-event-class? x 'note-event))
@@ -129,16 +143,32 @@ return the previous voice state."
     (if p (span-state p) '())))
 
 (define (make-voice-states evl)
-  (let ((vec (list->vector (map (lambda (v)
-                                  (make <Voice-state>
-                                    #:moment (caar v)
-                                    #:tuning (cdar v)
-                                    #:events (map car (cdr v))))
-                                evl))))
-    (do ((i 0 (1+ i)))
-        ((= i (vector-length vec)) vec)
-      (slot-set! (vector-ref vec i) 'vector-index i)
-      (slot-set! (vector-ref vec i) 'state-vector vec))))
+  (let* ((states (map (lambda (v)
+                        (make <Voice-state>
+                          #:moment (caar v)
+                          #:tuning (cdar v)
+                          #:events (map car (cdr v))))
+                      (reverse evl))))
+
+    ;; add an entry with no events at the moment the last event ends
+    (if (pair? states)
+        (let ((last-real-event (car states)))
+          (set! states
+                (cons (make <Voice-state>
+                        #:moment (end-moment last-real-event)
+                        #:tuning (tuning last-real-event)
+                        #:events '())
+                      states))))
+
+    ;; TODO: Add an entry at +inf.0 and see if it allows us to remove
+    ;; the many instances of conditional code handling the case that
+    ;; there is no voice state at a given moment.
+
+    (let ((vec (list->vector (reverse! states))))
+      (do ((i 0 (1+ i)))
+          ((= i (vector-length vec)) vec)
+        (slot-set! (vector-ref vec i) 'vector-index i)
+        (slot-set! (vector-ref vec i) 'state-vector vec)))))
 
 (define (make-split-state vs1 vs2)
   "Merge lists VS1 and VS2, containing Voice-state objects into vector
@@ -315,9 +345,16 @@ LilyPond version 2.8 and earlier."
     (define (analyse-forced-combine result-idx prev-res)
 
       (define (get-forced-event x)
-        (and (ly:in-event-class? x 'part-combine-force-event)
-             (cons (ly:event-property x 'forced-type)
-                   (ly:event-property x 'once))))
+        (cond
+         ((and (ly:in-event-class? x 'SetProperty)
+               (eq? (ly:event-property x 'symbol) 'partCombineForced))
+          (cons (ly:event-property x 'value #f)
+                (ly:event-property x 'once #f)))
+         ((and (ly:in-event-class? x 'UnsetProperty)
+               (eq? (ly:event-property x 'symbol) 'partCombineForced))
+          (cons #f (ly:event-property x 'once #f)))
+         (else #f)))
+
       (define (part-combine-events vs)
         (if (not vs)
             '()