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)));
35 Music::internal_is_music_type (SCM k)const
37 SCM ifs = get_mus_property ("types");
39 return scm_memq (k, ifs) != SCM_BOOL_F;
45 SCM nm = get_mus_property ("name");
48 return ly_symbol2string (nm);
52 return classname (this);
57 Music::transpose (Pitch)
62 Music::compress (Moment)
67 Music::Music (Music const &m)
69 immutable_property_alist_ = m.immutable_property_alist_;
70 mutable_property_alist_ = SCM_EOL;
74 First we smobify_self, then we copy over the stuff. If we don't,
75 stack vars that hold the copy might be optimized away, meaning
76 that they won't be protected from GC.
79 mutable_property_alist_ = ly_deep_mus_copy (m.mutable_property_alist_);
80 set_spot (*m.origin ());
86 immutable_property_alist_ = SCM_EOL;
87 mutable_property_alist_ = SCM_EOL;
92 Music::get_property_alist (bool m) const
94 return (m) ? mutable_property_alist_ : immutable_property_alist_;
98 Music::mark_smob (SCM m)
100 Music * mus = (Music *)SCM_CELL_WORD_1 (m);
101 scm_gc_mark (mus->immutable_property_alist_);
102 scm_gc_mark (mus->mutable_property_alist_);
107 Music::get_length () const
109 SCM l = get_mus_property ("length");
110 if (unsmob_moment (l))
111 return *unsmob_moment (l);
112 else if (gh_procedure_p (l))
114 SCM res = gh_call1 (l, self_scm ());
115 return *unsmob_moment (res);
122 Music::start_mom () const
124 SCM l = get_mus_property ("start-moment-function");
125 if (gh_procedure_p (l))
127 SCM res = gh_call1 (l, self_scm ());
128 return *unsmob_moment (res);
136 print_alist (SCM a, SCM port)
139 SCM_EOL -> catch malformed lists.
141 for (SCM s = a; gh_pair_p (s); s = ly_cdr (s))
143 scm_display (ly_caar (s), port);
144 scm_puts (" = ", port);
145 scm_write (ly_cdar (s), port);
146 scm_puts ("\n", port);
151 Music::print_smob (SCM s, SCM p, scm_print_state*)
153 scm_puts ("#<Music ", p);
154 Music* m = unsmob_music (s);
155 scm_puts (classname (m),p);
157 print_alist (m->mutable_property_alist_, p);
158 print_alist (m->immutable_property_alist_, p);
165 Music::to_relative_octave (Pitch m)
171 IMPLEMENT_TYPE_P (Music, "ly:music?");
173 IMPLEMENT_SMOBS (Music);
174 IMPLEMENT_DEFAULT_EQUAL_P (Music);
176 /****************************/
179 Music::internal_get_mus_property (SCM sym) const
181 SCM s = scm_sloppy_assq (sym, mutable_property_alist_);
185 s = scm_sloppy_assq (sym, immutable_property_alist_);
186 return (s == SCM_BOOL_F) ? SCM_EOL : ly_cdr (s);
190 Music::internal_set_mus_property (SCM s, SCM v)
192 if (internal_type_checking_global_b)
193 if (!type_check_assignment (s, v, ly_symbol2scm ("music-type?")))
196 mutable_property_alist_ = scm_assq_set_x (mutable_property_alist_, s, v);
204 Music::set_spot (Input ip)
206 set_mus_property ("origin", make_input (ip));
210 Music::origin () const
212 Input *ip = unsmob_input (get_mus_property ("origin"));
213 return ip ? ip : & dummy_input_global;
222 LY_DEFINE(ly_get_mus_property,
223 "ly:get-mus-property", 2, 0, 0, (SCM mus, SCM sym),
224 "Get the property @var{sym} of music expression @var{mus}.")
226 Music * sc = unsmob_music (mus);
227 SCM_ASSERT_TYPE(sc, mus, SCM_ARG1, __FUNCTION__, "music");
228 SCM_ASSERT_TYPE(gh_symbol_p (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
230 return sc->internal_get_mus_property (sym);
233 LY_DEFINE(ly_set_mus_property,
234 "ly:set-mus-property!", 3, 0, 0,
235 (SCM mus, SCM sym, SCM val),
236 "Set property @var{sym} in music expression @var{mus} to @var{val}.")
238 Music * sc = unsmob_music (mus);
239 SCM_ASSERT_TYPE(sc, mus, SCM_ARG1, __FUNCTION__, "music");
240 SCM_ASSERT_TYPE(gh_symbol_p (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
242 bool ok = type_check_assignment (sym, val, ly_symbol2scm ("music-type?"));
245 sc->internal_set_mus_property (sym, val);
248 return SCM_UNSPECIFIED;
252 LY_DEFINE(ly_music_name, "ly:music-name", 1, 0, 0,
254 "Return the name of @var{music}.")
256 Music * m = unsmob_music (mus);
257 SCM_ASSERT_TYPE(m, mus, SCM_ARG1, __FUNCTION__ ,"music");
259 const char * nm = classname (m);
260 return scm_makfrom0str (nm);
265 // to do property args
266 LY_DEFINE(ly_extended_make_music,
267 "ly:make-bare-music", 2, 0, 0, (SCM type, SCM props),
268 "Make a music object/expression of type @var{type}, init with\n"
269 "@var{props}. Warning: this interface will likely change in the near\n"
272 "Music is the data type that music expressions are stored in. The data\n"
273 "type does not yet offer many manipulations.\n"
275 "WARNING: only for internal use. Please use make-music-by-name. \n"
278 SCM_ASSERT_TYPE(gh_string_p (type), type, SCM_ARG1, __FUNCTION__, "string");
280 SCM s = make_music (ly_scm2string (type))->self_scm ();
281 unsmob_music (s)->immutable_property_alist_ = props;
282 scm_gc_unprotect_object (s);
286 // to do property args
287 LY_DEFINE(ly_get_mutable_properties,
288 "ly:get-mutable-properties", 1, 0, 0, (SCM mus),
289 "Return an alist signifying the mutable properties of @var{mus}.\n"
290 "The immutable properties are not available; they should be initialized\n"
291 "by the functions make-music-by-name function.\n"
294 Music *m = unsmob_music (mus);
295 SCM_ASSERT_TYPE(m, mus, SCM_ARG1, __FUNCTION__, "music");
297 return m->get_property_alist (true);
300 LY_DEFINE(ly_music_list_p,"music-list?", 1, 0, 0,
301 (SCM l),"Type predicate: return true if @var{l} is a list of music objects.")
303 if (scm_list_p (l) != SCM_BOOL_T)
306 while (gh_pair_p (l))
308 if (!unsmob_music (gh_car (l)))
321 make_music_by_name (SCM sym)
323 if (!make_music_proc)
324 make_music_proc = scm_primitive_eval (ly_symbol2scm ("make-music-by-name"));
326 SCM rv = scm_call_1 (make_music_proc, sym);
331 scm_gc_protect_object (rv);
332 return unsmob_music (rv);