]> git.donarmstrong.com Git - lilypond.git/blob - lily/object-key.cc
(Invoking lilypond-book):
[lilypond.git] / 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_
159                      ? original_->self_scm ()
160                      : SCM_BOOL_F, scm_from_int (copy_count_));
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 }
169