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"
18 SCM ly_deep_mus_copy (SCM);
21 Music::internal_is_music_type (SCM k)const
23 SCM ifs = get_property ("types");
25 return scm_memq (k, ifs) != SCM_BOOL_F;
31 SCM nm = get_property ("name");
34 return ly_symbol2string (nm);
38 return classname (this);
44 Music::Music (Music const &m)
46 immutable_property_alist_ = m.immutable_property_alist_;
47 mutable_property_alist_ = SCM_EOL;
51 First we smobify_self, then we copy over the stuff. If we don't,
52 stack vars that hold the copy might be optimized away, meaning
53 that they won't be protected from GC.
56 mutable_property_alist_ = ly_deep_mus_copy (m.mutable_property_alist_);
57 set_spot (*m.origin ());
63 immutable_property_alist_ = SCM_EOL;
64 mutable_property_alist_ = SCM_EOL;
69 Music::get_property_alist (bool m) const
71 return (m) ? mutable_property_alist_ : immutable_property_alist_;
75 Music::mark_smob (SCM m)
77 Music * mus = (Music *)SCM_CELL_WORD_1 (m);
78 scm_gc_mark (mus->immutable_property_alist_);
79 scm_gc_mark (mus->mutable_property_alist_);
84 Music::get_length () const
86 SCM l = get_property ("length");
87 if (unsmob_moment (l))
88 return *unsmob_moment (l);
89 else if (gh_procedure_p (l))
91 SCM res = gh_call1 (l, self_scm ());
92 return *unsmob_moment (res);
99 Music::start_mom () const
101 SCM l = get_property ("start-moment-function");
102 if (gh_procedure_p (l))
104 SCM res = gh_call1 (l, self_scm ());
105 return *unsmob_moment (res);
113 print_alist (SCM a, SCM port)
116 SCM_EOL -> catch malformed lists.
118 for (SCM s = a; gh_pair_p (s); s = ly_cdr (s))
120 scm_display (ly_caar (s), port);
121 scm_puts (" = ", port);
122 scm_write (ly_cdar (s), port);
123 scm_puts ("\n", port);
128 Music::print_smob (SCM s, SCM p, scm_print_state*)
130 scm_puts ("#<Music ", p);
131 Music* m = unsmob_music (s);
133 SCM nm = m->get_property ("name");
134 if (gh_symbol_p (nm) || gh_string_p (nm))
140 scm_puts (classname (m),p);
144 Printing properties takes a lot of time, especially during backtraces.
145 For inspecting, it is better to explicitly use an inspection
154 Music::to_relative_octave (Pitch p)
156 SCM elt = get_property ("element");
158 if (Music* m = unsmob_music (elt))
159 p = m->to_relative_octave (p);
161 p = music_list_to_relative (get_property ("elements"),
167 Music::compress (Moment factor)
169 SCM elt = get_property ("element");
171 if (Music* m = unsmob_music (elt))
172 m->compress (factor);
174 compress_music_list (get_property ("elements"), factor);
179 Music::transpose (Pitch delta)
181 SCM elt = get_property ("element");
183 if (Music* m = unsmob_music (elt))
184 m->transpose (delta);
186 transpose_music_list (get_property ("elements"), delta);
190 IMPLEMENT_TYPE_P (Music, "ly:music?");
192 IMPLEMENT_SMOBS (Music);
193 IMPLEMENT_DEFAULT_EQUAL_P (Music);
195 /****************************/
198 Music::internal_get_property (SCM sym) const
200 SCM s = scm_sloppy_assq (sym, mutable_property_alist_);
204 s = scm_sloppy_assq (sym, immutable_property_alist_);
205 return (s == SCM_BOOL_F) ? SCM_EOL : ly_cdr (s);
209 Music::internal_set_property (SCM s, SCM v)
211 if (internal_type_checking_global_b)
212 if (!type_check_assignment (s, v, ly_symbol2scm ("music-type?")))
215 mutable_property_alist_ = scm_assq_set_x (mutable_property_alist_, s, v);
221 Music::set_spot (Input ip)
223 set_property ("origin", make_input (ip));
227 Music::origin () const
229 Input *ip = unsmob_input (get_property ("origin"));
230 return ip ? ip : & dummy_input_global;
239 LY_DEFINE(ly_music_length,
240 "ly:music-length", 1, 0, 0, (SCM mus),
241 "Get the length (in musical time) of music expression @var{mus}.")
243 Music * sc = unsmob_music (mus);
244 SCM_ASSERT_TYPE(sc, mus, SCM_ARG1, __FUNCTION__, "music");
245 return sc->get_length().smobbed_copy();
248 LY_DEFINE(ly_get_property,
249 "ly:music-property", 2, 0, 0, (SCM mus, SCM sym),
250 "Get the property @var{sym} of music expression @var{mus}.\n"
251 "If @var{sym} is undefined, return @code{'()}.\n" )
253 Music * sc = unsmob_music (mus);
254 SCM_ASSERT_TYPE(sc, mus, SCM_ARG1, __FUNCTION__, "music");
255 SCM_ASSERT_TYPE(gh_symbol_p (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
257 return sc->internal_get_property (sym);
260 LY_DEFINE(ly_set_property,
261 "ly:music-set-property!", 3, 0, 0,
262 (SCM mus, SCM sym, SCM val),
263 "Set property @var{sym} in music expression @var{mus} to @var{val}.")
265 Music * sc = unsmob_music (mus);
266 SCM_ASSERT_TYPE(sc, mus, SCM_ARG1, __FUNCTION__, "music");
267 SCM_ASSERT_TYPE(gh_symbol_p (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
269 bool ok = type_check_assignment (sym, val, ly_symbol2scm ("music-type?"));
272 sc->internal_set_property (sym, val);
275 return SCM_UNSPECIFIED;
279 LY_DEFINE(ly_music_name, "ly:music-name", 1, 0, 0,
281 "Return the name of @var{music}.")
283 Music * m = unsmob_music (mus);
284 SCM_ASSERT_TYPE(m, mus, SCM_ARG1, __FUNCTION__ ,"music");
286 const char * nm = classname (m);
287 return scm_makfrom0str (nm);
292 // to do property args
293 LY_DEFINE(ly_extended_make_music,
294 "ly:make-bare-music", 2, 0, 0, (SCM type, SCM props),
295 "Make a C++ music object of type @var{type}, initialize with\n"
298 "This function is for internal use, and is only called by "
299 "@code{make-music-by-name}, which is the preferred interface "
300 "for creating music objects. "
303 SCM_ASSERT_TYPE(gh_string_p (type), type, SCM_ARG1, __FUNCTION__, "string");
305 SCM s = make_music (ly_scm2string (type))->self_scm ();
306 unsmob_music (s)->immutable_property_alist_ = props;
307 scm_gc_unprotect_object (s);
311 // to do property args
312 LY_DEFINE(ly_get_mutable_properties,
313 "ly:get-mutable-properties", 1, 0, 0, (SCM mus),
314 "Return an alist containing the mutable properties of @var{mus}.\n"
315 "The immutable properties are not available; they should be initialized\n"
316 "by the @code{make-music-by-name} function.\n"
319 Music *m = unsmob_music (mus);
320 SCM_ASSERT_TYPE(m, mus, SCM_ARG1, __FUNCTION__, "music");
322 return m->get_property_alist (true);
325 LY_DEFINE(ly_music_list_p,"ly:music-list?", 1, 0, 0,
326 (SCM l),"Type predicate: return true if @var{l} is a list of music objects.")
328 if (scm_list_p (l) != SCM_BOOL_T)
331 while (gh_pair_p (l))
333 if (!unsmob_music (gh_car (l)))
343 LY_DEFINE(ly_deep_mus_copy,
344 "ly:music-deep-copy", 1,0,0, (SCM m),
345 "Copy @var{m} and all sub expressions of @var{m}")
347 if (unsmob_music (m))
349 SCM ss = unsmob_music (m)->clone ()->self_scm ();
350 scm_gc_unprotect_object (ss);
353 else if (gh_pair_p (m))
355 return gh_cons (ly_deep_mus_copy (ly_car (m)), ly_deep_mus_copy (ly_cdr (m)));
361 LY_DEFINE(ly_music_transpose,
362 "ly:music-transpose", 2,0,0, (SCM m, SCM p),
363 "Transpose @var{m} such that central C is mapped to @var{p}. "
366 Music * sc = unsmob_music (m);
367 Pitch * sp = unsmob_pitch (p);
368 SCM_ASSERT_TYPE(sc, m, SCM_ARG1, __FUNCTION__, "music");
369 SCM_ASSERT_TYPE(sp, p, SCM_ARG2, __FUNCTION__, "pitch");
372 return sc->self_scm(); // SCM_UNDEFINED ?
380 make_music_by_name (SCM sym)
382 if (!make_music_proc)
383 make_music_proc = scm_primitive_eval (ly_symbol2scm ("make-music-by-name"));
385 SCM rv = scm_call_1 (make_music_proc, sym);
390 scm_gc_protect_object (rv);
391 return unsmob_music (rv);