-
- (let*
- ((now-state (vector-ref result ri))
- (vs1 (car (voice-states now-state)))
- (vs2 (cdr (voice-states now-state)))
- (notes1 (if vs1 (note-events vs1) '()))
- (notes2 (if vs2 (note-events vs2) '()))
- (n1 (length notes1))
- (n2 (length notes2)) )
-
- (cond
- ((and (= n1 0) (= n2 0))
- (put 'apart-silence)
- (1+ ri) )
-
- ((and (= n2 0)
- (equal? (when vs1) (when now-state))
- (null? (previous-span-state vs1)))
- (try-solo 'solo1 ri ri))
- ((and (= n1 0)
- (equal? (when vs2) (when now-state))
- (null? (previous-span-state vs2)))
- (try-solo 'solo2 ri ri))
- (else
- (1+ ri))
- )))
-
- (if (< ri (vector-length result))
- (if (equal? (configuration (vector-ref result ri)) 'apart)
- (analyse-solo12 (analyse-moment ri))
- (analyse-solo12 (1+ ri)))) )
-
-
- (analyse-spanner-states voice-state-vec1)
- (analyse-spanner-states voice-state-vec2)
-
- (if #f
- (begin
- (display voice-state-vec1)
- (display "***\n")
- (display voice-state-vec2)
- (display "***\n")
- (display result)
- (display "***\n")
- ))
-
- (analyse-time-step 0)
- (analyse-a2 0)
-; (display result)
- (analyse-solo12 0)
-; (if pc-debug (display result))
-
- (set! result (map
- (lambda (x) (cons (when x) (configuration x)))
- (vector->list result)))
-
- (if pc-debug (display result))
- result))
+ (if (< current-idx (vector-length result))
+ (let* ((now-state (vector-ref result current-idx))
+ (solo-state (current-voice-state now-state (if (equal? type 'solo1) 1 2)))
+ (silent-state (current-voice-state now-state (if (equal? type 'solo1) 2 1)))
+ (silent-notes (if silent-state (note-events silent-state) '()))
+ (solo-notes (if solo-state (note-events solo-state) '())))
+ ;; (display (list "trying " type " at " (when now-state) solo-state silent-state "\n"))
+ (cond ((not (equal? (configuration now-state) 'apart))
+ current-idx)
+ ((> (length silent-notes) 0) start-idx)
+ ((not solo-state)
+ (put-range type start-idx current-idx)
+ current-idx)
+ ((and
+ (null? (span-state solo-state)))
+
+ ;;
+ ;; This includes rests. This isn't a problem: long rests
+ ;; will be shared with the silent voice, and be marked
+ ;; as unisilence. Therefore, long rests won't
+ ;; accidentally be part of a solo.
+ ;;
+ (put-range type start-idx current-idx)
+ (try-solo type (1+ current-idx) (1+ current-idx)))
+ (else
+ (try-solo type start-idx (1+ current-idx)))))
+ ;; try-solo
+ start-idx))
+
+ (define (analyse-moment result-idx)
+ "Analyse 'apart starting at RESULT-IDX. Return next index. "
+ (let* ((now-state (vector-ref result result-idx))
+ (vs1 (current-voice-state now-state 1))
+ (vs2 (current-voice-state now-state 2))
+ ;; (vs1 (car (voice-states now-state)))
+ ;; (vs2 (cdr (voice-states now-state)))
+ (notes1 (if vs1 (note-events vs1) '()))
+ (notes2 (if vs2 (note-events vs2) '()))
+ (n1 (length notes1))
+ (n2 (length notes2)))
+ ;; (display (list "analyzing step " result-idx " moment " (when now-state) vs1 vs2 "\n"))
+ (max
+ ;; we should always increase.
+ (cond ((and (= n1 0) (= n2 0))
+ (put 'apart-silence)
+ (1+ result-idx))
+ ((and (= n2 0)
+ (equal? (when vs1) (when now-state))
+ (null? (previous-span-state vs1)))
+ (try-solo 'solo1 result-idx result-idx))
+ ((and (= n1 0)
+ (equal? (when vs2) (when now-state))
+ (null? (previous-span-state vs2)))
+ (try-solo 'solo2 result-idx result-idx))
+
+ (else (1+ result-idx)))
+ ;; analyse-moment
+ (1+ result-idx))))
+
+ (if (< result-idx (vector-length result))
+ (if (equal? (configuration (vector-ref result result-idx)) 'apart)
+ (analyse-solo12 (analyse-moment result-idx))
+ (analyse-solo12 (1+ result-idx))))) ; analyse-solo12
+
+ (analyse-spanner-states voice-state-vec1)
+ (analyse-spanner-states voice-state-vec2)
+ (if #f
+ (begin
+ (display voice-state-vec1)
+ (display "***\n")
+ (display voice-state-vec2)
+ (display "***\n")
+ (display result)
+ (display "***\n")))
+ (analyse-time-step 0)
+ ;; (display result)
+ (analyse-a2 0)
+ ;;(display result)
+ (analyse-solo12 0)
+ ;; (display result)
+ (set! result (map
+ (lambda (x) (cons (when x) (configuration x)))
+ (vector->list result)))
+ (if #f ;; pc-debug
+ (display result))
+ result))