2 music.cc -- implement Music
4 source file of the GNU LilyPond music typesetter
6 (c) 1997--2003 Han-Wen Nienhuys <hanwen@cs.uu.nl>
10 #include "input-smob.hh"
12 #include "music-list.hh"
15 #include "ly-smobs.icc"
18 LY_DEFINE(ly_deep_mus_copy,
19 "ly:music-deep-copy", 1,0,0, (SCM m),
20 "Copy @var{m} and all sub expressions of @var{m}")
24 SCM ss = unsmob_music (m)->clone ()->self_scm ();
25 scm_gc_unprotect_object (ss);
28 else if (gh_pair_p (m))
30 return gh_cons (ly_deep_mus_copy (ly_car (m)), ly_deep_mus_copy (ly_cdr (m)));
37 Music::internal_is_music_type (SCM k)const
39 SCM ifs = get_mus_property ("types");
41 return scm_memq (k, ifs) != SCM_BOOL_F;
47 SCM nm = get_mus_property ("name");
50 return ly_symbol2string (nm);
54 return classname (this);
59 Music::transpose (Pitch)
64 Music::compress (Moment)
68 Music::Music (Music const &m)
70 immutable_property_alist_ = m.immutable_property_alist_;
71 mutable_property_alist_ = SCM_EOL;
75 First we smobify_self, then we copy over the stuff. If we don't,
76 stack vars that hold the copy might be optimized away, meaning
77 that they won't be protected from GC.
80 mutable_property_alist_ = ly_deep_mus_copy (m.mutable_property_alist_);
81 set_spot (*m.origin ());
87 immutable_property_alist_ = SCM_EOL;
88 mutable_property_alist_ = SCM_EOL;
93 Music::get_property_alist (bool m) const
95 return (m) ? mutable_property_alist_ : immutable_property_alist_;
99 Music::mark_smob (SCM m)
101 Music * mus = (Music *)SCM_CELL_WORD_1 (m);
102 scm_gc_mark (mus->immutable_property_alist_);
103 scm_gc_mark (mus->mutable_property_alist_);
108 Music::get_length () const
110 SCM l = get_mus_property ("length");
111 if (unsmob_moment (l))
112 return *unsmob_moment (l);
113 else if (gh_procedure_p (l))
115 SCM res = gh_call1 (l, self_scm ());
116 return *unsmob_moment (res);
123 Music::start_mom () const
125 SCM l = get_mus_property ("start-moment-function");
126 if (gh_procedure_p (l))
128 SCM res = gh_call1 (l, self_scm ());
129 return *unsmob_moment (res);
137 print_alist (SCM a, SCM port)
140 SCM_EOL -> catch malformed lists.
142 for (SCM s = a; gh_pair_p (s); s = ly_cdr (s))
144 scm_display (ly_caar (s), port);
145 scm_puts (" = ", port);
146 scm_write (ly_cdar (s), port);
147 scm_puts ("\n", port);
152 Music::print_smob (SCM s, SCM p, scm_print_state*)
154 scm_puts ("#<Music ", p);
155 Music* m = unsmob_music (s);
157 SCM nm = m->get_mus_property ("name");
158 if (gh_symbol_p (nm) || gh_string_p (nm))
164 scm_puts (classname (m),p);
168 Printing properties takes a lot of time, especially during backtraces.
169 For inspecting, it is better to explicitly use an inspection
178 Music::to_relative_octave (Pitch m)
184 IMPLEMENT_TYPE_P (Music, "ly:music?");
186 IMPLEMENT_SMOBS (Music);
187 IMPLEMENT_DEFAULT_EQUAL_P (Music);
189 /****************************/
192 Music::internal_get_mus_property (SCM sym) const
194 SCM s = scm_sloppy_assq (sym, mutable_property_alist_);
198 s = scm_sloppy_assq (sym, immutable_property_alist_);
199 return (s == SCM_BOOL_F) ? SCM_EOL : ly_cdr (s);
203 Music::internal_set_mus_property (SCM s, SCM v)
205 if (internal_type_checking_global_b)
206 if (!type_check_assignment (s, v, ly_symbol2scm ("music-type?")))
209 mutable_property_alist_ = scm_assq_set_x (mutable_property_alist_, s, v);
217 Music::set_spot (Input ip)
219 set_mus_property ("origin", make_input (ip));
223 Music::origin () const
225 Input *ip = unsmob_input (get_mus_property ("origin"));
226 return ip ? ip : & dummy_input_global;
235 LY_DEFINE(ly_get_music_length,
236 "ly:get-music-length", 1, 0, 0, (SCM mus),
237 "Get the length (in musical time) of music expression @var{mus}.")
239 Music * sc = unsmob_music (mus);
240 SCM_ASSERT_TYPE(sc, mus, SCM_ARG1, __FUNCTION__, "music");
241 return sc->get_length().smobbed_copy();
244 LY_DEFINE(ly_get_mus_property,
245 "ly:get-mus-property", 2, 0, 0, (SCM mus, SCM sym),
246 "Get the property @var{sym} of music expression @var{mus}.\n"
247 "If @var{sym} is undefined, return @code{'()}.\n"
250 Music * sc = unsmob_music (mus);
251 SCM_ASSERT_TYPE(sc, mus, SCM_ARG1, __FUNCTION__, "music");
252 SCM_ASSERT_TYPE(gh_symbol_p (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
254 return sc->internal_get_mus_property (sym);
257 LY_DEFINE(ly_set_mus_property,
258 "ly:set-mus-property!", 3, 0, 0,
259 (SCM mus, SCM sym, SCM val),
260 "Set property @var{sym} in music expression @var{mus} to @var{val}.")
262 Music * sc = unsmob_music (mus);
263 SCM_ASSERT_TYPE(sc, mus, SCM_ARG1, __FUNCTION__, "music");
264 SCM_ASSERT_TYPE(gh_symbol_p (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
266 bool ok = type_check_assignment (sym, val, ly_symbol2scm ("music-type?"));
269 sc->internal_set_mus_property (sym, val);
272 return SCM_UNSPECIFIED;
276 LY_DEFINE(ly_music_name, "ly:music-name", 1, 0, 0,
278 "Return the name of @var{music}.")
280 Music * m = unsmob_music (mus);
281 SCM_ASSERT_TYPE(m, mus, SCM_ARG1, __FUNCTION__ ,"music");
283 const char * nm = classname (m);
284 return scm_makfrom0str (nm);
289 // to do property args
290 LY_DEFINE(ly_extended_make_music,
291 "ly:make-bare-music", 2, 0, 0, (SCM type, SCM props),
292 "Make a music object/expression of type @var{type}, init with\n"
293 "@var{props}. Warning: this interface will likely change in the near\n"
296 "Music is the data type that music expressions are stored in. The data\n"
297 "type does not yet offer many manipulations.\n"
299 "WARNING: only for internal use. Please use make-music-by-name. \n"
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 signifying the mutable properties of @var{mus}.\n"
314 "The immutable properties are not available; they should be initialized\n"
315 "by the functions make-music-by-name 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,"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)))
345 make_music_by_name (SCM sym)
347 if (!make_music_proc)
348 make_music_proc = scm_primitive_eval (ly_symbol2scm ("make-music-by-name"));
350 SCM rv = scm_call_1 (make_music_proc, sym);
355 scm_gc_protect_object (rv);
356 return unsmob_music (rv);