2 music.cc -- implement Music
4 source file of the GNU LilyPond music typesetter
6 (c) 1997--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
10 #include "input-smob.hh"
12 #include "music-list.hh"
15 #include "ly-smobs.icc"
20 Music::internal_is_music_type (SCM k)const
22 SCM ifs = get_property ("types");
24 return scm_memq (k, ifs) != SCM_BOOL_F;
30 SCM nm = get_property ("name");
33 return ly_symbol2string (nm);
37 return classname (this);
43 Music::Music (Music const &m)
45 immutable_property_alist_ = m.immutable_property_alist_;
46 mutable_property_alist_ = SCM_EOL;
50 First we smobify_self, then we copy over the stuff. If we don't,
51 stack vars that hold the copy might be optimized away, meaning
52 that they won't be protected from GC.
55 mutable_property_alist_ = ly_deep_mus_copy (m.mutable_property_alist_);
56 set_spot (*m.origin ());
62 immutable_property_alist_ = SCM_EOL;
63 mutable_property_alist_ = SCM_EOL;
68 Music::get_property_alist (bool m) const
70 return (m) ? mutable_property_alist_ : immutable_property_alist_;
74 Music::mark_smob (SCM m)
76 Music * mus = (Music *)SCM_CELL_WORD_1 (m);
77 scm_gc_mark (mus->immutable_property_alist_);
78 scm_gc_mark (mus->mutable_property_alist_);
83 Music::get_length () const
85 SCM l = get_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_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; gh_pair_p (s); 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);
132 SCM nm = m->get_property ("name");
133 if (gh_symbol_p (nm) || gh_string_p (nm))
139 scm_puts (classname (m),p);
143 Printing properties takes a lot of time, especially during backtraces.
144 For inspecting, it is better to explicitly use an inspection
153 Music::to_relative_octave (Pitch p)
155 SCM elt = get_property ("element");
157 if (Music* m = unsmob_music (elt))
158 p = m->to_relative_octave (p);
160 p = music_list_to_relative (get_property ("elements"),
166 Music::compress (Moment factor)
168 SCM elt = get_property ("element");
170 if (Music* m = unsmob_music (elt))
171 m->compress (factor);
173 compress_music_list (get_property ("elements"), factor);
178 Music::transpose (Pitch delta)
180 SCM elt = get_property ("element");
182 if (Music* m = unsmob_music (elt))
183 m->transpose (delta);
185 transpose_music_list (get_property ("elements"), delta);
189 IMPLEMENT_TYPE_P (Music, "ly:music?");
191 IMPLEMENT_SMOBS (Music);
192 IMPLEMENT_DEFAULT_EQUAL_P (Music);
194 /****************************/
197 Music::internal_get_property (SCM sym) const
199 SCM s = scm_sloppy_assq (sym, mutable_property_alist_);
203 s = scm_sloppy_assq (sym, immutable_property_alist_);
204 return (s == SCM_BOOL_F) ? SCM_EOL : ly_cdr (s);
208 Music::internal_set_property (SCM s, SCM v)
210 if (internal_type_checking_global_b)
211 if (!type_check_assignment (s, v, ly_symbol2scm ("music-type?")))
214 mutable_property_alist_ = scm_assq_set_x (mutable_property_alist_, s, v);
220 Music::set_spot (Input ip)
222 set_property ("origin", make_input (ip));
226 Music::origin () const
228 Input *ip = unsmob_input (get_property ("origin"));
229 return ip ? ip : & dummy_input_global;
238 LY_DEFINE(ly_music_length,
239 "ly:music-length", 1, 0, 0, (SCM mus),
240 "Get the length (in musical time) of music expression @var{mus}.")
242 Music * sc = unsmob_music (mus);
243 SCM_ASSERT_TYPE(sc, mus, SCM_ARG1, __FUNCTION__, "music");
244 return sc->get_length().smobbed_copy();
247 LY_DEFINE(ly_music_property,
248 "ly:music-property", 2, 0, 0, (SCM mus, SCM sym),
249 "Get the property @var{sym} of music expression @var{mus}.\n"
250 "If @var{sym} is undefined, return @code{'()}.\n" )
252 Music * sc = unsmob_music (mus);
253 SCM_ASSERT_TYPE(sc, mus, SCM_ARG1, __FUNCTION__, "music");
254 SCM_ASSERT_TYPE(gh_symbol_p (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
256 return sc->internal_get_property (sym);
259 LY_DEFINE(ly_music_set_property,
260 "ly:music-set-property!", 3, 0, 0,
261 (SCM mus, SCM sym, SCM val),
262 "Set property @var{sym} in music expression @var{mus} to @var{val}.")
264 Music * sc = unsmob_music (mus);
265 SCM_ASSERT_TYPE(sc, mus, SCM_ARG1, __FUNCTION__, "music");
266 SCM_ASSERT_TYPE(gh_symbol_p (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
268 bool ok = type_check_assignment (sym, val, ly_symbol2scm ("music-type?"));
271 sc->internal_set_property (sym, val);
274 return SCM_UNSPECIFIED;
278 LY_DEFINE(ly_music_name, "ly:music-name", 1, 0, 0,
280 "Return the name of @var{music}.")
282 Music * m = unsmob_music (mus);
283 SCM_ASSERT_TYPE(m, mus, SCM_ARG1, __FUNCTION__ ,"music");
285 const char * nm = classname (m);
286 return scm_makfrom0str (nm);
291 // to do property args
292 LY_DEFINE(ly_extended_make_music,
293 "ly:make-bare-music", 2, 0, 0, (SCM type, SCM props),
294 "Make a C++ music object of type @var{type}, initialize with\n"
297 "This function is for internal use, and is only called by "
298 "@code{make-music}, which is the preferred interface "
299 "for creating music objects. "
302 SCM_ASSERT_TYPE(gh_string_p (type), type, SCM_ARG1, __FUNCTION__, "string");
304 SCM s = make_music (ly_scm2string (type))->self_scm ();
305 unsmob_music (s)->immutable_property_alist_ = props;
306 scm_gc_unprotect_object (s);
310 // to do property args
311 LY_DEFINE(ly_get_mutable_properties,
312 "ly:get-mutable-properties", 1, 0, 0, (SCM mus),
313 "Return an alist containing the mutable properties of @var{mus}.\n"
314 "The immutable properties are not available; they should be initialized\n"
315 "by the @code{make-music} function.\n"
318 Music *m = unsmob_music (mus);
319 SCM_ASSERT_TYPE(m, mus, SCM_ARG1, __FUNCTION__, "music");
321 return m->get_property_alist (true);
324 LY_DEFINE(ly_music_list_p,"ly:music-list?", 1, 0, 0,
325 (SCM l),"Type predicate: return true if @var{l} is a list of music objects.")
327 if (scm_list_p (l) != SCM_BOOL_T)
330 while (gh_pair_p (l))
332 if (!unsmob_music (gh_car (l)))
342 LY_DEFINE(ly_deep_mus_copy,
343 "ly:music-deep-copy", 1,0,0, (SCM m),
344 "Copy @var{m} and all sub expressions of @var{m}")
346 if (unsmob_music (m))
348 SCM ss = unsmob_music (m)->clone ()->self_scm ();
349 scm_gc_unprotect_object (ss);
352 else if (gh_pair_p (m))
354 return gh_cons (ly_deep_mus_copy (ly_car (m)), ly_deep_mus_copy (ly_cdr (m)));
360 LY_DEFINE(ly_music_transpose,
361 "ly:music-transpose", 2,0,0, (SCM m, SCM p),
362 "Transpose @var{m} such that central C is mapped to @var{p}. "
365 Music * sc = unsmob_music (m);
366 Pitch * sp = unsmob_pitch (p);
367 SCM_ASSERT_TYPE(sc, m, SCM_ARG1, __FUNCTION__, "music");
368 SCM_ASSERT_TYPE(sp, p, SCM_ARG2, __FUNCTION__, "pitch");
371 return sc->self_scm(); // SCM_UNDEFINED ?
379 make_music_by_name (SCM sym)
381 if (!make_music_proc)
382 make_music_proc = scm_primitive_eval (ly_symbol2scm ("make-music"));
384 SCM rv = scm_call_1 (make_music_proc, sym);
389 scm_gc_protect_object (rv);
390 return unsmob_music (rv);