2 dispatcher.cc -- implement Dispatcher
4 source file of the GNU LilyPond music typesetter
6 (c) 2005-2006 Erik Sandberg <mandolaerik@gmail.com>
9 #include "dispatcher.hh"
11 #include "international.hh"
12 #include "ly-smobs.icc"
13 #include "stream-event.hh"
16 IMPLEMENT_SMOBS (Dispatcher);
17 IMPLEMENT_TYPE_P (Dispatcher, "dispatcher");
18 IMPLEMENT_DEFAULT_EQUAL_P (Dispatcher);
20 Dispatcher::~Dispatcher ()
24 Dispatcher::Dispatcher ()
28 dispatchers_ = SCM_EOL;
29 listen_classes_ = SCM_EOL;
31 // TODO: use resizable hash (guile 1.8)
32 // listeners_ = scm_c_make_hash_table (0);
33 listeners_ = scm_c_make_hash_table (17);
38 Dispatcher::mark_smob (SCM sm)
40 Dispatcher *me = (Dispatcher *) SCM_CELL_WORD_1 (sm);
41 scm_gc_mark (me->dispatchers_);
42 scm_gc_mark (me->listen_classes_);
43 return me->listeners_;
47 Dispatcher::print_smob (SCM s, SCM p, scm_print_state*)
49 Dispatcher *me = (Dispatcher *) SCM_CELL_WORD_1 (s);
50 scm_puts ("#<Dispatcher ", p);
51 scm_write (scm_vector_to_list (me->listeners_), p);
58 - Collect a list of listeners for each relevant class
59 - Send the event to each of these listeners, in increasing priority order.
60 This is done by keeping a priority queue of listener lists,
61 and iteratively send the event to the lowest-priority listener.
62 - An event is never sent twice to listeners with equal priority.
64 IMPLEMENT_LISTENER (Dispatcher, dispatch);
66 Dispatcher::dispatch (SCM sev)
68 Stream_event *ev = unsmob_stream_event (sev);
69 SCM class_symbol = ev->get_property ("class");
70 if (!scm_symbol_p (class_symbol))
72 warning (_f ("Event class should be a symbol"));
76 SCM class_list = scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), class_symbol);
77 if (!scm_is_pair (class_list))
79 // TODO: Re-enable this warning when the translator cleanup is finished
80 //ev->origin ()->warning (_f ("Unknown event class %s", ly_symbol2string (class_symbol).c_str ()));
84 int num_classes = scm_ilength (class_list);
87 For each event class there is a list of listeners, which is
88 ordered by priority. Our next task is to call these listeners, in
89 priority order. A priority queue stores the next element in each
90 listener list, and the lowest priority element is repeatedly
93 The priority queue is implemented as a bubble-sorted C
94 array. Using the stack instead of native Scheme datastructures
95 avoids overheads for memory allocation. The queue is usually small
96 (around 2 elements), so the quadratic sorting time is not a
97 problem. (if this changes, it's easy to rewrite this routine using
100 The first step is to collect all listener lists and to initially
101 insert them in the priority queue.
103 struct { int prio; SCM list; } lists[num_classes+1];
105 for (SCM cl = class_list; scm_is_pair(cl); cl = scm_cdr (cl))
107 SCM list = scm_hashq_ref (listeners_, scm_car (cl), SCM_EOL);
108 if (!scm_is_pair(list))
113 int prio = scm_to_int (scm_caar (list));
115 for (j = i; j > 0 && lists[j-1].prio > prio; j--)
116 lists[j] = lists[j-1];
117 lists[j].prio = prio;
118 lists[j].list = list;
122 lists[num_classes].prio = INT_MAX;
124 // Never send an event to two listeners with equal priority.
125 int last_priority = -1;
127 Each iteration extracts the lowest-priority element, which is a
128 list of listeners. The first listener is called, and the tail of
129 the list is pushed back into the priority queue.
133 // Send the event, if we haven't already sent it to this target.
134 if (lists[0].prio != last_priority)
136 // process the listener
137 assert (lists[0].prio > last_priority);
138 last_priority = lists[0].prio;
140 Listener *l = unsmob_listener (scm_cdar (lists[0].list));
141 l->listen (ev->self_scm ());
144 // go to the next listener; bubble-sort the class list.
145 SCM next = scm_cdr (lists[0].list);
146 if (!scm_is_pair(next))
148 int prio = (scm_is_pair(next)) ? scm_to_int (scm_caar (next)) : INT_MAX;
149 for (i = 0; prio > lists[i+1].prio; i++)
150 lists[i] = lists[i+1];
151 lists[i].prio = prio;
152 lists[i].list = next;
157 warning (_f ("Junking event: %s", ly_symbol2string (class_symbol).c_str ()));
162 Dispatcher::broadcast (Stream_event *ev)
164 dispatch (ev->self_scm ());
168 Dispatcher::add_listener (Listener l, SCM ev_class)
170 internal_add_listener (l, ev_class, ++priority_count_);
174 Dispatcher::internal_add_listener (Listener l, SCM ev_class, int priority)
176 SCM list = scm_hashq_ref (listeners_, ev_class, SCM_EOL);
177 if (!scm_is_pair (list))
179 /* Tell all dispatchers that we listen to, that we want to hear ev_class
181 for (SCM disp = dispatchers_; scm_is_pair(disp); disp = scm_cdr (disp))
183 int priority = scm_to_int (scm_cdar (disp));
184 Dispatcher *d = unsmob_dispatcher (scm_caar (disp));
185 d->internal_add_listener (GET_LISTENER (dispatch), ev_class, priority);
187 listen_classes_ = scm_cons (ev_class, listen_classes_);
189 SCM entry = scm_cons (scm_int2num (priority), l.smobbed_copy ());
190 list = scm_merge (list, scm_list_1 (entry), ly_lily_module_constant ("car<"));
191 scm_hashq_set_x (listeners_, ev_class, list);
195 Dispatcher::remove_listener (Listener l, SCM ev_class)
197 SCM list = scm_hashq_ref (listeners_, ev_class, SCM_EOL);
201 programming_error ("remove_listener called with incorrect class.");
205 // We just remove the listener once.
208 SCM dummy = scm_cons (SCM_EOL, list);
210 while (scm_is_pair(scm_cdr (e)))
211 if (*unsmob_listener (scm_cdadr (e)) == l && first)
213 scm_set_cdr_x (e, scm_cddr(e));
219 list = scm_cdr (dummy);
220 scm_hashq_set_x (listeners_, ev_class, list);
223 warning ("Attempting to remove nonexisting listener.");
224 else if (!scm_is_pair (list))
226 /* Unregister with all dispatchers. */
227 for (SCM disp = dispatchers_; disp != SCM_EOL; disp = scm_cdr (disp))
229 Dispatcher *d = unsmob_dispatcher (scm_caar (disp));
230 d->remove_listener (GET_LISTENER (dispatch), ev_class);
232 listen_classes_ = scm_delq_x (ev_class, listen_classes_);
236 /* Register as a listener to another dispatcher. */
238 Dispatcher::register_as_listener (Dispatcher *disp)
240 int priority = ++disp->priority_count_;
242 // Don't register twice to the same dispatcher.
243 if (scm_assq (disp->self_scm (), dispatchers_) != SCM_BOOL_F)
245 warning ("Already listening to dispatcher, ignoring request");
249 dispatchers_ = scm_acons (disp->self_scm (), scm_int2num (priority), dispatchers_);
251 Listener list = GET_LISTENER (dispatch);
252 for (SCM cl = listen_classes_; cl != SCM_EOL; cl = scm_cdr (cl))
254 disp->internal_add_listener (list, scm_car (cl), priority);
258 /* Unregister as a listener to another dispatcher. */
260 Dispatcher::unregister_as_listener (Dispatcher *disp)
262 dispatchers_ = scm_assq_remove_x (dispatchers_, disp->self_scm ());
264 Listener listener = GET_LISTENER (dispatch);
265 for (SCM cl = listen_classes_; scm_is_pair (cl); cl = scm_cdr (cl))
267 disp->remove_listener (listener, scm_car (cl));