lily/stream-event.cc

   1 /*
   2   stream-event.cc -- implement Stream_event
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 2005-2006 Erik Sandberg  <mandolaerik@gmail.com>
   7 */
   8
   9 #include "stream-event.hh"
  10
  11 #include "ly-smobs.icc"
  12 #include "context.hh"
  13 #include "input.hh"
  14 #include "input-smob.hh"
  15
  16 Stream_event::~Stream_event ()
  17 {
  18 }
  19
  20 void
  21 Stream_event::init ()
  22 {
  23   self_scm_ = SCM_EOL;
  24   property_alist_ = SCM_EOL;
  25
  26   smobify_self ();
  27 }
  28
  29 Stream_event::Stream_event ()
  30 {
  31   init ();
  32 }
  33
  34 Stream_event::Stream_event (SCM property_alist)
  35 {
  36   init ();
  37   property_alist_ = property_alist;
  38 }
  39
  40 /*
  41    Hm. Perhaps Stream_event should be a prob, with class_name as an
  42    immutable property?
  43  */
  44 Stream_event::Stream_event (SCM class_name, Input *origin)
  45 {
  46   init ();
  47   set_property ("class", class_name);
  48   if (origin)
  49     set_spot (origin);
  50 }
  51
  52 Stream_event::Stream_event (Stream_event *ev)
  53 {
  54   init ();
  55   property_alist_ = scm_copy_tree (ev->property_alist_);
  56 }
  57
  58 Input *
  59 Stream_event::origin () const
  60 {
  61   Input *i = unsmob_input (get_property ("origin"));
  62   return i ? i : &dummy_input_global;
  63 }
  64
  65 void Stream_event::set_spot (Input *i)
  66 {
  67   set_property ("origin", make_input (*i));
  68 }
  69
  70 SCM
  71 Stream_event::mark_smob (SCM sm)
  72 {
  73   Stream_event *me = (Stream_event *) SCM_CELL_WORD_1 (sm);
  74   return me->property_alist_;
  75 }
  76
  77 int
  78 Stream_event::print_smob (SCM s, SCM port, scm_print_state *)
  79 {
  80   scm_puts ("#<Stream_event ", port);
  81   scm_write (dump (s), port);
  82   scm_puts (" >", port);
  83   return 1;
  84 }
  85
  86 IMPLEMENT_SMOBS (Stream_event);
  87 IMPLEMENT_DEFAULT_EQUAL_P (Stream_event);
  88 IMPLEMENT_TYPE_P (Stream_event, "ly:stream-event?");
  89
  90 MAKE_SCHEME_CALLBACK (Stream_event, undump, 1);
  91 MAKE_SCHEME_CALLBACK (Stream_event, dump, 1);
  92
  93 SCM
  94 Stream_event::dump (SCM self)
  95 {
  96   Stream_event *ev = unsmob_stream_event (self);
  97   // Reversed alists look prettier.
  98   return scm_reverse (ev->property_alist_);
  99 }
 100
 101 SCM
 102 Stream_event::undump (SCM data)
 103 {
 104   Stream_event *obj = new Stream_event ();
 105   obj->property_alist_ = scm_reverse (data);
 106   return obj->unprotect ();
 107 }
 108
 109 SCM
 110 Stream_event::internal_get_property (SCM sym) const
 111 {
 112   SCM s = scm_sloppy_assq (sym, property_alist_);
 113   if (s != SCM_BOOL_F)
 114     return scm_cdr (s);
 115   return SCM_EOL;
 116 }
 117
 118 void
 119 Stream_event::internal_set_property (SCM prop, SCM val)
 120 {
 121   property_alist_ = scm_assq_set_x (property_alist_, prop, val);
 122 }