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