]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/part-combiner.scm
* python/lilylib.py (make_ps_images): don't do showpage for
[lilypond.git] / scm / part-combiner.scm
index 5cc2cfb8d21eadf154a9f0729d6346bad3df2f73..989b3c2884de405bedb9bc3da16df8821dd3cfb7 100644 (file)
@@ -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)
@@ -183,8 +182,6 @@ Voice-state objects
   
   (helper 0 '()))
 
-
-       
 (define noticed '())
 (define part-combine-listener '())
 
@@ -193,6 +190,8 @@ Voice-state objects
   (set! part-combine-listener x))
 
 (define-public (notice-the-events-for-pc context lst)
+  "add CONTEXT-ID, EVENT list to NOTICED variable."
+  
   (set! noticed (acons (ly:context-id context) lst noticed)))
 
 (define-public (make-part-combine-music music-list)
@@ -242,29 +241,22 @@ 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<?)))
          (cond ((> (length notes1) 1) (put 'apart))
                ((> (length notes2) 1) (put 'apart))
-               ;;
-               ((and (= (length notes2) 1)
-                     (= (length notes1) 0))
-                     (put 'playing2))
-               ((and (= (length notes1) 1)
-                     (= (length notes2) 0))
-                     (put 'playing1))
-               ;;
+               ((= 1 (+ (length notes2) (length notes1))) (put 'apart))
                ((and (= (length durs1) 1)
                      (= (length durs2) 1)
                      (not (equal? (car durs1) (car durs2))))
@@ -396,7 +388,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. "
@@ -410,8 +403,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))
@@ -425,7 +418,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)
@@ -505,12 +499,15 @@ 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))
-        (evs (last-pair noticed)))
-    (if (pair? evs)
+        (first-voice-handle (last-pair noticed)))
+
+    ;; (display (last-pair noticed))
+    (if (pair? first-voice-handle)
        (hash-set! tab name
                   ;; cdr : skip name string
-                  (list->vector (reverse! (cdar evs) '()))))))
+                  (list->vector (reverse! (cdar first-voice-handle)
+                                          '()))))))