-
- (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 (copy-state-from state-vec vs)
- (define (copy-one-state key-idx)
- (let*
- ((idx (cdr key-idx))
- (prev-ss (vector-ref result idx))
- (prev (configuration prev-ss)) )
- (if (symbol? prev)
- (put prev))))
-
- (map copy-one-state (span-state vs)) )
-
- (define (analyse-notes now-state)
- (let*
- (
- (vs1 (car (voice-states now-state)))
- (vs2 (cdr (voice-states now-state)))
-
- (notes1 (note-events 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 (note-events 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 (previous-voice-state vs1)
- (copy-state-from voice-state-vec1
- (previous-voice-state vs1)))
- (if (previous-voice-state vs2)
- (copy-state-from voice-state-vec2
- (previous-voice-state vs2)))
- (if (and (null? (span-state vs1)) (null? (span-state vs2)))
- (put 'chords))
-
- ))))
- )))
-
-
-
- (if (< ri (vector-length result))
- (let*
- ((now-state (vector-ref result ri))
- (vs1 (car (voice-states now-state)))
- (vs2 (cdr (voice-states now-state))))
-
- (cond
- ((not vs1) (put 'apart))
- ((not vs2) (put 'apart))
- (else
- (let*
- (
- (active1 (previous-span-state vs1))
- (active2 (previous-span-state vs2))
-
- (new-active1 (span-state vs1))
- (new-active2 (span-state vs2)) )
- (if
- pc-debug
- (display (list (when now-state) 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-a2 ri)
- (if (< ri (vector-length result))
- (let*
- ((now-state (vector-ref result ri))
- (vs1 (car (voice-states now-state)))
- (vs2 (cdr (voice-states now-state))) )
-
- (if (and (equal? (configuration now-state) 'chords)
- vs1 vs2)
-
- (let*
- ((notes1 (note-events vs1))
- (notes2 (note-events vs2)) )
- (cond
- ((and
- (= 1 (length notes1))
- (= 1 (length notes2))
- (equal? (ly:get-mus-property (car notes1) 'pitch)
- (ly:get-mus-property (car notes2) 'pitch)))
-
- (set! (configuration now-state) 'unisono))
- ((and
- (= 0 (length notes1))
- (= 0 (length notes2)))
- (set! (configuration now-state) 'unisilence)))
-
- ))
- (analyse-a2 (1+ ri))
-
- )))
-
- (define (analyse-solo12 ri)
-
- (define (previous-config vs)
- (let* ((pvs (previous-voice-state vs))
+ (let ((i (if (pair? index) (car index) result-idx)))
+ (if (and (<= 0 i)
+ (not (symbol? (configuration (vector-ref result i)))))
+ (begin
+ (set! (configuration (vector-ref result i)) x)
+ (put x (1- i))))))
+
+ (define (copy-state-from state-vec vs)
+ (define (copy-one-state key-idx)
+ (let* ((idx (cdr key-idx))
+ (prev-ss (vector-ref result idx))
+ (prev (configuration prev-ss)))
+ (if (symbol? prev)
+ (put prev))))
+ (map copy-one-state (span-state vs)))
+
+ (define (analyse-notes now-state)
+ (let* ((vs1 (car (voice-states now-state)))
+ (vs2 (cdr (voice-states now-state)))
+ (notes1 (note-events vs1))
+ (durs1 (sort (map (lambda (x) (ly:event-property x 'duration))
+ notes1)
+ ly:duration<?))
+ (pitches1 (sort (map (lambda (x) (ly:event-property x 'pitch))
+ notes1)
+ ly:pitch<?))
+ (notes2 (note-events vs2))
+ (durs2 (sort (map (lambda (x) (ly:event-property x 'duration))
+ notes2)
+ ly:duration<?))
+ (pitches2 (sort (map (lambda (x) (ly:event-property x 'pitch))
+ notes2)
+ ly:pitch<?)))
+ (cond ((> (length notes1) 1) (put 'apart))
+ ((> (length notes2) 1) (put 'apart))
+ ((= 1 (+ (length notes2) (length notes1))) (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)
+ (or
+ (< chord-threshold (ly:pitch-steps
+ (ly:pitch-diff (car pitches1)
+ (car pitches2))))
+
+ ;; voice crossings:
+ (> 0 (ly:pitch-steps (ly:pitch-diff (car pitches1)
+ (car pitches2))))
+ ))
+ (put 'apart)
+ ;; copy previous split state from spanner state
+ (begin
+ (if (previous-voice-state vs1)
+ (copy-state-from voice-state-vec1
+ (previous-voice-state vs1)))
+ (if (previous-voice-state vs2)
+ (copy-state-from voice-state-vec2
+ (previous-voice-state vs2)))
+ (if (and (null? (span-state vs1)) (null? (span-state vs2)))
+ (put 'chords)))))))))
+
+ (if (< result-idx (vector-length result))
+ (let* ((now-state (vector-ref result result-idx))
+ (vs1 (car (voice-states now-state)))
+ (vs2 (cdr (voice-states now-state))))
+
+ (cond ((not vs1) (put 'apart))
+ ((not vs2) (put 'apart))
+ (else
+ (let ((active1 (previous-span-state vs1))
+ (active2 (previous-span-state vs2))
+ (new-active1 (span-state vs1))
+ (new-active2 (span-state vs2)))
+ (if #f ; debug
+ (display (list (when now-state) result-idx
+ 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+ result-idx)))))))
+
+ (define (analyse-a2 result-idx)
+ (if (< result-idx (vector-length result))
+ (let* ((now-state (vector-ref result result-idx))
+ (vs1 (car (voice-states now-state)))
+ (vs2 (cdr (voice-states now-state))))
+ (if (and (equal? (configuration now-state) 'chords)
+ vs1 vs2)
+ (let ((notes1 (note-events vs1))
+ (notes2 (note-events vs2)))
+ (cond ((and (= 1 (length notes1))
+ (= 1 (length notes2))
+ (equal? (ly:event-property (car notes1) 'pitch)
+ (ly:event-property (car notes2) 'pitch)))
+ (set! (configuration now-state) 'unisono))
+ ((and (= 0 (length notes1))
+ (= 0 (length notes2)))
+ (set! (configuration now-state) 'unisilence)))))
+ (analyse-a2 (1+ result-idx)))))
+
+ (define (analyse-solo12 result-idx)
+
+ (define (previous-config vs)
+ (let* ((pvs (previous-voice-state vs))