2 Translator_group.cc -- implement Translator_group
4 source file of the GNU LilyPond music typesetter
6 (c) 1997--2003 Han-Wen Nienhuys <hanwen@cs.uu.nl>
9 #include "music-output-def.hh"
10 #include "translator-group.hh"
11 #include "translator.hh"
14 #include "scm-hash.hh"
15 #include "translator-def.hh"
19 Translator_group::Translator_group (Translator_group
const&s
)
24 Scheme_hash_table
* tab
= new Scheme_hash_table (*s
.properties_dict ());
25 properties_scm_
= tab
->self_scm ();
26 scm_gc_unprotect_object (tab
->self_scm ());
30 Translator_group::properties_dict () const
32 return Scheme_hash_table::unsmob (properties_scm_
);
35 Translator_group::~Translator_group ()
38 //assert (is_removable ());
42 Translator_group::Translator_group ()
45 Scheme_hash_table
*tab
= new Scheme_hash_table
;
46 properties_scm_
= tab
->self_scm ();
48 scm_gc_unprotect_object (tab
->self_scm ());
52 Translator_group::check_removal ()
55 for (SCM p
= trans_group_list_
; gh_pair_p (p
); p
= next
)
59 Translator_group
*trg
= dynamic_cast<Translator_group
*> (unsmob_translator (ly_car (p
)));
61 trg
->check_removal ();
62 if (trg
->is_removable ())
63 terminate_translator (trg
);
68 Translator_group::add_translator (SCM list
, Translator
*t
)
71 Must append, since list ordering must be preserved.
73 list
= gh_append2 (list
, gh_cons (t
->self_scm (), SCM_EOL
));
74 t
->daddy_trans_
= this;
75 t
->output_def_
= output_def_
;
82 Translator_group::add_used_group_translator (Translator
*t
)
84 trans_group_list_
= add_translator (trans_group_list_
,t
);
89 Translator_group::add_fresh_group_translator (Translator
*t
)
91 Translator_group
*tg
= dynamic_cast<Translator_group
*> (t
);
93 trans_group_list_
= add_translator (trans_group_list_
,t
);
95 Translator_def
* td
= unsmob_translator_def (tg
->definition_
);
98 this can not move before add_translator(), because \override
99 operations require that we are in the hierarchy.
101 td
->apply_default_property_operations (tg
);
108 Translator_group::is_removable () const
110 return trans_group_list_
== SCM_EOL
&& ! iterator_count_
;
114 Translator_group::find_existing_translator (SCM n
, String id
)
116 if ((is_alias (n
) && (id_string_
== id
|| id
.is_empty ())) || n
== ly_symbol2scm ("Current"))
119 Translator_group
* r
= 0;
120 for (SCM p
= trans_group_list_
; !r
&& gh_pair_p (p
); p
= ly_cdr (p
))
122 Translator
* t
= unsmob_translator (ly_car (p
));
124 r
= dynamic_cast<Translator_group
*> (t
)->find_existing_translator (n
, id
);
132 Translator_group::find_create_translator (SCM n
, String id
, SCM operations
)
134 Translator_group
* existing
= find_existing_translator (n
,id
);
138 Link_array
<Translator_def
> path
139 = unsmob_translator_def (definition_
)->path_to_acceptable_translator (n
, get_output_def ());
143 Translator_group
* current
= this;
145 // start at 1. The first one (index 0) will be us.
146 for (int i
=0; i
< path
.size (); i
++)
148 SCM ops
= (i
== path
.size () -1) ? operations
: SCM_EOL
;
150 Translator_group
* new_group
151 = path
[i
]->instantiate (output_def_
, ops
);
153 if (i
== path
.size () -1)
155 new_group
->id_string_
= id
;
158 current
->add_fresh_group_translator (new_group
);
159 apply_property_operations (new_group
, ops
);
167 Translator_group
*ret
= 0;
169 ret
= daddy_trans_
->find_create_translator (n
, id
, operations
);
172 warning (_f ("can't find or create `%s' called `%s'", ly_symbol2string (n
).to_str0 (), id
));
179 Translator_group::try_music (Music
* m
)
181 bool hebbes_b
= try_music_on_nongroup_children (m
);
183 if (!hebbes_b
&& daddy_trans_
)
184 hebbes_b
= daddy_trans_
->try_music (m
);
190 Translator_group::get_depth () const
192 return (daddy_trans_
) ? daddy_trans_
->get_depth () + 1 : 0;
196 Translator_group::get_ancestor (int level
)
198 if (!level
|| !daddy_trans_
)
201 return daddy_trans_
->get_ancestor (level
-1);
205 Translator_group::terminate_translator (Translator
*r
)
209 Return value ignored. GC does the rest.
211 remove_translator (r
);
216 Remove a translator from the hierarchy.
219 Translator_group::remove_translator (Translator
*trans
)
223 trans_group_list_
= scm_delq_x (trans
->self_scm (), trans_group_list_
);
224 trans
->daddy_trans_
= 0;
229 Translator_group::is_bottom_translator_b () const
231 return !gh_symbol_p (unsmob_translator_def (definition_
)->default_child_context_name ());
235 Translator_group::get_default_interpreter ()
237 if (!is_bottom_translator_b ())
239 SCM nm
= unsmob_translator_def (definition_
)->default_child_context_name ();
240 SCM st
= get_output_def ()->find_translator (nm
);
242 Translator_def
*t
= unsmob_translator_def (st
);
245 warning (_f ("can't find or create: `%s'", ly_symbol2string (nm
).to_str0 ()));
246 t
= unsmob_translator_def (this->definition_
);
248 Translator_group
*tg
= t
->instantiate (output_def_
, SCM_EOL
);
249 add_fresh_group_translator (tg
);
251 if (!tg
->is_bottom_translator_b ())
252 return tg
->get_default_interpreter ();
260 static_each (SCM list
, Method_pointer method
)
262 for (SCM p
= list
; gh_pair_p (p
); p
= ly_cdr (p
))
263 (unsmob_translator (ly_car (p
))->*method
) ();
268 Translator_group::each (Method_pointer method
)
270 static_each (simple_trans_list_
, method
);
271 static_each (trans_group_list_
, method
);
279 Translator_group::where_defined (SCM sym
) const
281 if (properties_dict ()->contains (sym
))
283 return (Translator_group
*)this;
286 return (daddy_trans_
) ? daddy_trans_
->where_defined (sym
) : 0;
290 return SCM_EOL when not found.
293 Translator_group::internal_get_property (SCM sym
) const
296 if (properties_dict ()->try_retrieve (sym
, &val
))
300 return daddy_trans_
->internal_get_property (sym
);
306 Translator_group::internal_set_property (SCM sym
, SCM val
)
309 if (internal_type_checking_global_b
)
310 assert (type_check_assignment (sym
, val
, ly_symbol2scm ("translation-type?")));
313 properties_dict ()->set (sym
, val
);
317 TODO: look up to check whether we have inherited var?
320 Translator_group::unset_property (SCM sym
)
322 properties_dict ()->remove (sym
);
327 Push or pop (depending on value of VAL) a single entry (ELTPROP . VAL)
328 entry from a translator property list by name of PROP
331 Translator_group::execute_pushpop_property (SCM prop
, SCM eltprop
, SCM val
)
333 if (gh_symbol_p (prop
))
335 if (val
!= SCM_UNDEFINED
)
337 SCM prev
= internal_get_property (prop
);
339 if (gh_pair_p (prev
) || prev
== SCM_EOL
)
341 bool ok
= type_check_assignment (eltprop
, val
, ly_symbol2scm ("backend-type?"));
345 prev
= gh_cons (gh_cons (eltprop
, val
), prev
);
346 internal_set_property (prop
, prev
);
357 SCM prev
= internal_get_property (prop
);
360 TODO: should have scm_equal_something () for reverting
363 SCM newprops
= SCM_EOL
;
364 while (gh_pair_p (prev
) && !SCM_EQ_P(ly_caar (prev
), eltprop
))
366 newprops
= gh_cons (ly_car (prev
), newprops
);
367 prev
= ly_cdr (prev
);
370 if (gh_pair_p (prev
))
372 newprops
= scm_reverse_x (newprops
, ly_cdr (prev
));
373 internal_set_property (prop
, newprops
);
385 Translator_group::stop_translation_timestep ()
387 each (&Translator::stop_translation_timestep
);
391 Translator_group::start_translation_timestep ()
393 each (&Translator::start_translation_timestep
);
397 Translator_group::do_announces ()
399 each (&Translator::do_announces
);
403 Translator_group::initialize ()
405 SCM tab
= scm_make_vector (gh_int2scm (19), SCM_BOOL_F
);
406 set_property ("acceptHashTable", tab
);
407 each (&Translator::initialize
);
411 Translator_group::finalize ()
413 each (&Translator::finalize
);
418 bool translator_accepts_any_of (Translator
*tr
, SCM ifaces
)
420 SCM ack_ifs
= scm_assoc (ly_symbol2scm ("events-accepted"),
421 tr
->translator_description());
422 ack_ifs
= gh_cdr (ack_ifs
);
423 for (SCM s
= ifaces
; ly_pair_p (s
); s
= ly_cdr (s
))
424 if (scm_memq (ly_car (s
), ack_ifs
) != SCM_BOOL_F
)
430 find_accept_translators (SCM gravlist
, SCM ifaces
)
433 for (SCM s
= gravlist
; ly_pair_p (s
); s
= ly_cdr (s
))
435 Translator
* tr
= unsmob_translator (ly_car (s
));
436 if (translator_accepts_any_of (tr
, ifaces
))
437 l
= scm_cons (tr
->self_scm (), l
);
439 l
= scm_reverse_x (l
, SCM_EOL
);
445 Translator_group::try_music_on_nongroup_children (Music
*m
)
447 SCM tab
= get_property ("acceptHashTable");
448 SCM name
= scm_sloppy_assq (ly_symbol2scm ("name"),
449 m
->get_property_alist (false));
451 if (!gh_pair_p (name
))
454 name
= gh_cdr (name
);
455 SCM accept_list
= scm_hashq_ref (tab
, name
, SCM_UNDEFINED
);
456 if (accept_list
== SCM_BOOL_F
)
458 accept_list
= find_accept_translators (simple_trans_list_
,
459 m
->get_mus_property ("types"));
460 scm_hashq_set_x (tab
, name
, accept_list
);
463 for (SCM p
= accept_list
; gh_pair_p (p
); p
= ly_cdr (p
))
465 Translator
* t
= unsmob_translator (ly_car (p
));
466 if (t
&& t
->try_music (m
))
473 Translator_group::properties_as_alist () const
475 return properties_dict()->to_alist();
479 Translator_group::context_name () const
481 Translator_def
* td
= unsmob_translator_def (definition_
);
482 return ly_symbol2string (td
->get_context_name ());
486 PRE_INIT_OPS is in the order specified, and hence must be reversed.
489 apply_property_operations (Translator_group
*tg
, SCM pre_init_ops
)
491 SCM correct_order
= scm_reverse (pre_init_ops
);
492 for (SCM s
= correct_order
; gh_pair_p (s
); s
= ly_cdr (s
))
494 SCM entry
= ly_car (s
);
495 SCM type
= ly_car (entry
);
496 entry
= ly_cdr (entry
);
498 if (type
== ly_symbol2scm ("push") || type
== ly_symbol2scm ("poppush"))
500 SCM val
= ly_cddr (entry
);
501 val
= gh_pair_p (val
) ? ly_car (val
) : SCM_UNDEFINED
;
503 tg
->execute_pushpop_property (ly_car (entry
), ly_cadr (entry
), val
);
505 else if (type
== ly_symbol2scm ("assign"))
507 tg
->internal_set_property (ly_car (entry
), ly_cadr (entry
));