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_mus_property ("types");
25 return scm_memq (k, ifs) != SCM_BOOL_F;
31 SCM nm = get_mus_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_mus_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_mus_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_mus_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_mus_property ("element");
158 if (Music* m = unsmob_music (elt))
159 p = m->to_relative_octave (p);
161 p = music_list_to_relative (get_mus_property ("elements"),
167 Music::compress (Moment factor)
169 SCM elt = get_mus_property ("element");
171 if (Music* m = unsmob_music (elt))
172 m->compress (factor);
174 compress_music_list (get_mus_property ("elements"), factor);
179 Music::transpose (Pitch delta)
181 SCM elt = get_mus_property ("element");
183 if (Music* m = unsmob_music (elt))
184 m->transpose (delta);
186 transpose_music_list (get_mus_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_mus_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_mus_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_mus_property ("origin", make_input (ip));
227 Music::origin () const
229 Input *ip = unsmob_input (get_mus_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_mus_property,
249 "ly:get-mus-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_mus_property (sym);
260 LY_DEFINE(ly_set_mus_property,
261 "ly:set-mus-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_mus_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 music object/expression of type @var{type}, init with\n"
296 "@var{props}. Warning: this interface will likely change in the near\n"
299 "Music is the data type that music expressions are stored in. The data\n"
300 "type does not yet offer many manipulations.\n"
302 "WARNING: only for internal use. Please use make-music-by-name. \n"
305 SCM_ASSERT_TYPE(gh_string_p (type), type, SCM_ARG1, __FUNCTION__, "string");
307 SCM s = make_music (ly_scm2string (type))->self_scm ();
308 unsmob_music (s)->immutable_property_alist_ = props;
309 scm_gc_unprotect_object (s);
313 // to do property args
314 LY_DEFINE(ly_get_mutable_properties,
315 "ly:get-mutable-properties", 1, 0, 0, (SCM mus),
316 "Return an alist signifying the mutable properties of @var{mus}.\n"
317 "The immutable properties are not available; they should be initialized\n"
318 "by the functions make-music-by-name function.\n"
321 Music *m = unsmob_music (mus);
322 SCM_ASSERT_TYPE(m, mus, SCM_ARG1, __FUNCTION__, "music");
324 return m->get_property_alist (true);
327 LY_DEFINE(ly_music_list_p,"music-list?", 1, 0, 0,
328 (SCM l),"Type predicate: return true if @var{l} is a list of music objects.")
330 if (scm_list_p (l) != SCM_BOOL_T)
333 while (gh_pair_p (l))
335 if (!unsmob_music (gh_car (l)))
345 LY_DEFINE(ly_deep_mus_copy,
346 "ly:music-deep-copy", 1,0,0, (SCM m),
347 "Copy @var{m} and all sub expressions of @var{m}")
349 if (unsmob_music (m))
351 SCM ss = unsmob_music (m)->clone ()->self_scm ();
352 scm_gc_unprotect_object (ss);
355 else if (gh_pair_p (m))
357 return gh_cons (ly_deep_mus_copy (ly_car (m)), ly_deep_mus_copy (ly_cdr (m)));
363 LY_DEFINE(ly_music_transpose,
364 "ly:music-transpose", 2,0,0, (SCM m, SCM p),
365 "Transpose @var{m} such that central C is mapped to @var{p}. "
368 Music * sc = unsmob_music (m);
369 Pitch * sp = unsmob_pitch (p);
370 SCM_ASSERT_TYPE(sc, m, SCM_ARG1, __FUNCTION__, "music");
371 SCM_ASSERT_TYPE(sp, p, SCM_ARG2, __FUNCTION__, "pitch");
374 return sc->self_scm(); // SCM_UNDEFINED ?
382 make_music_by_name (SCM sym)
384 if (!make_music_proc)
385 make_music_proc = scm_primitive_eval (ly_symbol2scm ("make-music-by-name"));
387 SCM rv = scm_call_1 (make_music_proc, sym);
392 scm_gc_protect_object (rv);
393 return unsmob_music (rv);