2 This file is part of LilyPond, the GNU music typesetter.
4 Copyright (C) 2005--2012 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_call_1 (ly_lily_module_constant ("hash-table->alist"),
69 - Collect a list of listeners for each relevant class
70 - Send the event to each of these listeners, in increasing priority order.
71 This is done by keeping a priority queue of listener lists,
72 and iteratively send the event to the lowest-priority listener.
73 - An event is never sent twice to listeners with equal priority.
75 IMPLEMENT_LISTENER (Dispatcher, dispatch);
77 Dispatcher::dispatch (SCM sev)
79 Stream_event *ev = unsmob_stream_event (sev);
80 SCM class_symbol = ev->get_property ("class");
81 if (!scm_is_symbol (class_symbol))
83 warning (_ ("Event class should be a symbol"));
87 SCM class_list = scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), class_symbol);
88 if (!scm_is_pair (class_list))
90 ev->origin ()->warning (_f ("Unknown event class %s", ly_symbol2string (class_symbol).c_str ()));
96 int num_classes = scm_ilength (class_list);
99 For each event class there is a list of listeners, which is
100 ordered by priority. Our next task is to call these listeners, in
101 priority order. A priority queue stores the next element in each
102 listener list, and the lowest priority element is repeatedly
103 extracted and called.
105 The priority queue is implemented as a bubble-sorted C
106 array. Using the stack instead of native Scheme datastructures
107 avoids overheads for memory allocation. The queue is usually small
108 (around 2 elements), so the quadratic sorting time is not a
109 problem. (if this changes, it's easy to rewrite this routine using
112 The first step is to collect all listener lists and to initially
113 insert them in the priority queue.
115 struct { int prio; SCM list; } lists[num_classes + 1];
117 for (SCM cl = class_list; scm_is_pair (cl); cl = scm_cdr (cl))
119 SCM list = scm_hashq_ref (listeners_, scm_car (cl), SCM_EOL);
120 if (!scm_is_pair (list))
125 int prio = scm_to_int (scm_caar (list));
127 for (j = i; j > 0 && lists[j - 1].prio > prio; j--)
128 lists[j] = lists[j - 1];
129 lists[j].prio = prio;
130 lists[j].list = list;
134 lists[num_classes].prio = INT_MAX;
136 // Never send an event to two listeners with equal priority.
137 int last_priority = -1;
139 Each iteration extracts the lowest-priority element, which is a
140 list of listeners. The first listener is called, and the tail of
141 the list is pushed back into the priority queue.
145 // Send the event, if we haven't already sent it to this target.
146 if (lists[0].prio != last_priority)
148 // process the listener
149 assert (lists[0].prio > last_priority);
150 last_priority = lists[0].prio;
152 Listener *l = unsmob_listener (scm_cdar (lists[0].list));
153 l->listen (ev->self_scm ());
158 // go to the next listener; bubble-sort the class list.
159 SCM next = scm_cdr (lists[0].list);
160 if (!scm_is_pair (next))
162 int prio = (scm_is_pair (next)) ? scm_to_int (scm_caar (next)) : INT_MAX;
163 for (i = 0; prio > lists[i + 1].prio; i++)
164 lists[i] = lists[i + 1];
165 lists[i].prio = prio;
166 lists[i].list = next;
170 /* TODO: Uncomment. */
172 warning (_f ("Junking event: %s", ly_symbol2string (class_symbol).c_str ()));
177 Dispatcher::broadcast (Stream_event *ev)
179 dispatch (ev->self_scm ());
183 Dispatcher::add_listener (Listener l, SCM ev_class)
185 internal_add_listener (l, ev_class, ++priority_count_);
189 Dispatcher::internal_add_listener (Listener l, SCM ev_class, int priority)
191 SCM list = scm_hashq_ref (listeners_, ev_class, SCM_EOL);
192 if (!scm_is_pair (list))
194 /* Tell all dispatchers that we listen to, that we want to hear ev_class
196 for (SCM disp = dispatchers_; scm_is_pair (disp); disp = scm_cdr (disp))
198 int priority = scm_to_int (scm_cdar (disp));
199 Dispatcher *d = unsmob_dispatcher (scm_caar (disp));
200 d->internal_add_listener (GET_LISTENER (dispatch), ev_class, priority);
202 listen_classes_ = scm_cons (ev_class, listen_classes_);
204 SCM entry = scm_cons (scm_from_int (priority), l.smobbed_copy ());
205 list = scm_merge (list, scm_list_1 (entry), ly_lily_module_constant ("car<"));
206 scm_hashq_set_x (listeners_, ev_class, list);
210 Dispatcher::remove_listener (Listener l, SCM ev_class)
212 SCM list = scm_hashq_ref (listeners_, ev_class, SCM_EOL);
216 programming_error ("remove_listener called with incorrect class.");
220 // We just remove the listener once.
223 SCM dummy = scm_cons (SCM_EOL, list);
225 while (scm_is_pair (scm_cdr (e)))
226 if (*unsmob_listener (scm_cdadr (e)) == l && first)
228 scm_set_cdr_x (e, scm_cddr (e));
234 list = scm_cdr (dummy);
235 scm_hashq_set_x (listeners_, ev_class, list);
238 warning ("Attempting to remove nonexisting listener.");
239 else if (!scm_is_pair (list))
241 /* Unregister with all dispatchers. */
242 for (SCM disp = dispatchers_; scm_is_pair (disp); disp = scm_cdr (disp))
244 Dispatcher *d = unsmob_dispatcher (scm_caar (disp));
245 d->remove_listener (GET_LISTENER (dispatch), ev_class);
247 listen_classes_ = scm_delq_x (ev_class, listen_classes_);
251 /* Register as a listener to another dispatcher. */
253 Dispatcher::register_as_listener (Dispatcher *disp)
255 int priority = ++disp->priority_count_;
257 // Don't register twice to the same dispatcher.
258 if (scm_assq (disp->self_scm (), dispatchers_) != SCM_BOOL_F)
260 warning ("Already listening to dispatcher, ignoring request");
264 dispatchers_ = scm_acons (disp->self_scm (), scm_from_int (priority), dispatchers_);
266 Listener list = GET_LISTENER (dispatch);
267 for (SCM cl = listen_classes_; scm_is_pair (cl); cl = scm_cdr (cl))
269 disp->internal_add_listener (list, scm_car (cl), priority);
273 /* Unregister as a listener to another dispatcher. */
275 Dispatcher::unregister_as_listener (Dispatcher *disp)
277 dispatchers_ = scm_assq_remove_x (dispatchers_, disp->self_scm ());
279 Listener listener = GET_LISTENER (dispatch);
280 for (SCM cl = listen_classes_; scm_is_pair (cl); cl = scm_cdr (cl))
282 disp->remove_listener (listener, scm_car (cl));