From c962a0162c67d8b67593c848d08c9345c8b045f0 Mon Sep 17 00:00:00 2001 From: Dan Eble Date: Sat, 30 May 2015 12:46:44 -0400 Subject: [PATCH] Issue 4485: Refactor \partcombine and \autochange iterators Move the \partcombine context state machine from C++ to Scheme and move the part-specific work into a new Part_combine_part_iterator. What remains in Part_combine_iterator is multi-measure rest handling. The part-specific work is now nothing more than changing context at specified times, which is basically what \autochange does. There are still some differences, but most of the implementation of both is now in the common base Change_sequence_iterator. --- lily/auto-change-iterator.cc | 53 +------ lily/change-sequence-iterator.cc | 67 ++++++++ lily/include/change-sequence-iterator.hh | 47 ++++++ lily/part-combine-iterator.cc | 191 +---------------------- lily/part-combine-part-iterator.cc | 60 +++++++ ly/music-functions-init.ly | 35 ++++- scm/autochange.scm | 11 +- scm/define-music-display-methods.scm | 41 ++--- scm/define-music-properties.scm | 2 +- scm/define-music-types.scm | 8 + scm/part-combiner.scm | 97 +++++++++--- 11 files changed, 324 insertions(+), 288 deletions(-) create mode 100644 lily/change-sequence-iterator.cc create mode 100644 lily/include/change-sequence-iterator.hh create mode 100644 lily/part-combine-part-iterator.cc diff --git a/lily/auto-change-iterator.cc b/lily/auto-change-iterator.cc index 95784ec03b..55ff27d316 100644 --- a/lily/auto-change-iterator.cc +++ b/lily/auto-change-iterator.cc @@ -18,61 +18,24 @@ */ #include "change-iterator.hh" -#include "context.hh" -#include "direction.hh" -#include "international.hh" -#include "music.hh" -#include "music-wrapper-iterator.hh" +#include "change-sequence-iterator.hh" -class Auto_change_iterator : public Music_wrapper_iterator +class Auto_change_iterator : public Change_sequence_iterator { public: DECLARE_SCHEME_CALLBACK (constructor, ()); + Auto_change_iterator () {} - Auto_change_iterator (); - -protected: - virtual void construct_children (); - virtual void process (Moment); private: - SCM split_list_; + virtual void change_to (const string &id); }; void -Auto_change_iterator::process (Moment m) -{ - Moment *splitm = 0; - - for (; scm_is_pair (split_list_); split_list_ = scm_cdr (split_list_)) - { - splitm = unsmob (scm_caar (split_list_)); - if (*splitm > m) - break; - - // N.B. change_to() returns an error message. Silence is the legacy - // behavior here, but maybe that should be changed. - Change_iterator::change_to (*child_iter_, - ly_symbol2scm ("Staff"), - ly_scm2string (scm_cdar (split_list_))); - } - - Music_wrapper_iterator::process (m); -} - -Auto_change_iterator::Auto_change_iterator () -{ - split_list_ = SCM_EOL; -} - -void -Auto_change_iterator::construct_children () +Auto_change_iterator::change_to (const string &id) { - split_list_ = get_music ()->get_property ("split-list"); - - Context *voice = get_outlet()->find_create_context (ly_symbol2scm ("Voice"), - "", SCM_EOL); - set_context (voice); - Music_wrapper_iterator::construct_children (); + // N.B. change_to() returns an error message. Silence is the legacy + // behavior here, but maybe that should be changed. + Change_iterator::change_to (*child_iter_, ly_symbol2scm ("Staff"), id); } IMPLEMENT_CTOR_CALLBACK (Auto_change_iterator); diff --git a/lily/change-sequence-iterator.cc b/lily/change-sequence-iterator.cc new file mode 100644 index 0000000000..02ed77dd06 --- /dev/null +++ b/lily/change-sequence-iterator.cc @@ -0,0 +1,67 @@ +/* + This file is part of LilyPond, the GNU music typesetter. + + Copyright (C) 2015 Daniel Eble + + LilyPond is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + LilyPond is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with LilyPond. If not, see . +*/ + +#include "change-sequence-iterator.hh" +#include "context.hh" +#include "music.hh" + +Change_sequence_iterator::Change_sequence_iterator () : + change_list_(SCM_EOL) +{ +} + +void +Change_sequence_iterator::construct_children () +{ + Music_wrapper_iterator::construct_children (); + + change_list_ = get_music ()->get_property ("context-change-list"); +} + +void +Change_sequence_iterator::process (Moment m) +{ + // Find the ID of the output context to use now. The loop is a bit of + // paranoia; we shouldn't expect multiple changes between moments in this + // part. + SCM context_id = SCM_EOL; + for (; scm_is_pair (change_list_); change_list_ = scm_cdr (change_list_)) + { + SCM mom_scm = scm_caar (change_list_); + Moment *mom = unsmob (mom_scm); + if (mom) + { + if (*mom > m) + break; + + context_id = scm_cdar (change_list_); + } + else + { + string s = "expected moment in change list: "; + s += ly_scm2string (mom_scm); + programming_error (s); + } + } + + if (!scm_is_null (context_id)) + change_to (ly_symbol2string (context_id)); + + Music_wrapper_iterator::process (m); +} diff --git a/lily/include/change-sequence-iterator.hh b/lily/include/change-sequence-iterator.hh new file mode 100644 index 0000000000..2c2dfe3eb0 --- /dev/null +++ b/lily/include/change-sequence-iterator.hh @@ -0,0 +1,47 @@ +/* + This file is part of LilyPond, the GNU music typesetter. + + Copyright (C) 2015 Daniel Eble + + LilyPond is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + LilyPond is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with LilyPond. If not, see . +*/ + +#ifndef CHANGE_SEQUENCE_ITERATOR_HH +#define CHANGE_SEQUENCE_ITERATOR_HH + +#include "music-wrapper-iterator.hh" +#include "context.hh" + +/** base for iterators that perform a sequence of timed context changes */ +class Change_sequence_iterator : public Music_wrapper_iterator +{ +public: + Change_sequence_iterator (); + +protected: + virtual void construct_children (); + virtual void process (Moment); + +private: + // implement in derived class to effect a context change + virtual void change_to (const string &id) = 0; + +private: + // There is no need to protect this in derived_mark() because it is protected + // via Music_iterator::music_. + SCM change_list_; +}; + + +#endif /* CHANGE_SEQUENCE_ITERATOR_HH */ diff --git a/lily/part-combine-iterator.cc b/lily/part-combine-iterator.cc index 8754effd29..f742d75a73 100644 --- a/lily/part-combine-iterator.cc +++ b/lily/part-combine-iterator.cc @@ -26,12 +26,6 @@ #include "warn.hh" #include "lily-imports.hh" -static const char *const CONTEXT_ONE = "one"; -static const char *const CONTEXT_TWO = "two"; -static const char *const CONTEXT_SHARED = "shared"; -static const char *const CONTEXT_SOLO = "solo"; -static const char *const CONTEXT_NULL = "null"; - class Part_combine_iterator : public Music_iterator { public: @@ -53,34 +47,10 @@ private: static const size_t NUM_PARTS = 2; Music_iterator *iterators_[NUM_PARTS]; - SCM split_list_; - Stream_event *mmrest_event_; - enum Status - { - INITIAL, - APART, - TOGETHER, - SOLO, - UNISONO, - UNISILENCE, - }; - Status state_; - - // For states in which it matters, this is the relevant part, - // e.g. 1 for Solo I, 2 for Solo II. - int chosen_part_; - - void substitute_one (Music_iterator *iter, const char *voice_id); - void substitute_both (const char *part1_voice_id, const char *part2_voice_id); bool is_active_outlet (const Context *c) const; void kill_mmrest (Context *c); - void chords_together (); - void solo1 (); - void solo2 (); - void apart (); - void unisono (bool silent, int newpart); }; const size_t Part_combine_iterator::NUM_PARTS; @@ -99,9 +69,6 @@ Part_combine_iterator::Part_combine_iterator () for (size_t i = 0; i < NUM_PARTS; i++) iterators_[i] = 0; - split_list_ = SCM_EOL; - state_ = INITIAL; - chosen_part_ = 1; } void @@ -147,45 +114,6 @@ Part_combine_iterator::ok () const return false; } -void -Part_combine_iterator::substitute_one (Music_iterator *iter, - const char *voice_id) -{ - Context *c = iter->get_outlet (); - if (!c) - { - programming_error ("no context"); - return; - } - c = c->get_parent_context (); - if (!c) - { - programming_error ("no parent context"); - return; - } - c = find_context_below (c, ly_symbol2scm("Voice"), voice_id); - if (!c) - { - string s = "can not find Voice context: "; - s += voice_id; - programming_error (s); - return; - } - iter->substitute_outlet (iter->get_outlet (), c); -} - -void -Part_combine_iterator::substitute_both (const char *part1_voice_id, - const char *part2_voice_id) -{ - // TODO: There is no good reason to tie the parts together here. - // Factor out per-part stuff into a new class of iterator which - // reads a part-specific list similar to the existing combined - // "split-list". - substitute_one(iterators_[0], part1_voice_id); - substitute_one(iterators_[1], part2_voice_id); -} - bool Part_combine_iterator::is_active_outlet (const Context *c) const { for (size_t i = 0; i < NUM_PARTS; i++) @@ -210,80 +138,9 @@ Part_combine_iterator::kill_mmrest (Context *c) c->event_source ()->broadcast (mmrest_event_); } -void -Part_combine_iterator::unisono (bool silent, int newpart) -{ - Status newstate = (silent) ? UNISILENCE : UNISONO; - - if ((newstate == state_) and (newpart == chosen_part_)) - return; - else - { - const char *c1 = (newpart == 2) ? CONTEXT_NULL : CONTEXT_SHARED; - const char *c2 = (newpart == 2) ? CONTEXT_SHARED : CONTEXT_NULL; - substitute_both (c1, c2); - - state_ = newstate; - chosen_part_ = newpart; - } -} - -void -Part_combine_iterator::solo1 () -{ - if ((state_ == SOLO) && (chosen_part_ == 1)) - return; - else - { - state_ = SOLO; - chosen_part_ = 1; - substitute_both (CONTEXT_SOLO, CONTEXT_NULL); - } -} - -void -Part_combine_iterator::solo2 () -{ - if ((state_ == SOLO) and (chosen_part_ == 2)) - return; - else - { - state_ = SOLO; - chosen_part_ = 2; - substitute_both (CONTEXT_NULL, CONTEXT_SOLO); - } -} - -void -Part_combine_iterator::chords_together () -{ - if (state_ == TOGETHER) - return; - else - { - state_ = TOGETHER; - - substitute_both (CONTEXT_SHARED, CONTEXT_SHARED); - } -} - -void -Part_combine_iterator::apart () -{ - if (state_ == APART) - return; - else - { - state_ = APART; - substitute_both (CONTEXT_ONE, CONTEXT_TWO); - } -} - void Part_combine_iterator::construct_children () { - split_list_ = get_music ()->get_property ("split-list"); - SCM lst = get_music ()->get_property ("elements"); iterators_[0] = unsmob (get_iterator (unsmob (scm_car (lst)))); iterators_[1] = unsmob (get_iterator (unsmob (scm_cadr (lst)))); @@ -292,56 +149,12 @@ Part_combine_iterator::construct_children () void Part_combine_iterator::process (Moment m) { - Moment *splitm = 0; - Context *prev_active_outlets[NUM_PARTS]; - for (size_t i = 0; i < NUM_PARTS; i++) - prev_active_outlets[i] = iterators_[i]->get_outlet (); - - for (; scm_is_pair (split_list_); split_list_ = scm_cdr (split_list_)) - { - splitm = unsmob (scm_caar (split_list_)); - if (splitm && *splitm > m) - break; - - SCM tag = scm_cdar (split_list_); - - if (scm_is_eq (tag, ly_symbol2scm ("chords"))) - chords_together (); - else if (scm_is_eq (tag, ly_symbol2scm ("apart")) - || scm_is_eq (tag, ly_symbol2scm ("apart-silence")) - || scm_is_eq (tag, ly_symbol2scm ("apart-spanner"))) - apart (); - else if (scm_is_eq (tag, ly_symbol2scm ("unisono"))) - { - // Continue to use the most recently used part because we might have - // killed mmrests in the other part. - unisono (false, (chosen_part_ == 2) ? 2 : 1); - } - else if (scm_is_eq (tag, ly_symbol2scm ("unisilence"))) - { - // as for unisono - unisono (true, (chosen_part_ == 2) ? 2 : 1); - } - else if (scm_is_eq (tag, ly_symbol2scm ("silence1"))) - unisono (true, 1); - else if (scm_is_eq (tag, ly_symbol2scm ("silence2"))) - unisono (true, 2); - else if (scm_is_eq (tag, ly_symbol2scm ("solo1"))) - solo1 (); - else if (scm_is_eq (tag, ly_symbol2scm ("solo2"))) - solo2 (); - else if (scm_is_symbol (tag)) - { - string s = "Unknown split directive: " - + (scm_is_symbol (tag) ? ly_symbol2string (tag) : string ("not a symbol")); - programming_error (s); - } - } - bool any_outlet_changed = false; for (size_t i = 0; i < NUM_PARTS; i++) { + prev_active_outlets[i] = iterators_[i]->get_outlet (); + if (iterators_[i]->ok ()) iterators_[i]->process (m); diff --git a/lily/part-combine-part-iterator.cc b/lily/part-combine-part-iterator.cc new file mode 100644 index 0000000000..b9262d92fd --- /dev/null +++ b/lily/part-combine-part-iterator.cc @@ -0,0 +1,60 @@ +/* + This file is part of LilyPond, the GNU music typesetter. + + Copyright (C) 2015 Daniel Eble + + LilyPond is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + LilyPond is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with LilyPond. If not, see . +*/ + +#include "change-sequence-iterator.hh" +#include "context.hh" + +class Part_combine_part_iterator : public Change_sequence_iterator +{ +public: + DECLARE_SCHEME_CALLBACK (constructor, ()); + Part_combine_part_iterator () {} + +private: + virtual void change_to (const string &id); + Context *find_voice(const string &id); +}; + +void +Part_combine_part_iterator::change_to (const string &id) +{ + Context *voice = find_voice (id); + if (voice) + substitute_outlet (get_outlet (), voice); + else + { + string s = "can not find Voice context: "; + s += id; + programming_error (s); + } +} + +Context * +Part_combine_part_iterator::find_voice (const string &id) +{ + // Find a Voice among the siblings of the current outlet. (Well, this might + // also find a sibling's descendant, but that should not be a problem.) + Context *c = get_outlet ()->get_parent_context (); + if (c) + return find_context_below (c, ly_symbol2scm("Voice"), id); + programming_error ("no parent context"); + return 0; +} + +IMPLEMENT_CTOR_CALLBACK (Part_combine_part_iterator); diff --git a/ly/music-functions-init.ly b/ly/music-functions-init.ly index 64cfa134b3..cda5e73957 100644 --- a/ly/music-functions-init.ly +++ b/ly/music-functions-init.ly @@ -1209,12 +1209,42 @@ parenthesize = two-context-settings shared-context-settings) - (let* ((pc-music (make-part-combine-music (list part1 part2) direction chord-range)) + (let* ((pc-music (make-music 'PartCombineMusic)) + (m1 (context-spec-music (make-non-relative-music part1) 'Voice "one")) + (m2 (context-spec-music (make-non-relative-music part2) 'Voice "two")) + (listener (ly:parser-lookup 'partCombineListener)) + (evs2 (recording-group-emulate m2 listener)) + (evs1 (recording-group-emulate m1 listener)) + (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) + '())) (L1 (ly:music-length part1)) (L2 (ly:music-length part2)) ;; keep the contexts alive for the full duration (skip (make-skip-music (make-duration-of-length (if (ly:moment> #} )) partcombine = diff --git a/scm/autochange.scm b/scm/autochange.scm index efc91edde1..3e1d4b9775 100644 --- a/scm/autochange.scm +++ b/scm/autochange.scm @@ -28,17 +28,16 @@ (if change-moment change-moment now) - (if (< dir 0) "down" "up")) acc)) + (if (< dir 0) 'down 'up)) acc)) (generate-split-list (if pitch #f (if change-moment change-moment now)) dir (cdr event-list) acc))))) (let* ((m (make-music 'AutoChangeMusic)) - (m1 (make-non-relative-music (context-spec-music music 'Voice "one"))) - (context-list (recording-group-emulate music + (m1 (context-spec-music (make-non-relative-music music) 'Voice "")) + (context-list (recording-group-emulate m1 (ly:parser-lookup 'partCombineListener))) - (evs (car context-list)) (rev (reverse! (cdar context-list))) (split (reverse! (generate-split-list #f @@ -46,6 +45,6 @@ rev '()) '()))) - (set! (ly:music-property m 'element) music) - (set! (ly:music-property m 'split-list) split) + (set! (ly:music-property m 'element) m1) + (set! (ly:music-property m 'context-change-list) split) m)) diff --git a/scm/define-music-display-methods.scm b/scm/define-music-display-methods.scm index 04c9c8beb3..8708cc1d73 100644 --- a/scm/define-music-display-methods.scm +++ b/scm/define-music-display-methods.scm @@ -642,7 +642,8 @@ Otherwise, return #f." (define-display-method AutoChangeMusic (m) (format #f "\\autochange ~a" - (music->lily-string (ly:music-property m 'element)))) + (music->lily-string + (ly:music-property (ly:music-property m 'element) 'element)))) (define-display-method ContextChange (m) (format #f "\\change ~a = \"~a\"" @@ -1002,31 +1003,19 @@ Otherwise, return #f." ;;; \partcombine (define-display-method PartCombineMusic (expr) - (format #f "\\partcombine ~{~a ~}" - (map-in-order (lambda (music) - (music->lily-string music)) - (ly:music-property expr 'elements)))) - -(define-extra-display-method PartCombineMusic (expr) - (with-music-match (expr (music 'PartCombineMusic - direction ?dir - elements ((music 'UnrelativableMusic - element (music 'ContextSpeccedMusic - context-id "one" - context-type 'Voice - element ?sequence1)) - (music 'UnrelativableMusic - element (music 'ContextSpeccedMusic - context-id "two" - context-type 'Voice - element ?sequence2))))) - (format #f "\\partcombine~a ~a~a~a" - (cond ((equal? ?dir UP) "Up") - ((equal? ?dir DOWN) "Down") - (else "")) - (music->lily-string ?sequence1) - (new-line->lily-string) - (music->lily-string ?sequence2)))) + (let ((dir (ly:music-property expr 'direction))) + (format #f "\\partcombine~a ~a~a~a" + (cond ((equal? dir UP) "Up") + ((equal? dir DOWN) "Down") + (else "")) + (music->lily-string (car (ly:music-property expr 'elements))) + (new-line->lily-string) + (music->lily-string (cadr (ly:music-property expr 'elements)))))) + +(define-display-method PartCombinePartMusic (expr) + (with-music-match ((ly:music-property expr 'element) + (music 'ContextSpeccedMusic element ?part)) + (format #f "~a" (music->lily-string ?part)))) (define-extra-display-method ContextSpeccedMusic (expr) "If `expr' is a \\partcombine expression, return \"\\partcombine ...\". diff --git a/scm/define-music-properties.scm b/scm/define-music-properties.scm index 422e65c106..0bcc5a20af 100644 --- a/scm/define-music-properties.scm +++ b/scm/define-music-properties.scm @@ -68,6 +68,7 @@ cautionary accidental.") (change-to-type ,symbol? "Type of the context to change to.") (class ,symbol? "The class name of an event class.") (context ,ly:context? "The context to which an event is sent.") + (context-change-list ,list? "Context changes for @code{\\autochange} or @code{\\partcombine}.") (context-id ,string? "Name of context.") (context-type ,symbol? "Type of context.") (create-new ,boolean? "Create a fresh context.") @@ -184,7 +185,6 @@ Options are @code{'text} and @code{'hairpin}.") (span-text ,markup? "The displayed text for dynamic text spanners (e.g., cresc.)") (spanner-id ,string? "Identifier to distinguish concurrent spanners.") - (split-list ,list? "Splitting moments for part combiner.") (start-callback ,procedure? "Function to compute the negative length of starting grace notes. This property can only be defined as initializer in @file{scm/@/define-music-types.scm}.") diff --git a/scm/define-music-types.scm b/scm/define-music-types.scm index e381fa2713..5ae59799f6 100644 --- a/scm/define-music-types.scm +++ b/scm/define-music-types.scm @@ -411,6 +411,14 @@ as separate voices.") (iterator-ctor . ,ly:part-combine-iterator::constructor) )) + (PartCombinePartMusic + . ((description . "A part to be combined with other parts on a staff.") + (length-callback . ,ly:music-wrapper::length-callback) + (start-callback . ,ly:music-wrapper::start-callback) + (iterator-ctor . ,ly:part-combine-part-iterator::constructor) + (types . (part-combine-part-music music-wrapper-music)) + )) + (PercentEvent . ((description . "Used internally to signal percent repeats.") (types . (event percent-event rhythmic-event)) diff --git a/scm/part-combiner.scm b/scm/part-combiner.scm index b8661afe2b..85548030ec 100644 --- a/scm/part-combiner.scm +++ b/scm/part-combiner.scm @@ -299,24 +299,6 @@ LilyPond version 2.8 and earlier." global) context-list)) -(define-public (make-part-combine-music 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 '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) @@ -803,6 +785,85 @@ the mark when there are no spanners active. (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 name mus) -- 2.39.2