X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fpart-combiner.scm;h=56b43892b98d8b2759a5c6b83f0b9cbab778de14;hb=bcaa3cce66632e4b428e11cef6cbbad3a8edaad2;hp=5fe821ff5f32a759885e14b3d47bbfd11715d2db;hpb=885941ba40b854b714fb793875b2987403ce2c72;p=lilypond.git

diff --git a/scm/part-combiner.scm b/scm/part-combiner.scm
index 5fe821ff5f..56b43892b9 100644
--- 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
@@ -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)
@@ -450,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)))
-q
-    ;; (display (last-pair noticed))
+
     (if (pair? first-voice-handle)
 	(hash-set! tab name
 		   ;; cdr : skip name string