From bdfb3700c62cf27c650ed2029361a455a7c12233 Mon Sep 17 00:00:00 2001 From: David Kastrup Date: Mon, 16 Apr 2012 17:23:23 +0200 Subject: [PATCH] Change class field in stream events to contain the complete event type list --- lily/context.cc | 4 +++- lily/dispatcher.cc | 22 ++++------------------ lily/dynamic-engraver.cc | 2 +- lily/music.cc | 4 +++- lily/new-dynamic-engraver.cc | 2 +- lily/page-turn-engraver.cc | 2 +- lily/paper-column-engraver.cc | 2 +- lily/part-combine-engraver.cc | 2 +- lily/part-combine-iterator.cc | 16 ++++++++++++---- lily/stream-event.cc | 1 - scm/autochange.scm | 2 +- scm/define-event-classes.scm | 2 +- scm/output-lib.scm | 2 +- scm/part-combiner.scm | 12 ++++++------ scm/translation-functions.scm | 2 +- 15 files changed, 37 insertions(+), 40 deletions(-) diff --git a/lily/context.cc b/lily/context.cc index 34b75523ea..0551b3b702 100644 --- a/lily/context.cc +++ b/lily/context.cc @@ -452,7 +452,9 @@ be called from any other place than the send_stream_event macro. void Context::internal_send_stream_event (SCM type, Input *origin, SCM props[]) { - Stream_event *e = new Stream_event (type, origin); + Stream_event *e = new Stream_event + (scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), type), + origin); for (int i = 0; props[i]; i += 2) { e->set_property (props[i], props[i + 1]); diff --git a/lily/dispatcher.cc b/lily/dispatcher.cc index 4db7c93a15..f546064368 100644 --- a/lily/dispatcher.cc +++ b/lily/dispatcher.cc @@ -77,19 +77,13 @@ void Dispatcher::dispatch (SCM sev) { Stream_event *ev = unsmob_stream_event (sev); - SCM class_symbol = ev->get_property ("class"); - if (!scm_is_symbol (class_symbol)) - { - warning (_ ("Event class should be a symbol")); - return; - } - - SCM class_list = scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), class_symbol); + SCM class_list = ev->get_property ("class"); if (!scm_is_pair (class_list)) { - ev->origin ()->warning (_f ("Unknown event class %s", ly_symbol2string (class_symbol).c_str ())); + ev->origin ()->warning (_ ("Event class should be a list")); return; } + #if 0 bool sent = false; #endif @@ -176,15 +170,7 @@ Dispatcher::dispatch (SCM sev) bool Dispatcher::is_listened (Stream_event *ev) { - SCM class_symbol = ev->get_property ("class"); - if (!scm_is_symbol (class_symbol)) - { - warning (_ ("Event class should be a symbol")); - return false; - } - - for (SCM cl = scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), class_symbol); - scm_is_pair (cl); cl = scm_cdr (cl)) + for (SCM cl = ev->get_property ("class"); scm_is_pair (cl); cl = scm_cdr (cl)) { SCM list = scm_hashq_ref (listeners_, scm_car (cl), SCM_EOL); if (scm_is_pair (list)) diff --git a/lily/dynamic-engraver.cc b/lily/dynamic-engraver.cc index a3cb779521..c492e59c55 100644 --- a/lily/dynamic-engraver.cc +++ b/lily/dynamic-engraver.cc @@ -215,7 +215,7 @@ Dynamic_engraver::process_music () TODO: Use symbols. */ - SCM start_sym = current_cresc_ev_->get_property ("class"); + SCM start_sym = scm_car (current_cresc_ev_->get_property ("class")); string start_type; if (start_sym == ly_symbol2scm ("decrescendo-event")) diff --git a/lily/music.cc b/lily/music.cc index 7927fe3067..e96e83d59f 100644 --- a/lily/music.cc +++ b/lily/music.cc @@ -279,7 +279,9 @@ Music::to_event () const if (!internal_is_music_type (class_name)) programming_error ("Not a music type"); - Stream_event *e = new Stream_event (class_name, mutable_property_alist_); + Stream_event *e = new Stream_event + (scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), class_name), + mutable_property_alist_); Moment length = get_length (); if (length.to_bool ()) e->set_property ("length", length.smobbed_copy ()); diff --git a/lily/new-dynamic-engraver.cc b/lily/new-dynamic-engraver.cc index 1388235b1b..749f9aaa16 100644 --- a/lily/new-dynamic-engraver.cc +++ b/lily/new-dynamic-engraver.cc @@ -242,7 +242,7 @@ string New_dynamic_engraver::get_spanner_type (Stream_event *ev) { string type; - SCM start_sym = ev->get_property ("class"); + SCM start_sym = scm_car (ev->get_property ("class")); if (start_sym == ly_symbol2scm ("decrescendo-event")) type = "decrescendo"; diff --git a/lily/page-turn-engraver.cc b/lily/page-turn-engraver.cc index b18531cc1a..d7c7ccec32 100644 --- a/lily/page-turn-engraver.cc +++ b/lily/page-turn-engraver.cc @@ -172,7 +172,7 @@ IMPLEMENT_TRANSLATOR_LISTENER (Page_turn_engraver, break); void Page_turn_engraver::listen_break (Stream_event *ev) { - string name = ly_symbol2string (ev->get_property ("class")); + string name = ly_symbol2string (scm_car (ev->get_property ("class"))); if (name == "page-turn-event") { diff --git a/lily/paper-column-engraver.cc b/lily/paper-column-engraver.cc index de550aeb73..8ff894d8fa 100644 --- a/lily/paper-column-engraver.cc +++ b/lily/paper-column-engraver.cc @@ -162,7 +162,7 @@ Paper_column_engraver::handle_manual_breaks (bool only_do_permissions) for (vsize i = 0; i < break_events_.size (); i++) { string prefix; - SCM name_sym = break_events_[i]->get_property ("class"); + SCM name_sym = scm_car (break_events_[i]->get_property ("class")); string name = ly_symbol2string (name_sym); size_t end = name.rfind ("-event"); if (end) diff --git a/lily/part-combine-engraver.cc b/lily/part-combine-engraver.cc index 36d91f9ddf..6d11c155f8 100644 --- a/lily/part-combine-engraver.cc +++ b/lily/part-combine-engraver.cc @@ -79,7 +79,7 @@ Part_combine_engraver::Part_combine_engraver () void Part_combine_engraver::create_item (Stream_event *ev) { - SCM what = ev->get_property ("class"); + SCM what = scm_car (ev->get_property ("class")); SCM text = SCM_EOL; if (what == ly_symbol2scm ("solo-one-event")) text = get_property ("soloText"); diff --git a/lily/part-combine-iterator.cc b/lily/part-combine-iterator.cc index db6b77cbc6..e7bece69cb 100644 --- a/lily/part-combine-iterator.cc +++ b/lily/part-combine-iterator.cc @@ -223,7 +223,9 @@ Part_combine_iterator::kill_mmrest (int in) if (!mmrest_event_) { - mmrest_event_ = new Stream_event (ly_symbol2scm ("multi-measure-rest-event")); + mmrest_event_ = new Stream_event + (scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), + ly_symbol2scm ("multi-measure-rest-event"))); mmrest_event_->set_property ("duration", SCM_EOL); mmrest_event_->unprotect (); } @@ -256,7 +258,9 @@ Part_combine_iterator::unisono (bool silent) { if (!unisono_event_) { - unisono_event_ = new Stream_event (ly_symbol2scm ("unisono-event")); + unisono_event_ = new Stream_event + (scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), + ly_symbol2scm ("unisono-event"))); unisono_event_->unprotect (); } @@ -286,7 +290,9 @@ Part_combine_iterator::solo1 () { if (!solo_one_event_) { - solo_one_event_ = new Stream_event (ly_symbol2scm ("solo-one-event")); + solo_one_event_ = new Stream_event + (scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), + ly_symbol2scm ("solo-one-event"))); solo_one_event_->unprotect (); } @@ -311,7 +317,9 @@ Part_combine_iterator::solo2 () { if (!solo_two_event_) { - solo_two_event_ = new Stream_event (ly_symbol2scm ("solo-two-event")); + solo_two_event_ = new Stream_event + (scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), + ly_symbol2scm ("solo-two-event"))); solo_two_event_->unprotect (); } diff --git a/lily/stream-event.cc b/lily/stream-event.cc index ef801efc62..5ce03ec08d 100644 --- a/lily/stream-event.cc +++ b/lily/stream-event.cc @@ -69,7 +69,6 @@ bool Stream_event::internal_in_event_class (SCM class_name) { SCM cl = get_property ("class"); - cl = scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), cl); return scm_c_memq (class_name, cl) != SCM_BOOL_F; } diff --git a/scm/autochange.scm b/scm/autochange.scm index 54f5e96250..14252e4b1d 100644 --- a/scm/autochange.scm +++ b/scm/autochange.scm @@ -11,7 +11,7 @@ (evs (map car (cdar event-list))) (now (car now-tun)) (notes (filter (lambda (x) - (equal? (ly:event-property x 'class) 'note-event)) + (ly:in-event-class? x 'note-event)) evs)) (pitch (if (pair? notes) (ly:event-property (car notes) 'pitch) diff --git a/scm/define-event-classes.scm b/scm/define-event-classes.scm index fee440ad50..771513f5b4 100644 --- a/scm/define-event-classes.scm +++ b/scm/define-event-classes.scm @@ -96,7 +96,7 @@ (define-public (ly:in-event-class? ev cl) "Does event @var{ev} belong to event class @var{cl}?" - (memq cl (ly:make-event-class (ly:event-property ev 'class)))) + (memq cl (ly:event-property ev 'class))) ;; does this exist in guile already? (define (map-tree f t) diff --git a/scm/output-lib.scm b/scm/output-lib.scm index bb8f4ddf50..95fefbdb3a 100644 --- a/scm/output-lib.scm +++ b/scm/output-lib.scm @@ -900,7 +900,7 @@ and duration-log @var{log}." ;; dynamics (define-public (hairpin::calc-grow-direction grob) - (if (eq? (ly:event-property (event-cause grob) 'class) 'decrescendo-event) + (if (ly:in-event-class? (event-cause grob) 'decrescendo-event) START STOP)) diff --git a/scm/part-combiner.scm b/scm/part-combiner.scm index 88c0b88fa6..7deeeeb481 100644 --- a/scm/part-combiner.scm +++ b/scm/part-combiner.scm @@ -41,7 +41,7 @@ (define-method (note-events (vs )) (define (f? x) - (equal? (ly:event-property x 'class) 'note-event)) + (ly:in-event-class? x 'note-event)) (filter f? (events vs))) (define-method (previous-voice-state (vs )) @@ -130,19 +130,19 @@ Voice-state objects "Analyse EVS at INDEX, given state ACTIVE." (define (analyse-tie-start active ev) - (if (equal? (ly:event-property ev 'class) 'tie-event) + (if (ly:in-event-class? ev 'tie-event) (acons 'tie (split-index (vector-ref voice-state-vec index)) active) active)) (define (analyse-tie-end active ev) - (if (equal? (ly:event-property ev 'class) 'note-event) + (if (ly:in-event-class? ev 'note-event) (assoc-remove! active 'tie) active)) (define (analyse-absdyn-end active ev) - (if (or (equal? (ly:event-property ev 'class) 'absolute-dynamic-event) - (and (equal? (ly:event-property ev 'class) 'crescendo-event) + (if (or (ly:in-event-class? ev 'absolute-dynamic-event) + (and (ly:in-event-class? ev 'span-dynamic-event) (equal? STOP (ly:event-property ev 'span-direction)))) (assoc-remove! (assoc-remove! active 'cresc) 'decr) active)) @@ -153,7 +153,7 @@ Voice-state objects (else (< (cdr a) (cdr b))))) (define (analyse-span-event active ev) - (let* ((name (ly:event-property ev 'class)) + (let* ((name (car (ly:event-property ev 'class))) (key (cond ((equal? name 'slur-event) 'slur) ((equal? name 'phrasing-slur-event) 'tie) ((equal? name 'beam-event) 'beam) diff --git a/scm/translation-functions.scm b/scm/translation-functions.scm index a535497962..2dd8d2d92c 100644 --- a/scm/translation-functions.scm +++ b/scm/translation-functions.scm @@ -300,7 +300,7 @@ if no fingering is present." (map (lambda (art) (let* ((num (ly:event-property art 'digit))) - (if (and (eq? 'fingering-event (ly:event-property art 'class)) + (if (and (ly:in-event-class? art 'fingering-event) (number? num) (> num 0)) (set! finger-found num)))) -- 2.39.2