lily/dispatcher.cc

   1 /*
   2   dispatcher.cc -- implement Dispatcher
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 2005-2006 Erik Sandberg  <mandolaerik@gmail.com>
   7 */
   8
   9 #include "dispatcher.hh"
  10 #include "input.hh"
  11 #include "international.hh"
  12 #include "ly-smobs.icc"
  13 #include "warn.hh"
  14
  15 IMPLEMENT_SMOBS (Dispatcher);
  16 IMPLEMENT_TYPE_P (Dispatcher, "ly:dispatcher?");
  17 IMPLEMENT_DEFAULT_EQUAL_P (Dispatcher);
  18
  19 Dispatcher::~Dispatcher ()
  20 {
  21 }
  22
  23 Dispatcher::Dispatcher ()
  24 {
  25   self_scm_ = SCM_EOL;
  26   listeners_ = SCM_EOL;
  27   dispatchers_ = SCM_EOL;
  28   listen_classes_ = SCM_EOL;
  29   smobify_self ();
  30 // TODO: use resizable hash (guile 1.8)
  31 //  listeners_ = scm_c_make_hash_table (0);
  32   listeners_ = scm_c_make_hash_table (17);
  33   priority_count_ = 0;
  34 }
  35
  36 SCM
  37 Dispatcher::mark_smob (SCM sm)
  38 {
  39   Dispatcher *me = (Dispatcher *) SCM_CELL_WORD_1 (sm);
  40   scm_gc_mark (me->dispatchers_);
  41   scm_gc_mark (me->listen_classes_);
  42   return me->listeners_;
  43 }
  44
  45 int
  46 Dispatcher::print_smob (SCM s, SCM p, scm_print_state*)
  47 {
  48   Dispatcher *me = (Dispatcher *) SCM_CELL_WORD_1 (s);
  49   scm_puts ("#<Dispatcher ", p);
  50   scm_write (scm_vector_to_list (me->listeners_), p);
  51   scm_puts (">", p);
  52   return 1;
  53 }
  54
  55 /*
  56 Event dispatching:
  57 - Collect a list of listeners for each relevant class
  58 - Send the event to each of these listeners, in increasing priority order.
  59   This is done by keeping a priority queue of listener lists,
  60   and iteratively send the event to the lowest-priority listener.
  61 - An event is never sent twice to listeners with equal priority.
  62 */
  63 IMPLEMENT_LISTENER (Dispatcher, dispatch);
  64 void
  65 Dispatcher::dispatch (SCM sev)
  66 {
  67   Stream_event *ev = unsmob_stream_event (sev);
  68   SCM class_symbol = ev->get_property ("class");
  69   if (!scm_symbol_p (class_symbol))
  70     {
  71       warning (_ ("Event class should be a symbol"));
  72       return;
  73     }
  74
  75   SCM class_list = scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), class_symbol);
  76   if (!scm_is_pair (class_list))
  77     {
  78       ev->origin ()->warning (_f ("Unknown event class %s", ly_symbol2string (class_symbol).c_str ()));
  79       return;
  80     }
  81   bool sent = false;
  82   int num_classes = scm_ilength (class_list);
  83
  84   /*
  85     For each event class there is a list of listeners, which is
  86     ordered by priority. Our next task is to call these listeners, in
  87     priority order.  A priority queue stores the next element in each
  88     listener list, and the lowest priority element is repeatedly
  89     extracted and called.
  90
  91     The priority queue is implemented as a bubble-sorted C
  92     array. Using the stack instead of native Scheme datastructures
  93     avoids overheads for memory allocation. The queue is usually small
  94     (around 2 elements), so the quadratic sorting time is not a
  95     problem. (if this changes, it's easy to rewrite this routine using
  96     a heap)
  97
  98     The first step is to collect all listener lists and to initially
  99     insert them in the priority queue.
 100   */
 101   struct { int prio; SCM list; } lists[num_classes+1];
 102   int i = 0;
 103   for (SCM cl = class_list; scm_is_pair (cl); cl = scm_cdr (cl))
 104     {
 105       SCM list = scm_hashq_ref (listeners_, scm_car (cl), SCM_EOL);
 106       if (!scm_is_pair (list))
 107         num_classes--;
 108       else
 109         {
 110           // bubblesort.
 111           int prio = scm_to_int (scm_caar (list));
 112           int j;
 113           for (j = i; j > 0 && lists[j-1].prio > prio; j--)
 114             lists[j] = lists[j-1];
 115           lists[j].prio = prio;
 116           lists[j].list = list;
 117           i++;
 118         }
 119     }
 120   lists[num_classes].prio = INT_MAX;
 121
 122   // Never send an event to two listeners with equal priority.
 123   int last_priority = -1;
 124   /*
 125     Each iteration extracts the lowest-priority element, which is a
 126     list of listeners. The first listener is called, and the tail of
 127     the list is pushed back into the priority queue.
 128   */
 129   while (num_classes)
 130     {
 131       // Send the event, if we haven't already sent it to this target.
 132       if (lists[0].prio != last_priority)
 133         {
 134           // process the listener
 135           assert (lists[0].prio > last_priority);
 136           last_priority = lists[0].prio;
 137
 138           Listener *l = unsmob_listener (scm_cdar (lists[0].list));
 139           l->listen (ev->self_scm ());
 140           sent = true;
 141         }
 142       // go to the next listener; bubble-sort the class list.
 143       SCM next = scm_cdr (lists[0].list);
 144       if (!scm_is_pair (next))
 145         num_classes--;
 146       int prio = (scm_is_pair (next)) ? scm_to_int (scm_caar (next)) : INT_MAX;
 147       for (i = 0; prio > lists[i+1].prio; i++)
 148         lists[i] = lists[i+1];
 149       lists[i].prio = prio;
 150       lists[i].list = next;
 151     }
 152
 153 /* TODO: Uncomment.
 154   if (!sent)
 155     warning (_f ("Junking event: %s", ly_symbol2string (class_symbol).c_str ()));
 156 */
 157 }
 158
 159 void
 160 Dispatcher::broadcast (Stream_event *ev)
 161 {
 162   dispatch (ev->self_scm ());
 163 }
 164
 165 void
 166 Dispatcher::add_listener (Listener l, SCM ev_class)
 167 {
 168   internal_add_listener (l, ev_class, ++priority_count_);
 169 }
 170
 171 inline void
 172 Dispatcher::internal_add_listener (Listener l, SCM ev_class, int priority)
 173 {
 174   SCM list = scm_hashq_ref (listeners_, ev_class, SCM_EOL);
 175   if (!scm_is_pair (list))
 176     {
 177       /* Tell all dispatchers that we listen to, that we want to hear ev_class
 178          events */
 179       for (SCM disp = dispatchers_; scm_is_pair (disp); disp = scm_cdr (disp))
 180         {
 181           int priority = scm_to_int (scm_cdar (disp));
 182           Dispatcher *d = unsmob_dispatcher (scm_caar (disp));
 183           d->internal_add_listener (GET_LISTENER (dispatch), ev_class, priority);
 184         }
 185       listen_classes_ = scm_cons (ev_class, listen_classes_);
 186     }
 187   SCM entry = scm_cons (scm_int2num (priority), l.smobbed_copy ());
 188   list = scm_merge (list, scm_list_1 (entry), ly_lily_module_constant ("car<"));
 189   scm_hashq_set_x (listeners_, ev_class, list);
 190 }
 191
 192 void
 193 Dispatcher::remove_listener (Listener l, SCM ev_class)
 194 {
 195   SCM list = scm_hashq_ref (listeners_, ev_class, SCM_EOL);
 196
 197   if (list == SCM_EOL)
 198     {
 199       programming_error ("remove_listener called with incorrect class.");
 200       return;
 201     }
 202
 203   // We just remove the listener once.
 204   bool first = true;
 205
 206   SCM dummy = scm_cons (SCM_EOL, list);
 207   SCM e = dummy;
 208   while (scm_is_pair (scm_cdr (e)))
 209     if (*unsmob_listener (scm_cdadr (e)) == l && first)
 210       {
 211         scm_set_cdr_x (e, scm_cddr (e));
 212         first = false;
 213         break;
 214       }
 215     else
 216       e = scm_cdr (e);
 217   list = scm_cdr (dummy);
 218   scm_hashq_set_x (listeners_, ev_class, list);
 219
 220   if (first)
 221     warning ("Attempting to remove nonexisting listener.");
 222   else if (!scm_is_pair (list))
 223     {
 224       /* Unregister with all dispatchers. */
 225       for (SCM disp = dispatchers_; scm_is_pair (disp); disp = scm_cdr (disp))
 226         {
 227           Dispatcher *d = unsmob_dispatcher (scm_caar (disp));
 228           d->remove_listener (GET_LISTENER (dispatch), ev_class);
 229         }
 230       listen_classes_ = scm_delq_x (ev_class, listen_classes_);
 231     }
 232 }
 233
 234 /* Register as a listener to another dispatcher. */
 235 void
 236 Dispatcher::register_as_listener (Dispatcher *disp)
 237 {
 238   int priority = ++disp->priority_count_;
 239
 240   // Don't register twice to the same dispatcher.
 241   if (scm_assq (disp->self_scm (), dispatchers_) != SCM_BOOL_F)
 242     {
 243       warning ("Already listening to dispatcher, ignoring request");
 244       return;
 245     }
 246
 247   dispatchers_ = scm_acons (disp->self_scm (), scm_int2num (priority), dispatchers_);
 248
 249   Listener list = GET_LISTENER (dispatch);
 250   for (SCM cl = listen_classes_; scm_is_pair (cl); cl = scm_cdr (cl))
 251     {
 252       disp->internal_add_listener (list, scm_car (cl), priority);
 253     }
 254 }
 255
 256 /* Unregister as a listener to another dispatcher. */
 257 void
 258 Dispatcher::unregister_as_listener (Dispatcher *disp)
 259 {
 260   dispatchers_ = scm_assq_remove_x (dispatchers_, disp->self_scm ());
 261
 262   Listener listener = GET_LISTENER (dispatch);
 263   for (SCM cl = listen_classes_; scm_is_pair (cl); cl = scm_cdr (cl))
 264     {
 265       disp->remove_listener (listener, scm_car (cl));
 266     }
 267 }