]> git.donarmstrong.com Git - lilypond.git/blob - lily/scheme-engraver.cc
Doc-es: update Vocal.
[lilypond.git] / lily / scheme-engraver.cc
1 /*
2   scheme-engraver.cc -- implement Scheme_engraver
3
4   source file of the GNU LilyPond music typesetter
5
6   Copyright (c) 2009--2011 Han-Wen Nienhuys <hanwen@lilypond.org>
7
8   LilyPond is free software: you can redistribute it and/or modify
9   it under the terms of the GNU General Public License as published by
10   the Free Software Foundation, either version 3 of the License, or
11   (at your option) any later version.
12
13   LilyPond is distributed in the hope that it will be useful,
14   but WITHOUT ANY WARRANTY; without even the implied warranty of
15   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16   GNU General Public License for more details.
17
18   You should have received a copy of the GNU General Public License
19   along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
20 */
21
22 #include "scheme-engraver.hh"
23
24 #include "grob.hh"
25
26 #include "translator.icc"
27
28 Scheme_engraver::Scheme_engraver ()
29 {
30   stop_translation_timestep_function_ = SCM_EOL;
31   start_translation_timestep_function_ = SCM_EOL;
32   process_music_function_ = SCM_EOL;
33   process_acknowledged_function_ = SCM_EOL;
34   initialize_function_ = SCM_EOL;
35   finalize_function_ = SCM_EOL;
36   listeners_alist_ = SCM_EOL;
37
38   interface_acknowledger_hash_ = SCM_EOL;
39   interface_end_acknowledger_hash_ = SCM_EOL;
40
41   must_be_last_ = false;
42   per_instance_listeners_ = 0;
43 }
44
45 Scheme_engraver::~Scheme_engraver ()
46 {
47   translator_listener_record *next = 0;
48   for (translator_listener_record *r = per_instance_listeners_;
49        r; r = next)
50     {
51       next = r->next_;
52       delete r;
53     }
54 }
55
56 // Extracts the value if callable, if not return #f.
57 static SCM
58 callable (SCM symbol, SCM defn)
59 {
60   SCM val = ly_assoc_get (symbol, defn, SCM_BOOL_F);
61   return ly_is_procedure (val) ? val : SCM_BOOL_F;
62 }
63
64 bool
65 Scheme_engraver::must_be_last () const
66 {
67   return must_be_last_;
68 }
69
70 void
71 Scheme_engraver::init_from_scheme (SCM definition)
72 {
73   start_translation_timestep_function_ = callable (ly_symbol2scm ("start-translation-timestep"),
74                                                    definition);
75   stop_translation_timestep_function_ = callable (ly_symbol2scm ("stop-translation-timestep"),
76                                                   definition);
77   process_music_function_ = callable (ly_symbol2scm ("process-music"), definition);
78   process_acknowledged_function_ = callable (ly_symbol2scm ("process-acknowledged"),
79                                              definition);
80   initialize_function_ = callable (ly_symbol2scm ("initialize"), definition);
81   finalize_function_ = callable (ly_symbol2scm ("finalize"), definition);
82
83   SCM listeners = ly_assoc_get (ly_symbol2scm ("listeners"), definition, SCM_EOL);
84
85   listeners_alist_ = SCM_EOL;
86
87   must_be_last_ = to_boolean (ly_assoc_get (ly_symbol2scm ("must-be-last"),
88                                             definition,
89                                             SCM_BOOL_F));
90
91   translator_listener_record **tail = &per_instance_listeners_;
92   for (SCM p = listeners; scm_is_pair (p); p = scm_cdr (p))
93     {
94       SCM event_class = scm_caar (p);
95       SCM proc = scm_cdar (p);
96
97       if (!(ly_is_procedure (proc) && ly_is_symbol (event_class)))
98         continue;
99
100       // We should check the arity of the function?
101
102       // Record for later lookup.
103       listeners_alist_ = scm_acons (event_class, proc, listeners_alist_);
104
105       translator_listener_record *rec = new translator_listener_record;
106       *tail = rec;
107       rec->event_class_ = event_class;
108       rec->get_listener_ = &Scheme_engraver::get_listener;
109       tail = &rec->next_;
110     }
111
112   init_acknowledgers (ly_assoc_get (ly_symbol2scm ("acknowledgers"),
113                                     definition, SCM_EOL),
114                       &interface_acknowledger_hash_);
115
116   init_acknowledgers (ly_assoc_get (ly_symbol2scm ("end-acknowledgers"),
117                                     definition, SCM_EOL),
118                       &interface_end_acknowledger_hash_);
119
120   // TODO: hook up description, props read/written, grobs created
121   // etc. to provide automatic documentation.
122 }
123
124 void
125 Scheme_engraver::init_acknowledgers (SCM alist,
126                                      SCM *hash)
127 {
128   *hash = scm_c_make_hash_table (7);
129   for (SCM p = alist; scm_is_pair (p); p = scm_cdr (p))
130     {
131       SCM iface = scm_caar (p);
132       SCM proc = scm_cdar (p);
133
134       if (!(ly_is_procedure (proc) && ly_is_symbol (iface)))
135         continue;
136
137       scm_hashq_set_x (*hash, iface, proc);
138     }
139 }
140
141 // This is the easy way to do it, at the cost of too many invocations
142 // of Scheme_engraver::acknowledge_grob.  The clever dispatching of
143 // acknowledgers is hardwired to have 1 method per engraver per
144 // grob-type, which doesn't work for this case.
145 void
146 Scheme_engraver::acknowledge_grob (Grob_info info)
147 {
148   acknowledge_grob_by_hash (info, interface_acknowledger_hash_);
149 }
150
151 void
152 Scheme_engraver::acknowledge_end_grob (Grob_info info)
153 {
154   acknowledge_grob_by_hash (info, interface_end_acknowledger_hash_);
155 }
156
157 void
158 Scheme_engraver::acknowledge_grob_by_hash (Grob_info info,
159                                            SCM iface_function_hash)
160 {
161   SCM meta = info.grob ()->internal_get_property (ly_symbol2scm ("meta"));
162   SCM ifaces = scm_cdr (scm_assoc (ly_symbol2scm ("interfaces"), meta));
163   for (SCM s = ifaces; scm_is_pair (s); s = scm_cdr (s))
164     {
165       SCM func = scm_hashq_ref (iface_function_hash,
166                                 scm_car (s), SCM_BOOL_F);
167
168       if (ly_is_procedure (func))
169         scm_call_3 (func, self_scm (), info.grob ()->self_scm (),
170                     info.origin_translator ()->self_scm ());
171     }
172 }
173
174 static
175 void call_listen_closure (void *target, SCM ev)
176 {
177   SCM cl = (SCM) target;
178   SCM func = scm_car (cl);
179   SCM engraver = scm_cdr (cl);
180   scm_call_2 (func, engraver, ev);
181 }
182
183 static
184 void mark_listen_closure (void *target)
185 {
186   scm_gc_mark ((SCM)target);
187 }
188
189 Listener_function_table listen_closure
190 =
191 {
192   call_listen_closure, mark_listen_closure
193 };
194
195 /* static */
196 Listener
197 Scheme_engraver::get_listener (void *arg, SCM name)
198 {
199   Scheme_engraver *me = (Scheme_engraver *) arg;
200   SCM func = ly_assoc_get (name, me->listeners_alist_, SCM_BOOL_F);
201   assert (ly_is_procedure (func));
202
203   SCM closure = scm_cons (func, me->self_scm ());
204   return Listener ((void *)closure, &listen_closure);
205 }
206
207 translator_listener_record *
208 Scheme_engraver::get_listener_list () const
209 {
210   return per_instance_listeners_;
211 }
212
213 #define DISPATCH(what)                                  \
214   void                                                  \
215   Scheme_engraver::what ()                              \
216   {                                                     \
217     if (what ## _function_ != SCM_BOOL_F)               \
218       scm_call_1 (what ## _function_, self_scm ());     \
219   }
220
221 DISPATCH (start_translation_timestep);
222 DISPATCH (stop_translation_timestep);
223 DISPATCH (initialize);
224 DISPATCH (finalize);
225 DISPATCH (process_music);
226 DISPATCH (process_acknowledged);
227
228 void
229 Scheme_engraver::derived_mark () const
230 {
231   scm_gc_mark (start_translation_timestep_function_);
232   scm_gc_mark (stop_translation_timestep_function_);
233   scm_gc_mark (initialize_function_);
234   scm_gc_mark (finalize_function_);
235   scm_gc_mark (process_music_function_);
236   scm_gc_mark (process_acknowledged_function_);
237   scm_gc_mark (listeners_alist_);
238   scm_gc_mark (interface_acknowledger_hash_);
239   scm_gc_mark (interface_end_acknowledger_hash_);
240 }
241
242 ADD_ACKNOWLEDGER (Scheme_engraver, grob);
243 ADD_END_ACKNOWLEDGER (Scheme_engraver, grob);
244
245 ADD_TRANSLATOR (Scheme_engraver,
246                 /* doc */
247                 "Implement engravers in Scheme.  Interprets arguments to"
248                 " @code{\\consists} as callbacks.",
249
250                 /* create */
251                 "",
252
253                 /* read */
254                 "",
255
256                 /* write */
257                 ""
258                );