(display (span-state x) file)
(display "\n" file))
+;; Return the duration of the longest event in the Voice-state.
+(define-method (duration (vs <Voice-state>))
+ (define (duration-max event d1)
+ (let ((d2 (ly:event-property event 'duration #f)))
+ (if d2
+ (if (ly:duration<? d1 d2) d2 d1)
+ d1)))
+
+ (fold duration-max (ly:make-duration 0 0 0) (events vs)))
+
+;; Return the moment that the longest event in the Voice-state ends.
+(define-method (end-moment (vs <Voice-state>))
+ (ly:moment-add (moment vs) (ly:duration-length (duration vs))))
+
(define-method (note-events (vs <Voice-state>))
(define (f? x)
(ly:in-event-class? x 'note-event))
(if p (span-state p) '())))
(define (make-voice-states evl)
- (let ((vec (list->vector (map (lambda (v)
- (make <Voice-state>
- #:moment (caar v)
- #:tuning (cdar v)
- #:events (map car (cdr v))))
- evl))))
- (do ((i 0 (1+ i)))
- ((= i (vector-length vec)) vec)
- (slot-set! (vector-ref vec i) 'vector-index i)
- (slot-set! (vector-ref vec i) 'state-vector vec))))
+ (let* ((states (map (lambda (v)
+ (make <Voice-state>
+ #:moment (caar v)
+ #:tuning (cdar v)
+ #:events (map car (cdr v))))
+ (reverse evl))))
+
+ ;; add an entry with no events at the moment the last event ends
+ (if (pair? states)
+ (let ((last-real-event (car states)))
+ (set! states
+ (cons (make <Voice-state>
+ #:moment (end-moment last-real-event)
+ #:tuning (tuning last-real-event)
+ #:events '())
+ states))))
+
+ ;; TODO: Add an entry at +inf.0 and see if it allows us to remove
+ ;; the many instances of conditional code handling the case that
+ ;; there is no voice state at a given moment.
+
+ (let ((vec (list->vector (reverse! states))))
+ (do ((i 0 (1+ i)))
+ ((= i (vector-length vec)) vec)
+ (slot-set! (vector-ref vec i) 'vector-index i)
+ (slot-set! (vector-ref vec i) 'state-vector vec)))))
(define (make-split-state vs1 vs2)
"Merge lists VS1 and VS2, containing Voice-state objects into vector
global)
context-list))
-(define-public (make-part-combine-music parser music-list direction chord-range)
- (let* ((m (make-music 'PartCombineMusic))
- (m1 (make-non-relative-music (context-spec-music (first music-list) 'Voice "one")))
- (m2 (make-non-relative-music (context-spec-music (second music-list) 'Voice "two")))
- (listener (ly:parser-lookup parser 'partCombineListener))
- (evs2 (recording-group-emulate m2 listener))
- (evs1 (recording-group-emulate m1 listener)))
-
- (set! (ly:music-property m 'elements) (list m1 m2))
- (set! (ly:music-property m 'direction) direction)
- (set! (ly:music-property m 'split-list)
- (if (and (assoc "one" evs1) (assoc "two" evs2))
- (determine-split-list (reverse! (assoc-get "one" evs1) '())
- (reverse! (assoc-get "two" evs2) '())
- chord-range)
- '()))
- m))
-
(define-public (determine-split-list evl1 evl2 chord-range)
"@var{evl1} and @var{evl2} should be ascending. @var{chord-range} is a pair of numbers (min . max) defining the distance in steps between notes that may be combined into a chord or unison."
(let* ((pc-debug #f)
(define (analyse-forced-combine result-idx prev-res)
(define (get-forced-event x)
- (and (ly:in-event-class? x 'part-combine-force-event)
- (cons (ly:event-property x 'forced-type)
- (ly:event-property x 'once))))
+ (cond
+ ((and (ly:in-event-class? x 'SetProperty)
+ (eq? (ly:event-property x 'symbol) 'partCombineForced))
+ (cons (ly:event-property x 'value #f)
+ (ly:event-property x 'once #f)))
+ ((and (ly:in-event-class? x 'UnsetProperty)
+ (eq? (ly:event-property x 'symbol) 'partCombineForced))
+ (cons #f (ly:event-property x 'once #f)))
+ (else #f)))
+
(define (part-combine-events vs)
(if (not vs)
'()
(commit-segment)
(make-sequential-music (reverse! full-seq))))
+(define-public default-part-combine-context-change-state-machine-one
+ ;; (current-state . ((split-state-event . (output-voice next-state)) ...))
+ '((Initial . ((apart . (one . Initial))
+ (apart-silence . (one . Initial))
+ (apart-spanner . (one . Initial))
+ (chords . (shared . Initial))
+ (silence1 . (shared . Initial))
+ (silence2 . (null . Demoted))
+ (solo1 . (solo . Initial))
+ (solo2 . (null . Demoted))
+ (unisono . (shared . Initial))
+ (unisilence . (shared . Initial))))
+
+ ;; After a part has been used as the exclusive input for a
+ ;; passage, we want to use it by default for unisono/unisilence
+ ;; passages because Part_combine_iterator might have killed
+ ;; multi-measure rests in the other part. Here we call such a
+ ;; part "promoted". Part one begins promoted.
+ (Demoted . ((apart . (one . Demoted))
+ (apart-silence . (one . Demoted))
+ (apart-spanner . (one . Demoted))
+ (chords . (shared . Demoted))
+ (silence1 . (shared . Initial))
+ (silence2 . (null . Demoted))
+ (solo1 . (solo . Initial))
+ (solo2 . (null . Demoted))
+ (unisono . (null . Demoted))
+ (unisilence . (null . Demoted))))))
+
+(define-public default-part-combine-context-change-state-machine-two
+ ;; (current-state . ((split-state-event . (output-voice next-state)) ...))
+ '((Initial . ((apart . (two . Initial))
+ (apart-silence . (two . Initial))
+ (apart-spanner . (two . Initial))
+ (chords . (shared . Initial))
+ (silence1 . (null . Initial))
+ (silence2 . (shared . Promoted))
+ (solo1 . (null . Initial))
+ (solo2 . (solo . Promoted))
+ (unisono . (null . Initial))
+ (unisilence . (null . Initial))))
+
+ ;; See the part-one state machine for the meaning of "promoted".
+ (Promoted . ((apart . (two . Promoted))
+ (apart-silence . (two . Promoted))
+ (apart-spanner . (two . Promoted))
+ (chords . (shared . Promoted))
+ (silence1 . (null . Initial))
+ (silence2 . (shared . Promoted))
+ (solo1 . (null . Initial))
+ (solo2 . (solo . Promoted))
+ (unisono . (shared . Promoted))
+ (unisilence . (shared . Promoted))))))
+
+(define-public (make-part-combine-context-changes state-machine split-list)
+ "Generate a sequence of part combiner context changes from a split list"
+
+ (define (get-state state-name)
+ (assq-ref state-machine state-name))
+
+ (let ((change-list '())
+ (prev-voice #f)
+ (state (get-state 'Initial)))
+
+ (define (handle-split split)
+ (let* ((moment (car split))
+ (action (assq-ref state (cdr split))))
+ (if action
+ (let ((voice (car action))
+ (next-state-name (cdr action)))
+ (if (not (eq? voice prev-voice))
+ (begin
+ (set! change-list (cons (cons moment voice) change-list))
+ (set! prev-voice voice)))
+ (set! state (get-state next-state-name))))))
+
+ (for-each handle-split split-list)
+ (reverse! change-list)))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define-public (add-quotable parser name mus)
+(define-public (add-quotable name mus)
(let* ((tab (eval 'musicQuotes (current-module)))
(voicename (get-next-unique-voice-name))
;; recording-group-emulate returns an assoc list (reversed!), so
;; hand it a proper unique context name and extract that key:
(ctx-spec (context-spec-music mus 'Voice voicename))
- (listener (ly:parser-lookup parser 'partCombineListener))
+ (listener (ly:parser-lookup 'partCombineListener))
(context-list (reverse (recording-group-emulate ctx-spec listener)))
(raw-voice (assoc voicename context-list))
(quote-contents (if (pair? raw-voice) (cdr raw-voice) '())))
projects / lilypond.git / blobdiff