lily/object-key.cc

   1 /*
   2   object-key.cc -- implement Object_key
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 2004--2006 Han-Wen Nienhuys <hanwen@xs4all.nl>
   7 */
   8
   9 #include "lilypond-key.hh"
  10 #include "ly-smobs.icc"
  11
  12 SCM
  13 Object_key::mark_smob (SCM key)
  14 {
  15   Object_key *k = (Object_key *) SCM_CELL_WORD_1 (key);
  16   k->derived_mark ();
  17   return SCM_EOL;
  18 }
  19
  20 void
  21 Object_key::derived_mark () const
  22 {
  23 }
  24
  25 Object_key::~Object_key ()
  26 {
  27 }
  28
  29 int
  30 Object_key::get_type () const
  31 {
  32   return GENERAL_KEY;
  33 }
  34
  35 int
  36 Object_key::print_smob (SCM smob, SCM port, scm_print_state*)
  37 {
  38   Object_key *k = (Object_key *) SCM_CELL_WORD_1 (smob);
  39   scm_puts ("#<Object_key ", port);
  40   scm_display (scm_from_int (k->get_type ()), port);
  41   scm_puts (">", port);
  42   return 1;
  43 }
  44
  45 Object_key::Object_key ()
  46 {
  47   smobify_self ();
  48 }
  49
  50 int
  51 Object_key::compare (Object_key const *other) const
  52 {
  53   if (this == other)
  54     return 0;
  55
  56   int c = sign (get_type () - other->get_type ());
  57   if (c)
  58     return c;
  59   else
  60     return do_compare (other);
  61 }
  62
  63 IMPLEMENT_SMOBS (Object_key);
  64
  65 SCM
  66 Object_key::equal_p (SCM a, SCM b)
  67 {
  68   Object_key *ka = unsmob_key (a);
  69   Object_key *kb = unsmob_key (b);
  70
  71   return (ka->compare (kb)) ? SCM_BOOL_F : SCM_BOOL_T;
  72 }
  73
  74 int
  75 Object_key::do_compare (Object_key const *) const
  76 {
  77   return 0;
  78 }
  79
  80 SCM
  81 Object_key::dump () const
  82 {
  83   return scm_cons (scm_from_int (get_type ()),
  84                    as_scheme ());
  85 }
  86
  87 SCM
  88 Object_key::as_scheme () const
  89 {
  90   return SCM_EOL;
  91 }
  92
  93 Object_key *
  94 Object_key::from_scheme (SCM)
  95 {
  96   return new Object_key ();
  97 }
  98
  99 struct Object_dumper_table_entry
 100 {
 101   Object_key_type type_;
 102   Object_key *(*ctor_) (SCM);
 103 };
 104
 105 static Object_dumper_table_entry undumpers[]
 106 = {
 107   {BASE_KEY, Object_key::from_scheme},
 108   {COPIED_KEY, Copied_key::from_scheme},
 109   {GENERAL_KEY, Lilypond_general_key::from_scheme},
 110   {GROB_KEY, Lilypond_grob_key::from_scheme},
 111   {CONTEXT_KEY, Lilypond_context_key::from_scheme},
 112   {KEY_COUNT, 0},
 113 };
 114
 115 Object_key *
 116 Object_key::undump (SCM scm_key)
 117 {
 118   int t = scm_to_int (scm_car (scm_key));
 119   assert (t == undumpers[t].type_);
 120   return (undumpers[t].ctor_) (scm_cdr (scm_key));
 121 }
 122
 123 /****************************************************************/
 124
 125 Copied_key::Copied_key (Object_key const *key, int count)
 126 {
 127   copy_count_ = count;
 128   original_ = key;
 129 }
 130
 131 int
 132 Copied_key::get_type () const
 133 {
 134   return COPIED_KEY;
 135 }
 136
 137 int
 138 Copied_key::do_compare (Object_key const *key) const
 139 {
 140   Copied_key const *other = dynamic_cast<Copied_key const *> (key);
 141
 142   int c = original_->compare (other->original_);
 143   if (c)
 144     return c;
 145
 146   return sign (copy_count_ - other->copy_count_);
 147 }
 148
 149 void
 150 Copied_key::derived_mark () const
 151 {
 152   scm_gc_mark (original_->self_scm ());
 153 }
 154
 155 SCM
 156 Copied_key::as_scheme () const
 157 {
 158   return scm_list_2 (original_ ? original_->self_scm () : SCM_BOOL_F, scm_from_int (copy_count_));
 159 }
 160
 161 Object_key *
 162 Copied_key::from_scheme (SCM a)
 163 {
 164   return new Copied_key (unsmob_key (scm_car (a)),
 165                          scm_to_int (scm_list_ref (a, scm_from_int (1))));
 166 }