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 Han-Wen Nienhuys <hanwen@xs4all.nl>
   7
   8 */
   9
  10 #include "lilypond-key.hh"
  11 #include "ly-smobs.icc"
  12
  13 SCM
  14 Object_key::mark_smob (SCM key)
  15 {
  16   Object_key* k = (Object_key*) SCM_CELL_WORD_1 (key);
  17   k->derived_mark();
  18   return SCM_EOL;
  19 }
  20
  21 void
  22 Object_key::derived_mark () const
  23 {
  24
  25 }
  26
  27 Object_key::~Object_key()
  28 {
  29 }
  30
  31 int
  32 Object_key::get_type () const
  33 {
  34   return GENERAL_KEY;
  35 }
  36
  37 int
  38 Object_key::print_smob (SCM smob, SCM port, scm_print_state*)
  39 {
  40   Object_key* k = (Object_key*) SCM_CELL_WORD_1 (smob);
  41   scm_puts ("#<Object_key ", port);
  42   scm_display (scm_from_int (k->get_type()), port);
  43   scm_puts (">", port);
  44   return 1;
  45 }
  46
  47 Object_key::Object_key ()
  48 {
  49   smobify_self ();
  50 }
  51
  52 int
  53 Object_key::compare (Object_key const *other) const
  54 {
  55   if (this == other)
  56     return 0;
  57
  58   int c = sign (get_type () -  other->get_type());
  59   if (c)
  60     return c;
  61   else
  62     return do_compare (other);
  63 }
  64
  65 IMPLEMENT_SMOBS (Object_key);
  66
  67 SCM
  68 Object_key::equal_p (SCM a , SCM b)
  69 {
  70   Object_key *ka = unsmob_key (a);
  71   Object_key *kb = unsmob_key (b);
  72
  73   return (ka->compare (kb)) ? SCM_BOOL_F : SCM_BOOL_T;
  74 }
  75
  76 int
  77 Object_key::do_compare (Object_key const *) const
  78 {
  79   return 0;
  80 }
  81
  82
  83 SCM
  84 Object_key::dump () const
  85 {
  86   return scm_cons (scm_from_int (get_type()),
  87                    as_scheme());
  88 }
  89
  90
  91
  92 SCM
  93 Object_key::as_scheme () const
  94 {
  95   return SCM_EOL;
  96 }
  97
  98 Object_key*
  99 Object_key::from_scheme (SCM)
 100 {
 101   return new Object_key();
 102 }
 103
 104 struct {
 105   Object_key_type type_;
 106   Object_key* (*ctor_)(SCM);
 107 } undumpers[] = {
 108   {BASE_KEY, Object_key::from_scheme},
 109   {COPIED_KEY, Copied_key::from_scheme},
 110   {GROB_KEY, Lilypond_grob_key::from_scheme},
 111   {CONTEXT_KEY, Lilypond_context_key::from_scheme},
 112   {GENERAL_KEY, Lilypond_general_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
 163 Object_key *
 164 Copied_key::from_scheme (SCM a)
 165 {
 166   return new Copied_key (unsmob_key (scm_car (a)),
 167                          scm_to_int  (scm_list_ref (a, scm_from_int (1))));
 168 }