Fix some bugs in the dynamic engraver and PostScript backend

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

diff --git a/scm/part-combiner.scm b/scm/part-combiner.scm
index 2679c195e74cb7ad3594031d79762b32d7927c4b..56b43892b98d8b2759a5c6b83f0b9cbab778de14 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--2006    Han-Wen Nienhuys <hanwen@cs.uu.nl>
 
 ;; todo: figure out how to make module,
 ;; without breaking nested ly scopes
@@ -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))))
 
@@ -127,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))
     
@@ -186,7 +188,7 @@ Voice-state objects
 (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)
@@ -449,62 +451,16 @@ the mark when there are no spanners active."
         (display result))
     result))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; autochange - fairly related to part combining.
-
-(define-public (make-autochange-music music)
-  (define (generate-split-list change-moment event-list acc)
-    (if (null? event-list)
-       acc
-       (let* ((now-tun (caar event-list))
-              (evs (map car (cdar event-list)))
-              (now (car now-tun))
-              (notes (filter (lambda (x)
-                               (equal? (ly:music-property  x 'name) 'NoteEvent))
-                             evs))
-              (pitch (if (pair? notes)
-                         (ly:music-property (car notes) 'pitch)
-                         #f)))
-         ;; tail recursive.
-         (if (and pitch (not (= (ly:pitch-steps pitch) 0)))
-             (generate-split-list #f
-                                  (cdr event-list)
-                                  (cons (cons
-
-                                         (if change-moment
-                                             change-moment
-                                             now)
-                                         (sign (ly:pitch-steps pitch))) acc))
-             (generate-split-list
-              (if pitch #f now)
-              (cdr event-list) acc)))))
-  
-  (set! noticed '())
-  (let* ((m (make-music 'AutoChangeMusic))
-        (context (ly:run-translator (make-non-relative-music music) part-combine-listener))
-        (evs (last-pair noticed))
-        (split (reverse! (generate-split-list
-                          #f
-                          (if (pair? evs)
-                              (reverse! (cdar evs) '()) '())
-                          '())
-                         '())))
-    (set! (ly:music-property m 'element) music)
-    (set! (ly:music-property m 'split-list) split)
-    (set! noticed '())
-    m))
-
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (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)))
 
-    ;; (display (last-pair noticed))
     (if (pair? first-voice-handle)
        (hash-set! tab name
                   ;; cdr : skip name string