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"
10 #include "international.hh"
11 #include "ly-smobs.icc"
12 #include "stream-event.hh"
15 // ES todo: move to lily-guile.hh
16 SCM appendable_list ();
17 void appendable_list_append (SCM l, SCM elt);
19 IMPLEMENT_SMOBS (Dispatcher);
20 IMPLEMENT_TYPE_P (Dispatcher, "dispatcher");
21 IMPLEMENT_DEFAULT_EQUAL_P (Dispatcher);
23 Dispatcher::~Dispatcher ()
27 Dispatcher::Dispatcher ()
31 dispatchers_ = SCM_EOL;
32 listen_classes_ = SCM_EOL;
34 // TODO: use resizable hash (guile 1.8)
35 // listeners_ = scm_c_make_hash_table (0);
36 listeners_ = scm_c_make_hash_table (17);
41 Dispatcher::mark_smob (SCM sm)
43 Dispatcher *me = (Dispatcher *) SCM_CELL_WORD_1 (sm);
44 scm_gc_mark (me->dispatchers_);
45 scm_gc_mark (me->listen_classes_);
46 return me->listeners_;
50 Dispatcher::print_smob (SCM s, SCM p, scm_print_state*)
52 Dispatcher *me = (Dispatcher *) SCM_CELL_WORD_1 (s);
53 scm_puts ("#<Dispatcher ", p);
54 scm_write (scm_vector_to_list (me->listeners_), p);
61 - Collect a list of listeners for each relevant class
62 - Send the event to each of these listeners, in increasing priority order.
63 This is done by keeping a priority queue of listener lists,
64 and iteratively send the event to the lowest-priority listener.
65 - An event is never sent twice to listeners with equal priority.
67 IMPLEMENT_LISTENER (Dispatcher, dispatch);
69 Dispatcher::dispatch (SCM sev)
71 Stream_event *ev = unsmob_stream_event (sev);
72 SCM class_symbol = ev->get_property ("class");
73 if (!scm_symbol_p (class_symbol))
75 warning (_f ("Unknown event class %s", ly_symbol2string (class_symbol).c_str ()));
79 SCM class_list = scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), class_symbol);
81 int num_classes = scm_ilength (class_list);
84 For each event class there is a list of listeners, which is
85 ordered by priority. Our next task is to call these listeners, in
86 priority order. A priority queue stores the next element in each
87 listener list, and the lowest priority element is repeatedly
90 The priority queue is implemented as a bubble-sorted C
91 array. Using the stack instead of native Scheme datastructures
92 avoids overheads for memory allocation. The queue is usually small
93 (around 2 elements), so the quadratic sorting time is not a
94 problem. (if this changes, it's easy to rewrite this routine using
97 The first step is to collect all listener lists and to initially
98 insert them in the priority queue.
100 struct { int prio; SCM list; } lists[num_classes+1];
102 for (SCM cl = class_list; scm_is_pair(cl); cl = scm_cdr (cl))
104 SCM list = scm_hashq_ref (listeners_, scm_car (cl), SCM_EOL);
105 if (!scm_is_pair(list))
110 int prio = scm_to_int (scm_caar (list));
112 for (j = i; j > 0 && lists[j-1].prio > prio; j--)
113 lists[j] = lists[j-1];
114 lists[j].prio = prio;
115 lists[j].list = list;
119 lists[num_classes].prio = INT_MAX;
121 // Never send an event to two listeners with equal priority.
122 int last_priority = -1;
124 Each iteration extracts the lowest-priority element, which is a
125 list of listeners. The first listener is called, and the tail of
126 the list is pushed back into the priority queue.
130 // Send the event, if we haven't already sent it to this target.
131 if (lists[0].prio != last_priority)
133 // process the listener
134 assert (lists[0].prio > last_priority);
135 last_priority = lists[0].prio;
137 Listener *l = unsmob_listener (scm_cdar (lists[0].list));
138 l->listen (ev->self_scm ());
141 // go to the next listener; bubble-sort the class list.
142 SCM next = scm_cdr (lists[0].list);
143 if (!scm_is_pair(next))
145 int prio = (scm_is_pair(next)) ? scm_to_int (scm_caar (next)) : INT_MAX;
146 for (i = 0; prio > lists[i+1].prio; i++)
147 lists[i] = lists[i+1];
148 lists[i].prio = prio;
149 lists[i].list = next;
154 warning (_f ("Junking event: %s", ly_symbol2string (class_symbol).c_str ()));
159 Dispatcher::broadcast (Stream_event *ev)
161 dispatch (ev->self_scm ());
165 Dispatcher::add_listener (Listener l, SCM ev_class)
167 internal_add_listener (l, ev_class, ++priority_count_);
171 Dispatcher::internal_add_listener (Listener l, SCM ev_class, int priority)
173 SCM list = scm_hashq_ref (listeners_, ev_class, SCM_EOL);
176 /* Register with all dispatchers. */
177 for (SCM disp = dispatchers_; scm_is_pair(disp); disp = scm_cdr (disp))
179 int priority = scm_to_int (scm_cdar (disp));
180 Dispatcher *d = unsmob_dispatcher (scm_caar (disp));
181 d->internal_add_listener (GET_LISTENER (dispatch), ev_class, priority);
183 listen_classes_ = scm_cons (ev_class, listen_classes_);
185 SCM entry = scm_cons (scm_int2num (priority), l.smobbed_copy ());
186 list = scm_merge_x (list, scm_list_1 (entry), ly_lily_module_constant ("car<"));
187 scm_hashq_set_x (listeners_, ev_class, list);
191 Dispatcher::remove_listener (Listener l, SCM ev_class)
193 SCM list = scm_hashq_ref (listeners_, ev_class, SCM_EOL);
197 programming_error ("remove_listener called with incorrect class.");
201 // We just remove the listener once.
204 SCM dummy = scm_cons (SCM_EOL, list);
206 while (scm_is_pair(scm_cdr (e)))
207 if (*unsmob_listener (scm_cdadr (e)) == l && first)
209 scm_set_cdr_x (e, scm_cddr(e));
215 list = scm_cdr (dummy);
218 warning ("Attempting to remove nonexisting listener.");
219 else if (list == SCM_EOL)
221 /* Unregister with all dispatchers. */
222 for (SCM disp = dispatchers_; disp != SCM_EOL; disp = scm_cdr (disp))
224 Dispatcher *d = unsmob_dispatcher (scm_caar (disp));
225 d->remove_listener (GET_LISTENER (dispatch), ev_class);
227 listen_classes_ = scm_delq_x (ev_class, listen_classes_);
231 /* Register as a listener to another dispatcher. */
233 Dispatcher::register_as_listener (Dispatcher *disp)
235 int priority = ++disp->priority_count_;
237 // Don't register twice to the same dispatcher.
238 if (scm_assq (disp->self_scm (), dispatchers_) != SCM_BOOL_F)
240 warning ("Already listening to dispatcher, ignoring request");
244 dispatchers_ = scm_acons (disp->self_scm (), scm_int2num (priority), dispatchers_);
246 Listener list = GET_LISTENER (dispatch);
247 for (SCM cl = listen_classes_; cl != SCM_EOL; cl = scm_cdr (cl))
249 disp->internal_add_listener (list, scm_car (cl), priority);
253 /* Unregister as a listener to another dispatcher. */
255 Dispatcher::unregister_as_listener (Dispatcher *disp)
257 dispatchers_ = scm_assq_remove_x (dispatchers_, disp->self_scm ());
259 Listener list = GET_LISTENER (dispatch);
260 for (SCM cl = listen_classes_; cl != SCM_EOL; cl = scm_cdr (cl))
262 disp->remove_listener (list, scm_car (cl));