From 645811e9270441f7cd2f4231479b5872d7569f53 Mon Sep 17 00:00:00 2001
From: hanwen <hanwen>
Date: Tue, 3 Feb 2004 20:03:44 +0000
Subject: [PATCH] * lily/slur.cc (height): robustness fix.

* scm/music-functions.scm (determine-split-list): further analysis.
---
 Documentation/topdocs/NEWS.texi |   2 -
 lily/slur.cc                    |   2 +-
 scm/lily.scm                    |   1 +
 scm/music-functions.scm         | 310 ---------------------
 scm/part-combiner.scm           | 466 ++++++++++++++++++++++++++++++++
 5 files changed, 468 insertions(+), 313 deletions(-)
 create mode 100644 scm/part-combiner.scm

diff --git a/Documentation/topdocs/NEWS.texi b/Documentation/topdocs/NEWS.texi
index 95ea4ad532..0ca5c7bb2e 100644
--- a/Documentation/topdocs/NEWS.texi
+++ b/Documentation/topdocs/NEWS.texi
@@ -58,8 +58,6 @@ It is more robust and less buggy. The part-combiner can be used with
 @noindent
 See @file{input/regression/new-part-combine.ly} for an example.
 
-(This feature is still experimental.)
-
 @item Formatting of rehearsal marks has been improved. The @code{\mark}
 command now only does automatic incrementing for marks specified as
 integer. For example, @code{\mark #1} will print an A in the default
diff --git a/lily/slur.cc b/lily/slur.cc
index 8d69ddb2c2..4f763205d5 100644
--- a/lily/slur.cc
+++ b/lily/slur.cc
@@ -531,7 +531,7 @@ Slur::height (SCM smob, SCM ax)
   SCM mol = me->get_uncached_molecule ();
   Interval ext;
   if (Molecule * m = unsmob_molecule (mol))
-    ext = m->extent (a);
+    ext = m->extent= (a);
   return ly_interval2scm (ext);
 }
 
diff --git a/scm/lily.scm b/scm/lily.scm
index d0881b90de..e819bf653a 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -371,6 +371,7 @@ L1 is copied, L2 not.
        "new-markup.scm"
        "bass-figure.scm"
        "music-functions.scm"
+       "part-combiner.scm"
        "define-music-properties.scm"
        "auto-beam.scm"
        "chord-name.scm"
diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index c40d4b0783..46fe30b49f 100644
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -786,313 +786,3 @@ Rest can contain a list of beat groupings
 
      ))))
 
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; part-combiner.
-
-
-	
-(define noticed '())
-(define part-combine-listener '())
-(define-public (set-part-combine-listener x)
-  (set! part-combine-listener x))
-
-(define-public (notice-the-events-for-pc context lst)
-  (set! noticed (acons (ly:context-id context) lst noticed)))
-
-(define-public (make-new-part-combine-music music-list)
-  (let*
-     ((m (make-music-by-name 'NewPartCombineMusic))
-      (m1 (context-spec-music (car music-list) 'Voice "one"))
-      (m2 (context-spec-music (cadr music-list) 'Voice "two"))
-      (props '((denies Thread)
-	       (consists Rest_engraver)
-	       (consists Note_heads_engraver)
-	       )))
-    
-    (ly:set-mus-property! m 'elements (list m1 m2))
-    (ly:set-mus-property! m1 'property-operations props)
-    (ly:set-mus-property! m2 'property-operations props)
-    (ly:run-translator m2 part-combine-listener)
-    (ly:run-translator m1 part-combine-listener)
-    (ly:set-mus-property! m 'split-list
-			 (determine-split-list (reverse (cdr (assoc "one" noticed)))
-					       (reverse (cdr (assoc "two" noticed)))))
-    (set! noticed '())
-    
-    m))
-
-
-
-;;
-;; todo: this function is rather too hairy and too long.
-;;
-(define-public (determine-split-list evl1 evl2)
-  "EVL1 and EVL2 should be ascending"
-  (define pc-debug #t)
-  (define ev1 (list->vector evl1))
-  (define ev2 (list->vector evl2))
-  (define (when v i)
-    (car (vector-ref v i)))
-  (define (what v i)
-    (cdr (vector-ref v i)))
-
-  (define chord-threshold 8)
-  (define (get-note-evs v i)
-    (define (f? x)
-      (equal? (ly:get-mus-property  x 'name) 'NoteEvent))
-    (filter f? (map car (what v i))))
-  (define moments (uniq-list
-		   (merge (map car evl1) (map car evl2) ly:moment<?)))
-  (define result '())
-  
-  (define (analyse-time-step i1 i2 ri
-			     active1
-			     active2)
-
-    (define (analyse-tie-start active ev)
-      (if (equal? (ly:get-mus-property ev 'name) 'TieEvent)
-	  (acons 'tie ri active)
-	  active
-	  ))
-    
-    (define (analyse-tie-end active ev)
-      (if (equal? (ly:get-mus-property ev 'name) 'NoteEvent)
-	  (assoc-remove!  active 'tie)
-	  active) )
-    
-    (define (active<? a b)
-      (cond
-       ((symbol<? (car a) (car b)) #t)
-       ((symbol<? (car b) (car b)) #f)
-       (else
-	(< (cdr a) (cdr b)))
-       ))
-    
-    (define (analyse-span-event active ev)
-      (let*
-	  ((name (ly:get-mus-property ev 'name))
-	   (key (cond
-		       ((equal? name 'SlurEvent) 'slur)
-		       ((equal? name 'PhrasingSlurEvent) 'tie)
-		       ((equal? name 'BeamEvent) 'beam)
-		       ((equal? name 'CrescendoEvent) 'cresc)
-		       ((equal? name 'DecrescendoEvent) 'decr)
-		       (else #f)) )
-	   (sp (ly:get-mus-property ev 'span-direction))
-	   )
-
-	(if (and (symbol? key) (ly:dir? sp))
-	    (if (= sp STOP)
-		(assoc-remove! active key)
-		(acons key ri active))
-	    active)
-	))
-
-    (define (analyse-events active evs)
-      (define (helper analyzer active evs)
-	(if (pair? evs)
-	    (helper analyzer (analyzer active (car evs)) (cdr evs))
-	    active
-	    ))
-      (sort
-       (helper analyse-span-event
-	       (helper analyse-tie-start
-		       (helper analyse-tie-end active evs) evs) evs)
-       active<?))
-    
-
-    (define (put x . index)
-      "Put the result to X, starting from INDEX backwards."
-      (let
-	  ((i (if (pair? index) (car index) ri)))
-
-	(if (and (<= 0 i) (not (symbol? (what result i))))
-	    (begin
-	      (set-cdr! (vector-ref result i) x)
-	      (put x (1- i))
-	    ))
-	))
-	
-
-    (cond
-     ((= ri (vector-length result)) '())
-     ((= i1 (vector-length ev1)) (put 'apart))
-     ((= i2 (vector-length ev2)) (put 'apart))
-     (else
-      (let*
-	  ((now (when result ri))
-;	   (x (display (list "\nelse" (= i1 (vector-length ev1)) i2  (vector-length ev2) (= i2 (vector-length ev2)))))
-	   (m1 (when ev1 i1))
-	   (m2 (when ev2 i2))
-;	   (x (display "oked"))
-	   (evs1 (map car (what ev1 i1)))
-	   (evs2 (map car (what ev2 i2)))
-	   (new-active1 (analyse-events active1 evs1))
-	   (new-active2 (analyse-events active2 evs2))
-	   )
-
-	
-	(or #t (display (list (when result ri) i1 i2 ri
-		       active1 "->" new-active1
-		       active2 "->" new-active2
-		       (vector-length ev1) (vector-length ev2) (vector-length result)  "\n")))
-    
-	
-	(if (not (or (equal? m1 now)
-		     (equal? m2 now)))
-	    (begin
-	      (display
-	       (list "<? M1,M2 != result :"
-		     m1 m2 (when result ri)))
-	      (scm-error "boem")))
-
-	(cond
-	 ((ly:moment<? m1 m2)
-	  (put 'apart)
-	  (if (> ri 0) (put 'apart (1- ri)))
-	  (analyse-time-step (1+ i1) i2 (1+ ri) new-active1 active2))
-	 ((ly:moment<? m2 m1)
-	  (put 'apart)
-	  (if (> ri 0) (put 'apart (1- ri)))
-	  (analyse-time-step i1 (1+ i2) (1+ ri) active1 new-active2))
-	 (else
-
-	  (if (and (equal? active1 active2) (equal? new-active2 new-active1))
-	      (let*
-		  ((notes1 (get-note-evs ev1 i1))
-		   (durs1     (sort (map (lambda (x) (ly:get-mus-property x 'duration)) notes1) ly:duration<?))
-		   (pitches1 (sort
-			      (map (lambda (x) (ly:get-mus-property x 'pitch)) notes1) ly:pitch<?))
-		   (notes2 (get-note-evs ev2 i2))
-		   (durs2     (sort (map (lambda (x) (ly:get-mus-property x 'duration)) notes2) ly:duration<?))
-		   (pitches2 (sort
-			      (map (lambda (x) (ly:get-mus-property x 'pitch)) notes2) ly:pitch<?))
-		   )
-		(cond
-		 ((> (length notes1) 1) (put 'apart))
-		 ((> (length notes2) 1) (put 'apart))
-		 ((not (= (length notes1) (length notes2)))
-		  (put 'apart))
-		 ((and
-		   (= (length durs1) 1)
-		   (= (length durs2) 1)
-		   (not (equal? (car durs1) (car durs2))))
-
-		  (put 'apart))
-		 (else
-		  (if (and (= (length pitches1) (length pitches2)))
-		      (if
-		       (and (pair?  pitches1) (pair? pitches2)
-		       (< chord-threshold (ly:pitch-steps
-					   (ly:pitch-diff (car pitches1) (car pitches2)))))
-		       (put 'apart)
-
-
-		       ;; copy previous split state from spanner state
-		       (begin
-			 (map (lambda (key-idx)
-				(let*
-				    ((idx (cdr key-idx))
-				     (prev (what result  idx))
-				     )
-				  (if (symbol? prev)
-				      (put prev))
-				  )) (append active1 active2))
-			 (if (and (null? new-active1) (null? new-active2))
-			     (put 'chords ri))))
-		  
-		  ))))
-	      
-	      ;; active states different:
-	      ;; must mark differently so
-	      ;; it doesn't transform into solo 
-	      (put 'apart-spanner))
-	  (analyse-time-step (1+ i1) (1+ i2) (1+ ri) new-active1 new-active2)))
-	 ))))
-
-;; 
-   (define (analyse-solo12 i1 i2 ri)
-     (define (put x)
-       (set-cdr! (vector-ref result ri) x) )
-     (cond
-      ((= ri (vector-length result)) '())
-      ((= i1 (vector-length ev1)) '())
-      ((= i2 (vector-length ev2)) '())
-      (else
-       (let*
-	  ((now (when result ri))
-	   (m1 (when ev1 i1))
-	   (m2 (when ev2 i2))
-	   (notes1 (get-note-evs ev1
-				 (if (ly:moment<?  now m1)
-				     (1- i1) i1)))
-	   
-	   (durs1 (sort (map (lambda (x) (ly:get-mus-property x 'duration)) notes1) ly:duration<?))
-	   (pitches1 (sort
-		      (map (lambda (x) (ly:get-mus-property x 'pitch)) notes1) ly:pitch<?))
-
-	   (notes2 (get-note-evs ev2
-				 (if (ly:moment<? now m2)
-				     (1- i2) i2)))
-	   (n2 (length notes2))
-	   (n1 (length notes1))
-	   (durs2 (sort (map (lambda (x) (ly:get-mus-property x 'duration)) notes2) ly:duration<?))
-	   (pitches2 (sort
-		      (map (lambda (x) (ly:get-mus-property x 'pitch)) notes2) ly:pitch<?))
-	   )
-
-	(if pc-debug (display (list
-			 "\n"
-			 (when result ri) i1 "/" (vector-length ev1)
-			      m1 ":" notes1
-			      i2 "/" (vector-length ev2) m2 ":"
-			      notes2
-			      ri "/" (vector-length result)  " = "
-			      (what  result ri)
-			      "\n"
-			      )))
-    
-
-	
-	 (if (equal? (what result ri) 'apart)
-	     (cond
-	      ((and (= 0 n1)
-		    (< 0 n2)
-		    (equal? now m2)
-		    )
-	       (put 'solo2))
-	      ((and (< 0 n1)
-		    (= 0 n2)
-		    (equal? now m1)
-		    )
-	       (put 'solo1))
-	      ((and (= 0 n1)
-		    (= 0 n2))
-	       (put 'apart-silence))
-	      ))
-
-	 (if (and
-	      (equal? (what result ri) 'chords)
-	      (equal? pitches1 pitches2))
-	     (put (if (pair? pitches2)
-		      'unisono 'unisilence) ))
-	 
-	 (cond
-	  ((ly:moment<? m1 m2)
-	   (analyse-solo12 (1+ i1) i2 (1+ ri) ))
-	  ((ly:moment<? m2 m1)
-	   (analyse-solo12 i1 (1+ i2) (1+ ri) ))
-	  (else
-	   (analyse-solo12 (1+ i1) (1+ i2) (1+ ri)))
-	  )))))
-   (set! result (list->vector
-		 (map (lambda (x)
-			(cons x '())) moments)))
-   
-   (analyse-time-step 0 0  0 '() '())
-   (if pc-debug (display result))
-   (analyse-solo12 0 0 0)
-   (if pc-debug (display result))
-   
-   (vector->list result))
diff --git a/scm/part-combiner.scm b/scm/part-combiner.scm
new file mode 100644
index 0000000000..a5cf9f595c
--- /dev/null
+++ b/scm/part-combiner.scm
@@ -0,0 +1,466 @@
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; part-combiner.
+
+(use-modules (oop goops))
+
+(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 )
+  (spanner-state #:init-value '() #:accessor span-state)
+  )
+  
+
+
+(define-class <Split-state> ()
+  (configuration #:init-value '() #:accessor configuration)
+  (when-moment #:accessor when #:init-keyword #:when)
+  (is #:init-keyword #:indexes #:accessor indexes)
+  (synced  #:init-keyword #:synced #:init-value  #f #:getter synced?)
+  )
+
+(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)
+  (display " = " f)
+  (display (configuration x) f)
+  (if (synced? x)
+      (display " synced "))
+  (display "\n" f)
+  )
+
+
+(define (make-voice-states evl)
+  (list->vector
+  (map
+   (lambda (v)
+     (make <Voice-state>
+       #:when (car v)
+       #:events (map car (cdr v))
+       ))
+     evl)))
+
+(define (moment-min a b)
+  (if (ly:moment<? a b) a b))
+
+(define (make-split-state vs1 vs2)
+  "Merge lists VS1 and VS2, containing Voice-state objects into vector
+of Split-state objects, crosslinking the Split-state vector and
+Voice-state objects
+"
+  
+  (define (helper ss-idx ss-list idx1 idx2)
+    (let*
+	((m1 (if (< idx1 (vector-length vs1)) (when (vector-ref vs1 idx1)) #f) )
+	 (m2 (if (< idx2 (vector-length vs2)) (when (vector-ref vs2 idx2)) #f) )
+	 (min (cond ((and m1 m2) (moment-min m1 m2))
+		    (m1 m1)
+		    (m2 m2)
+		    (else #f)
+		    ))
+
+	 (inc1 (if (and m1 (equal? min m1)) 1 0))
+	 (inc2 (if (and m2 (equal? min m2)) 1 0))
+	 (ss-object
+	  (if min
+	      (make <Split-state>
+		#:when min
+		#:indexes (cons idx1 idx2)
+		#:synced (= inc1 inc2)
+		) #f))
+	 )
+      (if m1
+	  (set! (split-idx (vector-ref vs1 idx1)) ss-idx))
+      (if m2
+	  (set! (split-idx (vector-ref vs2 idx2)) ss-idx))
+      
+      (if min
+	  (helper (1+ ss-idx)
+		  (cons ss-object ss-list)
+		  (+ idx1 inc1)
+		  (+ idx2 inc2))
+	  ss-list
+	  )
+      ))
+
+    (list->vector
+     (reverse!
+      (helper 0 '() 0  0) '()))
+    )
+      
+
+
+(define (analyse-spanner-states voice-state-vec)
+
+  (define (helper index active)
+    "Analyse EVS at INDEX, given state ACTIVE."
+    
+    (define (analyse-tie-start active ev)
+      (if (equal? (ly:get-mus-property ev 'name) 'TieEvent)
+	  (acons 'tie index active)
+	  active
+	  ))
+    
+    (define (analyse-tie-end active ev)
+      (if (equal? (ly:get-mus-property ev 'name) 'NoteEvent)
+	  (assoc-remove! active 'tie)
+	  active) )
+    
+    (define (active<? a b)
+      (cond
+       ((symbol<? (car a) (car b)) #t)
+       ((symbol<? (car b) (car b)) #f)
+       (else
+	(< (cdr a) (cdr b)))
+       ))
+    
+    (define (analyse-span-event active ev)
+      (let*
+	  ((name (ly:get-mus-property ev 'name))
+	   (key (cond
+		 ((equal? name 'SlurEvent) 'slur)
+		 ((equal? name 'PhrasingSlurEvent) 'tie)
+		 ((equal? name 'BeamEvent) 'beam)
+		 ((equal? name 'CrescendoEvent) 'cresc)
+		 ((equal? name 'DecrescendoEvent) 'decr)
+		 (else #f)) )
+	   (sp (ly:get-mus-property ev 'span-direction))
+	   )
+
+	(if (and (symbol? key) (ly:dir? sp))
+	    (if (= sp STOP)
+		(assoc-remove! active key)
+		(acons key index active))
+	    active)
+	))
+
+    (define (analyse-events active evs)
+      "Run all analyzers on ACTIVE and EVS"
+
+      (define (run-analyzer analyzer active evs)
+	(if (pair? evs)
+	    (run-analyzer analyzer (analyzer active (car evs)) (cdr 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)
+       
+       active<?))
+
+    ;; must copy, since we use assoc-remove!
+    (if (< index (vector-length voice-state-vec))
+	(begin
+	  (set! active (analyse-events active (events (vector-ref voice-state-vec index))))
+	  (set! (span-state (vector-ref voice-state-vec index))
+		(list-copy active))
+
+	  (helper (1+ index) active)))
+    )
+
+
+  (helper 0 '())
+  
+  )
+
+
+	
+(define noticed '())
+(define part-combine-listener '())
+(define-public (set-part-combine-listener x)
+  (set! part-combine-listener x))
+
+(define-public (notice-the-events-for-pc context lst)
+  (set! noticed (acons (ly:context-id context) lst noticed)))
+
+(define-public (make-new-part-combine-music music-list)
+  (let*
+     ((m (make-music-by-name 'NewPartCombineMusic))
+      (m1 (context-spec-music (car music-list) 'Voice "one"))
+      (m2 (context-spec-music (cadr music-list) 'Voice "two"))
+      (props '((denies Thread)
+	       (consists Rest_engraver)
+	       (consists Note_heads_engraver)
+	       )))
+    
+    (ly:set-mus-property! m 'elements (list m1 m2))
+    (ly:set-mus-property! m1 'property-operations props)
+    (ly:set-mus-property! m2 'property-operations props)
+    (ly:run-translator m2 part-combine-listener)
+    (ly:run-translator m1 part-combine-listener)
+    (ly:set-mus-property! m 'split-list
+			 (determine-split-list (reverse (cdr (assoc "one" noticed)))
+					       (reverse (cdr (assoc "two" noticed)))))
+    (set! noticed '())
+    
+    m))
+
+
+    
+    
+
+
+
+;;
+;; todo: this function is rather too hairy and too long.
+;;
+(define-public (determine-split-list evl1 evl2)
+  "EVL1 and EVL2 should be ascending"
+
+  (let*
+      ((pc-debug #f)
+       (chord-threshold 8)
+       (voice-state-vec1 (make-voice-states evl1))
+       (voice-state-vec2 (make-voice-states evl2))
+       (result (make-split-state voice-state-vec1 voice-state-vec2))
+       )
+
+
+  (define (analyse-time-step ri)
+    (define (put x . index)
+      "Put the result to X, starting from INDEX backwards.
+
+Only set if not set previously.
+"
+      
+      (let
+	  ((i (if (pair? index) (car index) ri)))
+
+	(if (and (<= 0 i)
+		 (not (symbol? (configuration (vector-ref result i)))))
+	    (begin
+	      (set! (configuration (vector-ref result i)) x)
+	      (put x (1- i))
+	    ))
+	))
+
+    (define (get-note-evs vs)
+      (define (f? x)
+	(equal? (ly:get-mus-property  x 'name) 'NoteEvent))
+      (filter f? (events vs)))
+    
+    (define (copy-state-from state-vec vs)
+      (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 (configuration prev-ss))
+	     )
+	  (if (symbol? prev)
+	      (put prev))))
+      
+      (map copy-one-state (span-state vs))
+      )
+
+    (define (analyse-notes now-state) 
+      (let*
+	  (
+	   (i1 (car (indexes now-state)))
+	   (i2 (cdr (indexes now-state)))
+	   (vs1 (vector-ref voice-state-vec1 i1))
+	   (vs2 (vector-ref voice-state-vec2 i2))
+	   
+	   (notes1 (get-note-evs vs1))
+	   (durs1 (sort (map (lambda (x) (ly:get-mus-property x 'duration)) notes1) ly:duration<?))
+	   (pitches1 (sort
+		      (map (lambda (x) (ly:get-mus-property x 'pitch)) notes1) ly:pitch<?))
+	   (notes2 (get-note-evs vs2))
+	   (durs2     (sort (map (lambda (x) (ly:get-mus-property x 'duration)) notes2) ly:duration<?))
+	   (pitches2 (sort
+		      (map (lambda (x) (ly:get-mus-property x 'pitch)) notes2) ly:pitch<?))
+	   )
+	
+	(cond
+	 ((> (length notes1) 1) (put 'apart))
+	 ((> (length notes2) 1) (put 'apart))
+	 ((not (= (length notes1) (length notes2)))
+	  (put 'apart))
+	 ((and
+	   (= (length durs1) 1)
+	   (= (length durs2) 1)
+	   (not (equal? (car durs1) (car durs2))))
+
+	  (put 'apart))
+	 (else
+	  (if (and (= (length pitches1) (length pitches2)))
+	      (if (and (pair? pitches1)
+		       (pair? pitches2)
+		       (< chord-threshold (ly:pitch-steps
+					   (ly:pitch-diff (car pitches1) (car pitches2)))))
+		  (put 'apart)
+
+		  ;; copy previous split state from spanner state
+		  (begin
+		    (if (> i1 0)
+			(copy-state-from voice-state-vec1 (vector-ref voice-state-vec1 (1- i1))))
+		    (if (> i2 0)
+			(copy-state-from voice-state-vec2 (vector-ref voice-state-vec2 (1- i2))))
+		    (if (and (null? (span-state vs1)) (null? (span-state vs2)))
+			(put 'chords))
+		    
+		    ))))
+	 )))
+	 
+
+
+    (if (< ri (vector-length result))
+	(let*
+	    ((now-state (vector-ref result ri))
+	     (i1 (car (indexes now-state)))
+	     (i2 (cdr (indexes now-state))))
+	  
+	  (cond
+	   ((= i1 (vector-length voice-state-vec1)) (put 'apart))
+	   ((= i2 (vector-length voice-state-vec2)) (put 'apart))
+	   (else
+	    (let*
+		(
+		 (vs1 (vector-ref voice-state-vec1 i1))
+		 (vs2 (vector-ref voice-state-vec2 i2))
+		 
+		 (active1
+		  (if (> i1 0)
+		      (span-state (vector-ref voice-state-vec1 (1- i1)))
+		      '()))
+		 (active2
+		  (if (> i2 0)
+		      (span-state (vector-ref voice-state-vec2 (1- i2)))
+		      '()))
+
+		 (new-active1 (span-state vs1))
+		 (new-active2 (span-state vs2))
+
+		 )
+	      (if
+	       pc-debug
+	       (display (list (when now-state) i1 i2 ri
+				    active1 "->" new-active1
+				    active2 "->" new-active2
+				    "\n")))
+
+	      
+	      
+	      (if (and (synced? now-state)
+		       (equal? active1 active2)
+		       (equal? new-active1 new-active2))
+
+		  (analyse-notes now-state)
+
+		  ;; active states different:
+		  (put 'apart)
+		  )
+	      )
+
+					; go to the next one, if it exists.
+	    (analyse-time-step (1+ ri))
+	    )))))
+    
+    
+   (define (analyse-solo12 ri)
+     (define (put x)
+       (set-cdr! (vector-ref result ri) x) )
+     
+     (if (< ri (vector-length result))
+
+       (let*
+	  ((now (when result ri))
+	   (m1 (when ev1 i1))
+	   (m2 (when ev2 i2))
+	   (notes1 (get-note-evs ev1
+				 (if (ly:moment<?  now m1)
+				     (1- i1) i1)))
+	   
+	   (durs1 (sort (map (lambda (x) (ly:get-mus-property x 'duration)) notes1) ly:duration<?))
+	   (pitches1 (sort
+		      (map (lambda (x) (ly:get-mus-property x 'pitch)) notes1) ly:pitch<?))
+
+	   (notes2 (get-note-evs ev2
+				 (if (ly:moment<? now m2)
+				     (1- i2) i2)))
+	   (n2 (length notes2))
+	   (n1 (length notes1))
+	   (durs2 (sort (map (lambda (x) (ly:get-mus-property x 'duration)) notes2) ly:duration<?))
+	   (pitches2 (sort
+		      (map (lambda (x) (ly:get-mus-property x 'pitch)) notes2) ly:pitch<?))
+	   )
+
+	(if pc-debug (display (list
+			 "\n"
+			 (when result ri) i1 "/" (vector-length ev1)
+			      m1 ":" notes1
+			      i2 "/" (vector-length ev2) m2 ":"
+			      notes2
+			      ri "/" (vector-length result)  " = "
+			      (what  result ri)
+			      "\n"
+			      )))
+    
+
+	
+	 (if (equal? (what result ri) 'apart)
+	     (cond
+	      ((and (= 0 n1)
+		    (< 0 n2)
+		    (equal? now m2)
+		    )
+	       (put 'solo2))
+	      ((and (< 0 n1)
+		    (= 0 n2)
+		    (equal? now m1)
+		    )
+	       (put 'solo1))
+	      ((and (= 0 n1)
+		    (= 0 n2))
+	       (put 'apart-silence))
+	      ))
+
+	 (if (and
+	      (equal? (what result ri) 'chords)
+	      (equal? pitches1 pitches2))
+	     (put (if (pair? pitches2)
+		      'unisono 'unisilence) ))
+	 
+	 (cond
+	  ((ly:moment<? m1 m2)
+	   (analyse-solo12 (1+ i1) i2 (1+ ri) ))
+	  ((ly:moment<? m2 m1)
+	   (analyse-solo12 i1 (1+ i2) (1+ ri) ))
+	  (else
+	   (analyse-solo12 (1+ i1) (1+ i2) (1+ ri)))
+	  ))))
+
+
+   (analyse-spanner-states voice-state-vec1)
+   (analyse-spanner-states voice-state-vec2)
+;  (display voice-state-vec1)
+;   (display voice-state-vec2)
+;   (display result)
+     
+   (analyse-time-step 0)
+;   (analyse-solo12 0 0 0)
+   (display result)
+;   (if pc-debug (display result))
+
+   (set! result    (map
+		    (lambda (x) (cons (when x) (configuration x)))
+		    (vector->list result)))
+
+;   (if pc-debug (display result))
+   result))
-- 
2.39.5