* lily/parser.yy (part_combined_music): remove old PC cruft.

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

diff --git a/scm/part-combiner.scm b/scm/part-combiner.scm
index 44da6ab139e441adf1a4f33192bb29dd6d94b466..3d3c796cf288f7dec58a91c18ca4da8a5bb40ced 100644 (file)
--- a/scm/part-combiner.scm
+++ b/scm/part-combiner.scm
@@ -10,12 +10,26 @@
 (define-class <Voice-state> ()
   (event-list #:init-value '() #:accessor events #:init-keyword #:events)
   (when-moment #:accessor when #:init-keyword #:when)
-  (split-idx #:accessor split-idx)
+  (split-index #:accessor split-index)
   (vector-index)
   (state-vector)
+
+
+  ;;;
+  ; spanner-state is an alist
+  ; of (SYMBOL . RESULT-INDEX), which indicates where
+  ; said spanner was started.
   (spanner-state #:init-value '() #:accessor span-state)
   )
   
+(define-method (write (x <Voice-state> ) file)
+  (display (when x) file)
+  (display " evs = " file)
+  (display (events x) file)
+  (display " active = " file)
+  (display (span-state x) file)
+  (display "\n" file)
+  )
 
 (define-method (note-events (vs <Voice-state>))
   (define (f? x)
@@ -29,6 +43,8 @@
   (synced  #:init-keyword #:synced #:init-value  #f #:getter synced?)
   )
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (define-method (previous-voice-state (vs <Voice-state>))
   (let* ((i (slot-ref vs 'vector-index))
         (v (slot-ref vs 'state-vector))
@@ -46,14 +62,6 @@
               '())
         ))
 
-(define-method (write (x <Voice-state> ) file)
-  (display (when x) file)
-  (display " evs = " file)
-  (display (events x) file)
-  (display " active = " file)
-  (display (span-state x) file)
-  (display "\n" file)
-  )
 
 (define-method (write (x <Split-state> ) f)
   (display (when x) f)
@@ -115,9 +123,9 @@ Voice-state objects
                ) #f))
         )
       (if s1
-         (set! (split-idx s1) ss-idx))
+         (set! (split-index s1) ss-idx))
       (if s2
-         (set! (split-idx s2) ss-idx))
+         (set! (split-index s2) ss-idx))
       
       (if min
          (helper (1+ ss-idx)
@@ -150,6 +158,13 @@ Voice-state objects
       (if (equal? (ly:get-mus-property ev 'name) 'NoteEvent)
          (assoc-remove! active 'tie)
          active) )
+
+    (define (analyse-absdyn-end active ev)
+      (if (equal? (ly:get-mus-property ev 'name) 'AbsoluteDynamicEvent)
+         (assoc-remove!
+          (assoc-remove! active 'cresc)
+          'decr)
+         active) )
     
     (define (active<? a b)
       (cond
@@ -175,7 +190,9 @@ Voice-state objects
        (if (and (symbol? key) (ly:dir? sp))
            (if (= sp STOP)
                (assoc-remove! active key)
-               (acons key index active))
+               (acons key
+                      (split-index (vector-ref voice-state-vec index))
+                      active))
            active)
        ))
 
@@ -187,15 +204,29 @@ Voice-state objects
            (run-analyzer analyzer (analyzer active (car evs)) (cdr evs))
            active
            ))
+      (define (run-analyzers analyzers active evs)
+       (if (pair? analyzers)
+           (run-analyzers
+            (cdr analyzers)
+            (run-analyzer (car analyzers) active evs)
+            evs)
+           active
+       ))
+
+      
 
       (sort
 
        ;; todo: use fold or somesuch.
-       (run-analyzer
-       analyse-span-event
-       (run-analyzer
-        analyse-tie-start
-        (run-analyzer analyse-tie-end active evs) evs) evs)
+       (run-analyzers
+       (list
+        analyse-absdyn-end
+        analyse-span-event
+             
+        ;; note: tie-start/span comes after tie-end/absdyn.
+        analyse-tie-end analyse-tie-start)
+
+        active evs)
        
        active<?))
 
@@ -226,7 +257,7 @@ Voice-state objects
 
 (define-public (make-new-part-combine-music music-list)
   (let*
-     ((m (make-music-by-name 'NewPartCombineMusic))
+     ((m (make-music-by-name 'PartCombineMusic))
       (m1 (context-spec-music (car music-list) 'Voice "one"))
       (m2 (context-spec-music (cadr music-list) 'Voice "two"))
       (props '((denies Thread)
@@ -258,7 +289,7 @@ Voice-state objects
 
   
   (let*
-      ((pc-debug #t)
+      ((pc-debug #f)
        (chord-threshold 8)
        (voice-state-vec1 (make-voice-states evl1))
        (voice-state-vec2 (make-voice-states evl2))
@@ -289,8 +320,7 @@ Only set if not set previously.
       (define (copy-one-state key-idx)
        (let*
            ((idx (cdr key-idx))
-            (start-vs (vector-ref state-vec idx))
-            (prev-ss (vector-ref result (split-idx start-vs)))
+            (prev-ss (vector-ref result idx))
             (prev (configuration prev-ss))
             )
          (if (symbol? prev)
@@ -408,7 +438,6 @@ Only set if not set previously.
                  ((notes1 (note-events vs1)) 
                   (notes2 (note-events vs2))
                   )
-
                (cond
                 ((and
                   (= 1 (length notes1))
@@ -422,14 +451,16 @@ Only set if not set previously.
                   (= 0 (length notes2)))
                  (set! (configuration now-state) 'unisilence)))
 
-               (analyse-a2 (1+ ri))
-               )))))
+               ))
+         (analyse-a2 (1+ ri))
+
+         )))
        
    (define (analyse-solo12 ri)
     
      (define (previous-config vs)
        (let*  ((pvs (previous-voice-state vs))
-              (spi (if pvs (split-idx pvs) #f))
+              (spi (if pvs (split-index pvs) #f))
               (prev-split (if spi (vector-ref result spi) #f))
               )
         
@@ -441,8 +472,8 @@ Only set if not set previously.
      (define (put-range x a b)
        (do
           ((i a (1+ i)))
-          ((> i b))
-        (set! (configuration (vector-ref result i) x))
+          ((> i b) b)
+        (set! (configuration (vector-ref result i)) x)
         ))
      (define (put x)
        (set! (configuration (vector-ref result ri)) x))
@@ -480,9 +511,8 @@ Only set if not set previously.
           ((now-state (vector-ref result ri))
            (vs1 (car (voice-states now-state)))
            (vs2 (cdr (voice-states now-state)))
-           
-           (notes1 (note-events vs1))
-           (notes2 (note-events vs2))
+           (notes1 (if vs1 (note-events vs1) '()))
+           (notes2 (if vs2 (note-events vs2) '()))
            (n1 (length notes1))
            (n2 (length notes2))
            )
@@ -515,7 +545,7 @@ Only set if not set previously.
    (analyse-spanner-states voice-state-vec1)
    (analyse-spanner-states voice-state-vec2)
 
-   (if #t
+   (if #f
        (begin
        (display voice-state-vec1)
        (display "***\n")
@@ -526,8 +556,8 @@ Only set if not set previously.
        ))
      
    (analyse-time-step 0)
-   (display result)
    (analyse-a2 0)
+;   (display result)
    (analyse-solo12 0)
 ;   (if pc-debug (display result))