2 music.cc -- implement Music
4 source file of the GNU LilyPond music typesetter
6 (c) 1997--2002 Han-Wen Nienhuys <hanwen@cs.uu.nl>
10 #include "input-smob.hh"
12 #include "music-list.hh"
15 #include "ly-smobs.icc"
18 ly_deep_mus_copy (SCM m)
22 SCM ss = unsmob_music (m)->clone ()->self_scm ();
23 scm_gc_unprotect_object (ss);
26 else if (gh_pair_p (m))
28 return gh_cons (ly_deep_mus_copy (ly_car (m)), ly_deep_mus_copy (ly_cdr (m)));
37 immutable_property_alist_ = SCM_EOL;
38 mutable_property_alist_ = SCM_EOL;
42 Music::Music (Music const &m)
44 immutable_property_alist_ = m.immutable_property_alist_;
45 mutable_property_alist_ = SCM_EOL;
48 First we smobify_self, then we copy over the stuff. If we don't,
49 stack vars that hold the copy might be optimized away, meaning
50 that they won't be protected from GC.
53 mutable_property_alist_ = ly_deep_mus_copy (m.mutable_property_alist_);
54 set_spot (*m.origin ());
60 immutable_property_alist_ = l;
61 mutable_property_alist_ = SCM_EOL;
67 Music::mark_smob (SCM m)
69 Music * mus = (Music *)SCM_CELL_WORD_1 (m);
70 scm_gc_mark (mus->immutable_property_alist_);
71 scm_gc_mark (mus->mutable_property_alist_);
76 Music::compress (Moment)
83 Music::length_mom () const
85 SCM l = get_mus_property ("length");
86 if (unsmob_moment (l))
87 return *unsmob_moment (l);
88 else if (gh_procedure_p (l))
90 SCM res = gh_call1 (l, self_scm ());
91 return *unsmob_moment (res);
98 Music::start_mom () const
100 SCM l = get_mus_property ("start-moment-function");
101 if (gh_procedure_p (l))
103 SCM res = gh_call1 (l, self_scm ());
104 return *unsmob_moment (res);
112 print_alist (SCM a, SCM port)
115 SCM_EOL -> catch malformed lists.
117 for (SCM s = a; s != SCM_EOL; s = ly_cdr (s))
119 scm_display (ly_caar (s), port);
120 scm_puts (" = ", port);
121 scm_write (ly_cdar (s), port);
122 scm_puts ("\n", port);
127 Music::print_smob (SCM s, SCM p, scm_print_state*)
129 scm_puts ("#<Music ", p);
130 Music* m = unsmob_music (s);
131 scm_puts (classname (m),p);
133 print_alist (m->mutable_property_alist_, p);
134 print_alist (m->immutable_property_alist_, p);
141 Music::to_relative_octave (Pitch m)
148 Music::transpose (Pitch delta)
150 Pitch *p = unsmob_pitch (get_mus_property ("pitch"));
155 np.transpose (delta);
157 if (abs (np.alteration_) > 2)
159 warning (_f ("Transposition by %s makes accidental larger than two",
163 set_mus_property ("pitch", np.smobbed_copy ());
166 IMPLEMENT_TYPE_P (Music, "music?");
168 IMPLEMENT_SMOBS (Music);
169 IMPLEMENT_DEFAULT_EQUAL_P (Music);
171 /****************************/
174 Music::internal_get_mus_property (SCM sym) const
176 SCM s = scm_sloppy_assq (sym, mutable_property_alist_);
180 s = scm_sloppy_assq (sym, immutable_property_alist_);
181 return (s == SCM_BOOL_F) ? SCM_EOL : ly_cdr (s);
185 Music::internal_set_mus_property (SCM s, SCM v)
187 if (internal_type_checking_global_b)
188 if (!type_check_assignment (s, v, ly_symbol2scm ("music-type?")))
191 mutable_property_alist_ = scm_assq_set_x (mutable_property_alist_, s, v);
199 Music::set_spot (Input ip)
201 set_mus_property ("origin", make_input (ip));
205 Music::origin () const
207 Input *ip = unsmob_input (get_mus_property ("origin"));
208 return ip ? ip : & dummy_input_global;
217 LY_DEFINE(ly_get_mus_property,
218 "ly-get-mus-property", 2, 0, 0, (SCM mus, SCM sym),
219 "Get the property @var{sym} of music expression @var{mus}.")
221 Music * sc = unsmob_music (mus);
222 SCM_ASSERT_TYPE(sc, mus, SCM_ARG1, __FUNCTION__, "music");
223 SCM_ASSERT_TYPE(gh_symbol_p (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
225 return sc->internal_get_mus_property (sym);
228 LY_DEFINE(ly_set_mus_property,
229 "ly-set-mus-property!", 3, 0, 0,
230 (SCM mus, SCM sym, SCM val),
231 "Set property @var{sym} in music expression @var{mus} to @var{val}.")
233 Music * sc = unsmob_music (mus);
234 SCM_ASSERT_TYPE(sc, mus, SCM_ARG1, __FUNCTION__, "music");
235 SCM_ASSERT_TYPE(gh_symbol_p (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
237 bool ok = type_check_assignment (sym, val, ly_symbol2scm ("music-type?"));
240 sc->internal_set_mus_property (sym, val);
243 return SCM_UNSPECIFIED;
247 // to do property args
248 LY_DEFINE(ly_make_music,
249 "ly-make-music", 1, 0, 0, (SCM type),
251 Make a music object/expression of type @var{name}. Warning: this
252 interface will likely change in the near future.
256 Music is the data type that music expressions are stored in. The data
257 type does not yet offer many manipulations.
260 SCM_ASSERT_TYPE(gh_string_p (type), type, SCM_ARG1, __FUNCTION__, "string");
262 SCM s = make_music (ly_scm2string (type))->self_scm ();
263 scm_gc_unprotect_object (s);
268 LY_DEFINE(ly_music_name, "ly-music-name", 1, 0, 0,
270 "Return the name of @var{music}.")
272 Music * m = unsmob_music (mus);
273 SCM_ASSERT_TYPE(m, mus, SCM_ARG1, __FUNCTION__ ,"music");
275 const char * nm = classname (m);
276 return scm_makfrom0str (nm);
279 LY_DEFINE(ly_music_list_p,"music-list?", 1, 0, 0,
280 (SCM l),"Type predicate: return true if @var{l} is a list of music objects.")
282 if (scm_list_p (l) != SCM_BOOL_T)
285 while (gh_pair_p (l))
287 if (!unsmob_music (gh_car (l)))