2 This file is part of LilyPond, the GNU music typesetter.
4 Copyright (C) 2005--2011 Erik Sandberg <mandolaerik@gmail.com>
6 LilyPond is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 LilyPond is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
20 #include "dispatcher.hh"
22 #include "international.hh"
23 #include "ly-smobs.icc"
26 IMPLEMENT_SMOBS (Dispatcher);
27 IMPLEMENT_TYPE_P (Dispatcher, "ly:dispatcher?");
28 IMPLEMENT_DEFAULT_EQUAL_P (Dispatcher);
30 Dispatcher::~Dispatcher ()
34 Dispatcher::Dispatcher ()
38 dispatchers_ = SCM_EOL;
39 listen_classes_ = SCM_EOL;
41 // TODO: use resizable hash (guile 1.8)
42 // listeners_ = scm_c_make_hash_table (0);
43 listeners_ = scm_c_make_hash_table (17);
48 Dispatcher::mark_smob (SCM sm)
50 Dispatcher *me = (Dispatcher *) SCM_CELL_WORD_1 (sm);
51 scm_gc_mark (me->dispatchers_);
52 scm_gc_mark (me->listen_classes_);
53 return me->listeners_;
57 Dispatcher::print_smob (SCM s, SCM p, scm_print_state *)
59 Dispatcher *me = (Dispatcher *) SCM_CELL_WORD_1 (s);
60 scm_puts ("#<Dispatcher ", p);
61 scm_write (scm_vector_to_list (me->listeners_), p);
68 - Collect a list of listeners for each relevant class
69 - Send the event to each of these listeners, in increasing priority order.
70 This is done by keeping a priority queue of listener lists,
71 and iteratively send the event to the lowest-priority listener.
72 - An event is never sent twice to listeners with equal priority.
74 IMPLEMENT_LISTENER (Dispatcher, dispatch);
76 Dispatcher::dispatch (SCM sev)
78 Stream_event *ev = unsmob_stream_event (sev);
79 SCM class_symbol = ev->get_property ("class");
80 if (!scm_is_symbol (class_symbol))
82 warning (_ ("Event class should be a symbol"));
86 SCM class_list = scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), class_symbol);
87 if (!scm_is_pair (class_list))
89 ev->origin ()->warning (_f ("Unknown event class %s", ly_symbol2string (class_symbol).c_str ()));
95 int num_classes = scm_ilength (class_list);
98 For each event class there is a list of listeners, which is
99 ordered by priority. Our next task is to call these listeners, in
100 priority order. A priority queue stores the next element in each
101 listener list, and the lowest priority element is repeatedly
102 extracted and called.
104 The priority queue is implemented as a bubble-sorted C
105 array. Using the stack instead of native Scheme datastructures
106 avoids overheads for memory allocation. The queue is usually small
107 (around 2 elements), so the quadratic sorting time is not a
108 problem. (if this changes, it's easy to rewrite this routine using
111 The first step is to collect all listener lists and to initially
112 insert them in the priority queue.
114 struct { int prio; SCM list; } lists[num_classes + 1];
116 for (SCM cl = class_list; scm_is_pair (cl); cl = scm_cdr (cl))
118 SCM list = scm_hashq_ref (listeners_, scm_car (cl), SCM_EOL);
119 if (!scm_is_pair (list))
124 int prio = scm_to_int (scm_caar (list));
126 for (j = i; j > 0 && lists[j - 1].prio > prio; j--)
127 lists[j] = lists[j - 1];
128 lists[j].prio = prio;
129 lists[j].list = list;
133 lists[num_classes].prio = INT_MAX;
135 // Never send an event to two listeners with equal priority.
136 int last_priority = -1;
138 Each iteration extracts the lowest-priority element, which is a
139 list of listeners. The first listener is called, and the tail of
140 the list is pushed back into the priority queue.
144 // Send the event, if we haven't already sent it to this target.
145 if (lists[0].prio != last_priority)
147 // process the listener
148 assert (lists[0].prio > last_priority);
149 last_priority = lists[0].prio;
151 Listener *l = unsmob_listener (scm_cdar (lists[0].list));
152 l->listen (ev->self_scm ());
157 // go to the next listener; bubble-sort the class list.
158 SCM next = scm_cdr (lists[0].list);
159 if (!scm_is_pair (next))
161 int prio = (scm_is_pair (next)) ? scm_to_int (scm_caar (next)) : INT_MAX;
162 for (i = 0; prio > lists[i + 1].prio; i++)
163 lists[i] = lists[i + 1];
164 lists[i].prio = prio;
165 lists[i].list = next;
169 /* TODO: Uncomment. */
171 warning (_f ("Junking event: %s", ly_symbol2string (class_symbol).c_str ()));
176 Dispatcher::broadcast (Stream_event *ev)
178 dispatch (ev->self_scm ());
182 Dispatcher::add_listener (Listener l, SCM ev_class)
184 internal_add_listener (l, ev_class, ++priority_count_);
188 Dispatcher::internal_add_listener (Listener l, SCM ev_class, int priority)
190 SCM list = scm_hashq_ref (listeners_, ev_class, SCM_EOL);
191 if (!scm_is_pair (list))
193 /* Tell all dispatchers that we listen to, that we want to hear ev_class
195 for (SCM disp = dispatchers_; scm_is_pair (disp); disp = scm_cdr (disp))
197 int priority = scm_to_int (scm_cdar (disp));
198 Dispatcher *d = unsmob_dispatcher (scm_caar (disp));
199 d->internal_add_listener (GET_LISTENER (dispatch), ev_class, priority);
201 listen_classes_ = scm_cons (ev_class, listen_classes_);
203 SCM entry = scm_cons (scm_from_int (priority), l.smobbed_copy ());
204 list = scm_merge (list, scm_list_1 (entry), ly_lily_module_constant ("car<"));
205 scm_hashq_set_x (listeners_, ev_class, list);
209 Dispatcher::remove_listener (Listener l, SCM ev_class)
211 SCM list = scm_hashq_ref (listeners_, ev_class, SCM_EOL);
215 programming_error ("remove_listener called with incorrect class.");
219 // We just remove the listener once.
222 SCM dummy = scm_cons (SCM_EOL, list);
224 while (scm_is_pair (scm_cdr (e)))
225 if (*unsmob_listener (scm_cdadr (e)) == l && first)
227 scm_set_cdr_x (e, scm_cddr (e));
233 list = scm_cdr (dummy);
234 scm_hashq_set_x (listeners_, ev_class, list);
237 warning ("Attempting to remove nonexisting listener.");
238 else if (!scm_is_pair (list))
240 /* Unregister with all dispatchers. */
241 for (SCM disp = dispatchers_; scm_is_pair (disp); disp = scm_cdr (disp))
243 Dispatcher *d = unsmob_dispatcher (scm_caar (disp));
244 d->remove_listener (GET_LISTENER (dispatch), ev_class);
246 listen_classes_ = scm_delq_x (ev_class, listen_classes_);
250 /* Register as a listener to another dispatcher. */
252 Dispatcher::register_as_listener (Dispatcher *disp)
254 int priority = ++disp->priority_count_;
256 // Don't register twice to the same dispatcher.
257 if (scm_assq (disp->self_scm (), dispatchers_) != SCM_BOOL_F)
259 warning ("Already listening to dispatcher, ignoring request");
263 dispatchers_ = scm_acons (disp->self_scm (), scm_from_int (priority), dispatchers_);
265 Listener list = GET_LISTENER (dispatch);
266 for (SCM cl = listen_classes_; scm_is_pair (cl); cl = scm_cdr (cl))
268 disp->internal_add_listener (list, scm_car (cl), priority);
272 /* Unregister as a listener to another dispatcher. */
274 Dispatcher::unregister_as_listener (Dispatcher *disp)
276 dispatchers_ = scm_assq_remove_x (dispatchers_, disp->self_scm ());
278 Listener listener = GET_LISTENER (dispatch);
279 for (SCM cl = listen_classes_; scm_is_pair (cl); cl = scm_cdr (cl))
281 disp->remove_listener (listener, scm_car (cl));