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
  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 Object_dumper_table_entry {
 105   Object_key_type type_;
 106   Object_key* (*ctor_)(SCM);
 107 };
 108
 109 static Object_dumper_table_entry undumpers[] = {
 110   {BASE_KEY, Object_key::from_scheme},
 111   {COPIED_KEY, Copied_key::from_scheme},
 112   {GENERAL_KEY, Lilypond_general_key::from_scheme},
 113   {GROB_KEY, Lilypond_grob_key::from_scheme},
 114   {CONTEXT_KEY, Lilypond_context_key::from_scheme},
 115   {KEY_COUNT, 0},
 116 };
 117
 118 Object_key *
 119 Object_key::undump (SCM scm_key)
 120 {
 121   int t = scm_to_int (scm_car (scm_key));
 122   assert (t == undumpers[t].type_);
 123   return (undumpers[t].ctor_)(scm_cdr (scm_key));
 124 }
 125
 126 /****************************************************************/
 127
 128 Copied_key::Copied_key (Object_key const* key, int count)
 129 {
 130   copy_count_ = count;
 131   original_ = key;
 132 }
 133
 134 int
 135 Copied_key::get_type () const
 136 {
 137   return COPIED_KEY;
 138 }
 139
 140 int
 141 Copied_key::do_compare (Object_key const *key) const
 142 {
 143   Copied_key const *other = dynamic_cast<Copied_key const*> (key);
 144
 145   int c = original_->compare (other->original_);
 146   if (c)
 147     return c;
 148
 149   return sign (copy_count_ - other->copy_count_);
 150 }
 151
 152 void
 153 Copied_key::derived_mark () const
 154 {
 155   scm_gc_mark (original_->self_scm ());
 156 }
 157
 158 SCM
 159 Copied_key::as_scheme () const
 160 {
 161   return scm_list_2 (original_ ? original_->self_scm() : SCM_BOOL_F, scm_from_int (copy_count_));
 162 }
 163
 164
 165 Object_key *
 166 Copied_key::from_scheme (SCM a)
 167 {
 168   return new Copied_key (unsmob_key (scm_car (a)),
 169                          scm_to_int  (scm_list_ref (a, scm_from_int (1))));
 170 }