From: Han-Wen Nienhuys Date: Sun, 7 Nov 2004 20:05:37 +0000 (+0000) Subject: * scm/define-context-properties.scm (Module): change definition of X-Git-Tag: release/2.5.14~605 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=4d3e71c83947524c5ca2ae569cda04a0a85377b9;p=lilypond.git * scm/define-context-properties.scm (Module): change definition of graceSettings * lily/context-property.cc (Module): rename from translator-property.cc * lily/context.cc (context_name_symbol): new function * scm/music-functions.scm (add-grace-property): use list iso. vector for graceSettings remove set-{start,stop}-grace-properties. --- diff --git a/ChangeLog b/ChangeLog index dfc0e767fc..c534fec62c 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,20 @@ 2004-11-07 Han-Wen Nienhuys + * scm/define-context-properties.scm (Module): change definition of + graceSettings + + * lily/context-property.cc (Module): rename from + translator-property.cc + + * lily/context.cc (context_name_symbol): new function + + * lily/grace-engraver.cc: new file. Set properties for grobs based + on the grace-ness of now_moment(). + + * scm/music-functions.scm (add-grace-property): use list + iso. vector for graceSettings + remove set-{start,stop}-grace-properties. + * lily/new-quote-iterator.cc (construct_children): set quote_outlet_ if no quoted-context-{id,type} specified. diff --git a/lily/context-property.cc b/lily/context-property.cc new file mode 100644 index 0000000000..4796980d9f --- /dev/null +++ b/lily/context-property.cc @@ -0,0 +1,221 @@ +/* + translator-property.cc -- implement manipulation of immutable Grob + property lists. + + source file of the GNU LilyPond music typesetter + + (c) 2004 Han-Wen Nienhuys + */ + +#include "main.hh" +#include "context.hh" +#include "warn.hh" +#include "item.hh" +#include "spanner.hh" +#include "engraver.hh" + +/* + Grob descriptions (ie. alists with layout properties) are + represented as a (ALIST . BASED-ON) pair, where BASED-ON is the + alist defined in a parent context. BASED-ON should always be a tail + of ALIST. + + */ + +/* + Push or pop (depending on value of VAL) a single entry (ELTPROP . VAL) + entry from a translator property list by name of PROP +*/ + + +void +execute_pushpop_property (Context * trg, + SCM prop, SCM eltprop, SCM val) +{ + if (scm_is_symbol (prop) && scm_is_symbol (eltprop)) + { + if (val != SCM_UNDEFINED) + { + SCM prev = SCM_EOL; + Context * where = trg->where_defined (prop); + + /* + Don't mess with MIDI. + */ + if (!where) + return ; + + if (where != trg) + { + SCM base = updated_grob_properties (trg, prop); + prev = scm_cons (base, base); + trg->internal_set_property (prop, prev); + } + else + prev = trg->internal_get_property (prop); + + if (!scm_is_pair (prev)) + { + programming_error ("Grob definition should be cons."); + return ; + } + + SCM prev_alist = scm_car (prev); + + if (scm_is_pair (prev_alist) || prev_alist == SCM_EOL) + { + bool ok = type_check_assignment (eltprop, val, ly_symbol2scm ("backend-type?")); + + /* + tack onto alist: + */ + if (ok) + scm_set_car_x (prev, scm_acons (eltprop, val, prev_alist)); + } + else + { + // warning here. + } + } + else if (trg->where_defined (prop) == trg) + { + SCM prev = trg->internal_get_property (prop); + SCM prev_alist = scm_car (prev); + SCM daddy = scm_cdr (prev); + + SCM new_alist = SCM_EOL; + SCM *tail = &new_alist; + + while (prev_alist != daddy) + { + if (ly_c_equal_p (scm_caar (prev_alist), eltprop)) + { + prev_alist = scm_cdr (prev_alist); + break ; + } + + + *tail = scm_cons (scm_car (prev_alist), SCM_EOL); + tail = SCM_CDRLOC (*tail); + prev_alist = scm_cdr (prev_alist); + } + + if (new_alist == SCM_EOL && prev_alist == daddy) + trg->unset_property (prop); + else + { + *tail = prev_alist; + trg->internal_set_property (prop, scm_cons (new_alist, daddy)); + } + } + } + else + { + warning ("Need symbol arguments for \\override and \\revert"); + if (internal_type_checking_global_b) + assert (false); + } +} + +/* + PRE_INIT_OPS is in the order specified, and hence must be reversed. + */ +void +apply_property_operations (Context *tg, SCM pre_init_ops) +{ + SCM correct_order = scm_reverse (pre_init_ops); + for (SCM s = correct_order; scm_is_pair (s); s = scm_cdr (s)) + { + SCM entry = scm_car (s); + SCM type = scm_car (entry); + entry = scm_cdr (entry); + + if (type == ly_symbol2scm ("push") || type == ly_symbol2scm ("poppush")) + { + SCM val = scm_cddr (entry); + val = scm_is_pair (val) ? scm_car (val) : SCM_UNDEFINED; + + execute_pushpop_property (tg, scm_car (entry), scm_cadr (entry), val); + } + else if (type == ly_symbol2scm ("assign")) + { + tg->internal_set_property (scm_car (entry), scm_cadr (entry)); + } + } +} + +/* + Return the object alist for SYM, checking if its base in enclosing + contexts has changed. The alist is updated if necessary. + */ +SCM +updated_grob_properties (Context * tg, SCM sym) +{ + assert (scm_is_symbol (sym)); + + tg = tg->where_defined (sym); + if (!tg) + return SCM_EOL; + + SCM daddy_props + = (tg->get_parent_context ()) + ? updated_grob_properties (tg->get_parent_context (), sym) + : SCM_EOL; + + SCM props = tg->internal_get_property (sym); + + if (!scm_is_pair (props)) + { + programming_error ("grob props not a pair?"); + return SCM_EOL; + } + + SCM based_on = scm_cdr (props); + if (based_on == daddy_props) + { + return scm_car (props); + } + else + { + SCM copy = daddy_props; + SCM * tail = © + SCM p = scm_car (props); + while (p != based_on) + { + *tail = scm_cons (scm_car (p), daddy_props); + tail = SCM_CDRLOC (*tail); + p = scm_cdr (p); + } + + scm_set_car_x (props, copy); + scm_set_cdr_x (props, daddy_props); + + return copy; + } +} + +Item* +make_item_from_properties (Translator *tr, SCM x, SCM cause) +{ + Context *tg = tr->context (); + + SCM props = updated_grob_properties (tg, x); + Item *it= new Item (props); + + dynamic_cast(tr)->announce_grob (it, cause); + + return it; +} + +Spanner* +make_spanner_from_properties (Translator *tr, SCM x, SCM cause) +{ + Context *tg = tr->context (); + + SCM props = updated_grob_properties (tg, x); + Spanner *it= new Spanner (props); + + dynamic_cast(tr)->announce_grob (it, cause); + + return it; +} diff --git a/lily/context.cc b/lily/context.cc index 3c75157e8e..75b378c8f3 100644 --- a/lily/context.cc +++ b/lily/context.cc @@ -324,19 +324,25 @@ Context::properties_as_alist () const return properties_dict ()->to_alist (); } -String -Context::context_name () const +SCM +Context::context_name_symbol () const { Context_def * td = unsmob_context_def (definition_ ); - return ly_symbol2string (td->get_context_name ()); + return td->get_context_name (); } +String +Context::context_name () const +{ + return ly_symbol2string (context_name_symbol ()); +} Score_context* Context::get_score_context () const { - if (Score_context *sc =dynamic_cast ((Context*)this)) + if (Score_context *sc =dynamic_cast ((Context*) this)) return sc; + else if (daddy_context_) return daddy_context_->get_score_context (); else diff --git a/lily/grace-music.cc b/lily/grace-music.cc index 39e396a2da..e34d1ff279 100644 --- a/lily/grace-music.cc +++ b/lily/grace-music.cc @@ -10,8 +10,6 @@ #include "grace-music.hh" #include "grace-iterator.hh" - - Moment Grace_music::get_length () const { @@ -19,7 +17,6 @@ Grace_music::get_length () const return m; } - Moment Grace_music::start_mom () const { @@ -35,5 +32,4 @@ Grace_music::Grace_music () Grace_iterator::constructor_proc); } - ADD_MUSIC (Grace_music); diff --git a/lily/include/context.hh b/lily/include/context.hh index 46d836e26d..c8a366a27d 100644 --- a/lily/include/context.hh +++ b/lily/include/context.hh @@ -59,6 +59,7 @@ public: Context *remove_context (Context *trans); void check_removal (); String context_name () const; + SCM context_name_symbol () const; Global_context *get_global_context () const; virtual Score_context * get_score_context () const; diff --git a/lily/include/translation-property.hh b/lily/include/translation-property.hh deleted file mode 100644 index aacb932b9d..0000000000 --- a/lily/include/translation-property.hh +++ /dev/null @@ -1,63 +0,0 @@ -#if 0 -/* - translation-property.hh -- declare Translation_property - - source file of the GNU LilyPond music typesetter - - (c) 1997--2004 Han-Wen Nienhuys -*/ - - -#ifndef TRANSLATION_PROPERTY_HH -#define TRANSLATION_PROPERTY_HH - -#include "music.hh" - - -/** - Set a property of Translator - - value -- the value to set - symbol -- the symbol to set. - -*/ -class Translation_property : public Music -{ -public: - Translation_property (); - VIRTUAL_COPY_CONS (Music); -}; - -/** - Push onto basic property list. - - symbols -- list of basic-property lists - - element-property -- element property name - - element-value -- element property value - - */ -class Push_translation_property : public Music -{ -public: - VIRTUAL_COPY_CONS (Music); -}; - -/** - Restore previous setting. - - symbols -- list of basic-property lists - - element-property -- element property name - */ -class Pop_translation_property : public Music -{ -public: - VIRTUAL_COPY_CONS (Music); -}; - - - -#endif // PROPERTY_HH -#endif diff --git a/lily/stem-engraver.cc b/lily/stem-engraver.cc index 710d993f96..c4d3d1f8b3 100644 --- a/lily/stem-engraver.cc +++ b/lily/stem-engraver.cc @@ -24,14 +24,16 @@ */ class Stem_engraver : public Engraver { - Grob *stem_; + Grob *stem_; Grob *tremolo_; Music *rhythmic_ev_; - Music* tremolo_ev_; + Music *tremolo_ev_; + TRANSLATOR_DECLARATIONS (Stem_engraver); protected: void make_stem (Grob_info); + virtual void acknowledge_grob (Grob_info); virtual void stop_translation_timestep (); virtual bool try_music (Music *); diff --git a/lily/translator-property.cc b/lily/translator-property.cc deleted file mode 100644 index c5c1c44333..0000000000 --- a/lily/translator-property.cc +++ /dev/null @@ -1,222 +0,0 @@ -/* - translator-property.cc -- implement manipulation of - - immutable Grob property lists. - - source file of the GNU LilyPond music typesetter - - (c) 2004 Han-Wen Nienhuys - */ - -#include "main.hh" -#include "context.hh" -#include "warn.hh" -#include "item.hh" -#include "spanner.hh" -#include "engraver.hh" - -/* - Grob descriptions (ie. alists with layout properties) are - represented as a (ALIST . BASED-ON) pair, where BASED-ON is the - alist defined in a parent context. BASED-ON should always be a tail - of ALIST. - - */ - -/* - Push or pop (depending on value of VAL) a single entry (ELTPROP . VAL) - entry from a translator property list by name of PROP -*/ - - -void -execute_pushpop_property (Context * trg, - SCM prop, SCM eltprop, SCM val) -{ - if (scm_is_symbol (prop) && scm_is_symbol (eltprop)) - { - if (val != SCM_UNDEFINED) - { - SCM prev = SCM_EOL; - Context * where = trg->where_defined (prop); - - /* - Don't mess with MIDI. - */ - if (!where) - return ; - - if (where != trg) - { - SCM base = updated_grob_properties (trg, prop); - prev = scm_cons (base, base); - trg->internal_set_property (prop, prev); - } - else - prev = trg->internal_get_property (prop); - - if (!scm_is_pair (prev)) - { - programming_error ("Grob definition should be cons."); - return ; - } - - SCM prev_alist = scm_car (prev); - - if (scm_is_pair (prev_alist) || prev_alist == SCM_EOL) - { - bool ok = type_check_assignment (eltprop, val, ly_symbol2scm ("backend-type?")); - - /* - tack onto alist: - */ - if (ok) - scm_set_car_x (prev, scm_acons (eltprop, val, prev_alist)); - } - else - { - // warning here. - } - } - else if (trg->where_defined (prop) == trg) - { - SCM prev = trg->internal_get_property (prop); - SCM prev_alist = scm_car (prev); - SCM daddy = scm_cdr (prev); - - SCM new_alist = SCM_EOL; - SCM *tail = &new_alist; - - while (prev_alist != daddy) - { - if (ly_c_equal_p (scm_caar (prev_alist), eltprop)) - { - prev_alist = scm_cdr (prev_alist); - break ; - } - - - *tail = scm_cons (scm_car (prev_alist), SCM_EOL); - tail = SCM_CDRLOC (*tail); - prev_alist = scm_cdr (prev_alist); - } - - if (new_alist == SCM_EOL && prev_alist == daddy) - trg->unset_property (prop); - else - { - *tail = prev_alist; - trg->internal_set_property (prop, scm_cons (new_alist, daddy)); - } - } - } - else - { - warning ("Need symbol arguments for \\override and \\revert"); - if (internal_type_checking_global_b) - assert (false); - } -} - -/* - PRE_INIT_OPS is in the order specified, and hence must be reversed. - */ -void -apply_property_operations (Context *tg, SCM pre_init_ops) -{ - SCM correct_order = scm_reverse (pre_init_ops); - for (SCM s = correct_order; scm_is_pair (s); s = scm_cdr (s)) - { - SCM entry = scm_car (s); - SCM type = scm_car (entry); - entry = scm_cdr (entry); - - if (type == ly_symbol2scm ("push") || type == ly_symbol2scm ("poppush")) - { - SCM val = scm_cddr (entry); - val = scm_is_pair (val) ? scm_car (val) : SCM_UNDEFINED; - - execute_pushpop_property (tg, scm_car (entry), scm_cadr (entry), val); - } - else if (type == ly_symbol2scm ("assign")) - { - tg->internal_set_property (scm_car (entry), scm_cadr (entry)); - } - } -} - -/* - Return the object alist for SYM, checking if its base in enclosing - contexts has changed. The alist is updated if necessary. - */ -SCM -updated_grob_properties (Context * tg, SCM sym) -{ - assert (scm_is_symbol (sym)); - - tg = tg->where_defined (sym); - if (!tg) - return SCM_EOL; - - SCM daddy_props - = (tg->get_parent_context ()) - ? updated_grob_properties (tg->get_parent_context (), sym) - : SCM_EOL; - - SCM props = tg->internal_get_property (sym); - - if (!scm_is_pair (props)) - { - programming_error ("grob props not a pair?"); - return SCM_EOL; - } - - SCM based_on = scm_cdr (props); - if (based_on == daddy_props) - { - return scm_car (props); - } - else - { - SCM copy = daddy_props; - SCM * tail = © - SCM p = scm_car (props); - while (p != based_on) - { - *tail = scm_cons (scm_car (p), daddy_props); - tail = SCM_CDRLOC (*tail); - p = scm_cdr (p); - } - - scm_set_car_x (props, copy); - scm_set_cdr_x (props, daddy_props); - - return copy; - } -} - -Item* -make_item_from_properties (Translator *tr, SCM x, SCM cause) -{ - Context *tg = tr->context (); - - SCM props = updated_grob_properties (tg, x); - Item *it= new Item (props); - - dynamic_cast(tr)->announce_grob (it, cause); - - return it; -} - -Spanner* -make_spanner_from_properties (Translator *tr, SCM x, SCM cause) -{ - Context *tg = tr->context (); - - SCM props = updated_grob_properties (tg, x); - Spanner *it= new Spanner (props); - - dynamic_cast(tr)->announce_grob (it, cause); - - return it; -} diff --git a/ly/engraver-init.ly b/ly/engraver-init.ly index 4c867fafde..c901b285e0 100644 --- a/ly/engraver-init.ly +++ b/ly/engraver-init.ly @@ -203,6 +203,7 @@ \consists "Slur_engraver" \consists "Tie_engraver" \consists "Tuplet_engraver" + \consists "Grace_engraver" \consists "Skip_event_swallow_translator" } @@ -533,7 +534,7 @@ AncientRemoveEmptyStaffContext = \context { %% bassFigureFormatFunction = #format-bass-figure metronomeMarkFormatter = #format-metronome-markup - graceSettings = #`#( + graceSettings = #`( (Voice Stem direction 1) ;; TODO: should take from existing definition. ;; c&p from define-grobs.scm diff --git a/ly/grace-init.ly b/ly/grace-init.ly index 4e13a5ea02..282e31e087 100644 --- a/ly/grace-init.ly +++ b/ly/grace-init.ly @@ -2,32 +2,32 @@ startGraceMusic = { - \context Voice \applycontext #set-start-grace-properties +% \context Voice \applycontext #set-start-grace-properties } stopGraceMusic = { - \context Voice \applycontext #set-stop-grace-properties +% \context Voice \applycontext #set-stop-grace-properties } startAppoggiaturaMusic = { - \context Voice \applycontext #set-start-grace-properties +% \context Voice \applycontext #set-start-grace-properties s1*0( } stopAppoggiaturaMusic = { - \context Voice \applycontext #set-stop-grace-properties +% \context Voice \applycontext #set-stop-grace-properties s1*0) } startAcciaccaturaMusic = { - \context Voice \applycontext #set-start-grace-properties +% \context Voice \applycontext #set-start-grace-properties s1*0( \override Stem #'stroke-style = #"grace" } stopAcciaccaturaMusic = { \revert Stem #'stroke-style - \context Voice \applycontext #set-stop-grace-properties +% \context Voice \applycontext #set-stop-grace-properties s1*0) } diff --git a/scm/define-context-properties.scm b/scm/define-context-properties.scm index 8aedad8d88..247cf7932b 100644 --- a/scm/define-context-properties.scm +++ b/scm/define-context-properties.scm @@ -444,7 +444,7 @@ Valid values are described in @internalsref{bar-line-interface}. (melismaBusy ,boolean? "Signifies whether a melisma is active. This can be used to signal melismas on top of those automatically detected. ") - (graceSettings ,vector? + (graceSettings ,list? "Overrides for grace notes. This property should be manipulated through the @code{add-grace-property} function.") (currentCommandColumn ,ly:grob? "Grob that is X-parent to all diff --git a/scm/music-functions.scm b/scm/music-functions.scm index 4f4152a275..c402c23034 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -547,32 +547,12 @@ without context specification. Called from parser." (define (set-prop context) (let* ((where (ly:context-property-where-defined context 'graceSettings)) (current (ly:context-property where 'graceSettings)) - (new-settings (vector-extend current (list context-name grob sym val)))) + (new-settings (append current + (list (list context-name grob sym val))))) (ly:context-set-property! where 'graceSettings new-settings))) (ly:export (context-spec-music (make-apply-context set-prop) 'Voice))) -(define-public (set-start-grace-properties context) - (define (execute-1 x) - (let ((tr (ly:context-find context (car x)))) - (if (ly:context? tr) - (ly:context-pushpop-property tr (cadr x) (caddr x) (cadddr x))))) - - (let ((props (ly:context-property context 'graceSettings))) - (if (vector? props) - (vector-map execute-1 props)))) - -(define-public (set-stop-grace-properties context) - (define (execute-1 x) - (let ((tr (ly:context-find context (car x)))) - (if (ly:context? tr) - (ly:context-pushpop-property tr (cadr x) (caddr x))))) - - (let ((props (ly:context-property context 'graceSettings))) - (if (vector? props) - (vector-reverse-map execute-1 props)))) - - (defmacro-public def-grace-function (start stop) `(def-music-function (location music) (ly:music?)