*** empty log message ***

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

diff --git a/scm/part-combiner.scm b/scm/part-combiner.scm
index 94872ae65764a3000fe8d1917ed32ce7c613f7ab..9e59dc2ad55d31afb29c10163604d9fdfea4edf7 100644 (file)
--- a/scm/part-combiner.scm
+++ b/scm/part-combiner.scm
@@ -2,7 +2,7 @@
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 
-;;;; (c)  2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; (c) 2004--2005    Han-Wen Nienhuys <hanwen@cs.uu.nl>
 
 ;; todo: figure out how to make module,
 ;; without breaking nested ly scopes
@@ -18,7 +18,7 @@
   ;; spanner-state is an alist
   ;; of (SYMBOL . RESULT-INDEX), which indicates where
   ;; said spanner was started.
-  (spanner-state #:init-value '() #:accessor span-state) )
+  (spanner-state #:init-value '() #:accessor span-state))
   
 (define-method (write (x <Voice-state> ) file)
   (display (when x) file)
@@ -26,7 +26,7 @@
   (display (events x) file)
   (display " active = " file)
   (display (span-state x) file)
-  (display "\n" file) )
+  (display "\n" file))
 
 (define-method (note-events (vs <Voice-state>))
   (define (f? x)
@@ -35,7 +35,7 @@
 
 (define-method (previous-voice-state (vs <Voice-state>))
   (let ((i (slot-ref vs 'vector-index))
-       (v (slot-ref vs 'state-vector)) )
+       (v (slot-ref vs 'state-vector)))
     (if (< 0 i)
        (vector-ref v (1- i))
        #f)))
@@ -57,7 +57,7 @@
   (display (configuration x) f)
   (if (synced? x)
       (display " synced "))
-  (display "\n" f) )
+  (display "\n" f))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -73,8 +73,8 @@
                                    #:tuning (cdar v)
                                    #:events (map car (cdr v))))
                                evl))))
-    (do ( (i 0 (1+ i)) )
-       ( (= i (vector-length vec)) vec)
+    (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))))
 
@@ -110,7 +110,6 @@ Voice-state objects
          ss-list)))
   (list->vector (reverse! (helper 0 '() 0  0) '())))
 
-
 (define (analyse-spanner-states voice-state-vec)
 
   (define (helper index active)
@@ -128,7 +127,9 @@ Voice-state objects
          active))
 
     (define (analyse-absdyn-end active ev)
-      (if (equal? (ly:music-property ev 'name) 'AbsoluteDynamicEvent)
+      (if (or (equal? (ly:music-property ev 'name) 'AbsoluteDynamicEvent)
+             (and (equal? (ly:music-property ev 'name) 'CrescendoEvent)
+                  (equal? STOP (ly:music-property ev 'span-direction))))
          (assoc-remove! (assoc-remove! active 'cresc) 'decr)
          active))
     
@@ -183,13 +184,11 @@ Voice-state objects
   
   (helper 0 '()))
 
-
-       
 (define noticed '())
 (define part-combine-listener '())
 
 ; UGH - should pass noticed setter to part-combine-listener
-(define-public (set-part-combine-listener x)
+(define-safe-public (set-part-combine-listener x)
   (set! part-combine-listener x))
 
 (define-public (notice-the-events-for-pc context lst)
@@ -244,16 +243,16 @@ Only set if not set previously.
        (let* ((vs1 (car (voice-states now-state)))
               (vs2 (cdr (voice-states now-state)))
               (notes1 (note-events vs1))
-              (durs1    (sort (map (lambda (x) (ly:music-property x 'duration))
-                                   notes1)
-                              ly:duration<?))
+              (durs1 (sort (map (lambda (x) (ly:music-property x 'duration))
+                                notes1)
+                           ly:duration<?))
               (pitches1 (sort (map (lambda (x) (ly:music-property x 'pitch))
                                    notes1)
                               ly:pitch<?))
-              (notes2   (note-events vs2))
-              (durs2    (sort (map (lambda (x) (ly:music-property x 'duration))
-                                   notes2)
-                              ly:duration<?))
+              (notes2 (note-events vs2))
+              (durs2 (sort (map (lambda (x) (ly:music-property x 'duration))
+                                notes2)
+                           ly:duration<?))
               (pitches2 (sort (map (lambda (x) (ly:music-property x 'pitch))
                                    notes2)
                               ly:pitch<?)))
@@ -391,7 +390,8 @@ the mark when there are no spanners active."
                     (try-solo type (1+ current-idx) (1+  current-idx)))
                    (else
                     (try-solo type start-idx (1+ current-idx)))))
-           start-idx)) ; try-solo
+           ;; try-solo
+           start-idx))
       
       (define (analyse-moment result-idx)
        "Analyse 'apart starting at RESULT-IDX. Return next index. "
@@ -405,8 +405,8 @@ the mark when there are no spanners active."
               (n1 (length notes1))
               (n2 (length notes2)))
          ;; (display (list "analyzing step " result-idx "  moment " (when now-state) vs1 vs2  "\n"))
-         (max                          ; we should always increase.
-          
+         (max
+          ;; we should always increase.
           (cond ((and (= n1 0) (= n2 0))
                  (put 'apart-silence)
                  (1+ result-idx))
@@ -420,7 +420,8 @@ the mark when there are no spanners active."
                  (try-solo 'solo2 result-idx result-idx))
                 
                 (else (1+ result-idx)))
-          (1+ result-idx)))) ; analyse-moment
+          ;; analyse-moment
+          (1+ result-idx))))
       
       (if (< result-idx (vector-length result))
          (if (equal? (configuration (vector-ref result result-idx)) 'apart)
@@ -429,7 +430,7 @@ the mark when there are no spanners active."
 
     (analyse-spanner-states voice-state-vec1)
     (analyse-spanner-states voice-state-vec2)
-    (if #f
+    (if #t
        (begin
          (display voice-state-vec1)
          (display "***\n")
@@ -500,7 +501,7 @@ the mark when there are no spanners active."
 
 (define-public (add-quotable name mus)
   (set! noticed '())
-  (let* ((tab (eval 'musicQuotes (current-module) ))
+  (let* ((tab (eval 'musicQuotes (current-module)))
         (context (ly:run-translator (context-spec-music mus 'Voice)
                                     part-combine-listener))
         (first-voice-handle (last-pair noticed)))