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)));
37 immutable_property_alist_ = SCM_EOL;
38 mutable_property_alist_ = SCM_EOL;
42 Music::Music (Music const &m)
44 immutable_property_alist_ = m.immutable_property_alist_;
45 mutable_property_alist_ = SCM_EOL;
48 First we smobify_self, then we copy over the stuff. If we don't,
49 stack vars that hold the copy might be optimized away, meaning
50 that they won't be protected from GC.
53 mutable_property_alist_ = ly_deep_mus_copy (m.mutable_property_alist_);
54 set_spot (*m.origin ());
60 immutable_property_alist_ = l;
61 mutable_property_alist_ = SCM_EOL;
67 Music::mark_smob (SCM m)
69 Music * mus = (Music *)SCM_CELL_WORD_1 (m);
70 scm_gc_mark (mus->immutable_property_alist_);
71 scm_gc_mark (mus->mutable_property_alist_);
76 Music::compress (Moment)
83 Music::length_mom () const
85 SCM l = get_mus_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_mus_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; s != SCM_EOL; 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);
131 scm_puts (classname (m),p);
133 print_alist (m->mutable_property_alist_, p);
134 print_alist (m->immutable_property_alist_, p);
141 Music::to_relative_octave (Pitch m)
148 Music::transpose (Pitch delta)
150 Pitch *p = unsmob_pitch (get_mus_property ("pitch"));
155 np.transpose (delta);
157 if (abs (np.alteration_) > 2)
159 warning (_f ("Transposition by %s makes accidental larger than two",
163 set_mus_property ("pitch", np.smobbed_copy ());
166 IMPLEMENT_TYPE_P (Music, "music?");
168 IMPLEMENT_SMOBS (Music);
169 IMPLEMENT_DEFAULT_EQUAL_P (Music);
171 /****************************/
174 Music::internal_get_mus_property (SCM sym) const
176 SCM s = scm_sloppy_assq (sym, mutable_property_alist_);
180 s = scm_sloppy_assq (sym, immutable_property_alist_);
181 return (s == SCM_BOOL_F) ? SCM_EOL : ly_cdr (s);
185 Music::internal_set_mus_property (SCM s, SCM v)
188 if (internal_type_checking_global_b)
189 assert (type_check_assignment (s, v, ly_symbol2scm ("music-type?")));
192 mutable_property_alist_ = scm_assq_set_x (mutable_property_alist_, s, v);
200 Music::set_spot (Input ip)
202 set_mus_property ("origin", make_input (ip));
206 Music::origin () const
208 Input *ip = unsmob_input (get_mus_property ("origin"));
209 return ip ? ip : & dummy_input_global;
218 LY_DEFINE(ly_get_mus_property,
219 "ly-get-mus-property", 2, 0, 0, (SCM mus, SCM sym),
220 "Get the property @var{sym} of music expression @var{mus}.")
222 Music * sc = unsmob_music (mus);
223 SCM_ASSERT_TYPE(sc, mus, SCM_ARG1, __FUNCTION__, "music");
224 SCM_ASSERT_TYPE(gh_symbol_p (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
226 return sc->internal_get_mus_property (sym);
229 LY_DEFINE(ly_set_mus_property,
230 "ly-set-mus-property!", 3, 0, 0,
231 (SCM mus, SCM sym, SCM val),
232 "Set property @var{sym} in music expression @var{mus} to @var{val}.")
234 Music * sc = unsmob_music (mus);
235 SCM_ASSERT_TYPE(sc, mus, SCM_ARG1, __FUNCTION__, "grob");
236 SCM_ASSERT_TYPE(gh_symbol_p (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
238 bool ok = type_check_assignment (sym, val, ly_symbol2scm ("music-type?"));
241 sc->internal_set_mus_property (sym, val);
244 return SCM_UNSPECIFIED;
248 // to do property args
249 LY_DEFINE(ly_make_music,
250 "ly-make-music", 1, 0, 0, (SCM type),
252 Make a music object/expression of type @var{name}. Warning: this
253 interface will likely change in the near future.
257 Music is the data type that music expressions are stored in. The data
258 type does not yet offer many manipulations.
261 SCM_ASSERT_TYPE(gh_string_p (type), type, SCM_ARG1, __FUNCTION__, "string");
263 SCM s = make_music (ly_scm2string (type))->self_scm ();
264 scm_gc_unprotect_object (s);
269 LY_DEFINE(ly_music_name, "ly-music-name", 1, 0, 0,
271 "Return the name of @var{music}.")
273 Music * m = unsmob_music (mus);
274 SCM_ASSERT_TYPE(m, mus, SCM_ARG1, __FUNCTION__ ,"music");
276 const char * nm = classname (m);
277 return ly_str02scm (nm);
280 LY_DEFINE(ly_music_list_p,"music-list?", 1, 0, 0,
281 (SCM l),"Type predicate: return true if @var{l} is a list of music objects.")
283 if (scm_list_p (l) != SCM_BOOL_T)
286 while (gh_pair_p (l))
288 if (!unsmob_music (gh_car (l)))