- (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 (< 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 " (moment 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-apart-silence result-idx)
+ "Analyse 'apart-silence 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))
+ (rests1 (if vs1 (rest-and-skip-events vs1) '()))
+ (rests2 (if vs2 (rest-and-skip-events vs2) '()))
+ (prev-state (if (> result-idx 0)
+ (vector-ref result (- result-idx 1))
+ #f))
+ (prev-config (if prev-state
+ (configuration prev-state)
+ 'apart-silence)))
+ (cond
+ ;; rest with multi-measure rest: choose the rest
+ ((and (synced? now-state)
+ (= 1 (length rests1))
+ (ly:in-event-class? (car rests1) 'rest-event)
+ (= 0 (length rests2))) ; probably mmrest
+ (put 'silence1))
+
+ ;; as above with parts swapped
+ ((and (synced? now-state)
+ (= 1 (length rests2))
+ (ly:in-event-class? (car rests2) 'rest-event)
+ (= 0 (length rests1))) ; probably mmrest
+ (put 'silence2))
+
+ ((synced? now-state)
+ (put 'apart-silence))
+
+ ;; remain in the silence1/2 states until resync
+ ((equal? prev-config 'silence1)
+ (put 'silence1))
+
+ ((equal? prev-config 'silence2)
+ (put 'silence2))
+
+ (else
+ (put 'apart-silence)))
+
+ (1+ result-idx)))
+
+ (define (analyse-apart 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 " (moment now-state) vs1 vs2 "\n"))
+ (max
+ ;; we should always increase.
+ (cond ((and (= n1 0) (= n2 0))
+ ;; If we hit this, it means that the previous passes
+ ;; have designated as 'apart what is really
+ ;; 'apart-silence.
+ (analyse-apart-silence result-idx))
+ ((and (= n2 0)
+ (equal? (moment vs1) (moment now-state))
+ (null? (previous-span-state vs1)))
+ (try-solo 'solo1 result-idx result-idx))
+ ((and (= n1 0)
+ (equal? (moment vs2) (moment now-state))
+ (null? (previous-span-state vs2)))
+ (try-solo 'solo2 result-idx result-idx))
+
+ (else (1+ result-idx)))
+ ;; analyse-moment
+ (1+ result-idx))))