2004-11-07 Han-Wen Nienhuys <hanwen@xs4all.nl>
+ * 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.
--- /dev/null
+/*
+ translator-property.cc -- implement manipulation of immutable Grob
+ property lists.
+
+ source file of the GNU LilyPond music typesetter
+
+ (c) 2004 Han-Wen Nienhuys <hanwen@xs4all.nl>
+ */
+
+#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<Engraver*>(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<Engraver*>(tr)->announce_grob (it, cause);
+
+ return it;
+}
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<Score_context*> ((Context*)this))
+ if (Score_context *sc =dynamic_cast<Score_context*> ((Context*) this))
return sc;
+
else if (daddy_context_)
return daddy_context_->get_score_context ();
else
#include "grace-music.hh"
#include "grace-iterator.hh"
-
-
Moment
Grace_music::get_length () const
{
return m;
}
-
Moment
Grace_music::start_mom () const
{
Grace_iterator::constructor_proc);
}
-
ADD_MUSIC (Grace_music);
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;
+++ /dev/null
-#if 0
-/*
- translation-property.hh -- declare Translation_property
-
- source file of the GNU LilyPond music typesetter
-
- (c) 1997--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
-*/
-
-
-#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
*/
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 *);
+++ /dev/null
-/*
- translator-property.cc -- implement manipulation of
-
- immutable Grob property lists.
-
- source file of the GNU LilyPond music typesetter
-
- (c) 2004 Han-Wen Nienhuys <hanwen@xs4all.nl>
- */
-
-#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<Engraver*>(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<Engraver*>(tr)->announce_grob (it, cause);
-
- return it;
-}
\consists "Slur_engraver"
\consists "Tie_engraver"
\consists "Tuplet_engraver"
+ \consists "Grace_engraver"
\consists "Skip_event_swallow_translator"
}
%%
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
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)
}
(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
(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?)
projects / lilypond.git / commitdiff