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)));
40 Music::internal_is_music_type (SCM k)const
42 SCM ifs = get_mus_property ("types");
44 return scm_memq (k, ifs) != SCM_BOOL_F;
47 Music::Music (Music const &m)
49 immutable_property_alist_ = m.immutable_property_alist_;
50 mutable_property_alist_ = SCM_EOL;
54 First we smobify_self, then we copy over the stuff. If we don't,
55 stack vars that hold the copy might be optimized away, meaning
56 that they won't be protected from GC.
59 mutable_property_alist_ = ly_deep_mus_copy (m.mutable_property_alist_);
60 set_spot (*m.origin ());
66 immutable_property_alist_ = SCM_EOL;
67 mutable_property_alist_ = SCM_EOL;
72 Music::get_property_alist (bool m) const
74 return (m) ? mutable_property_alist_ : immutable_property_alist_;
78 Music::mark_smob (SCM m)
80 Music * mus = (Music *)SCM_CELL_WORD_1 (m);
81 scm_gc_mark (mus->immutable_property_alist_);
82 scm_gc_mark (mus->mutable_property_alist_);
87 Music::compress (Moment f)
89 SCM l = get_mus_property ("compress-procedure");
90 if (gh_procedure_p (l))
92 SCM res = gh_call2 (l, self_scm (), f.smobbed_copy());
98 Music::length_mom () const
100 SCM l = get_mus_property ("length");
101 if (unsmob_moment (l))
102 return *unsmob_moment (l);
103 else if (gh_procedure_p (l))
105 SCM res = gh_call1 (l, self_scm ());
106 return *unsmob_moment (res);
113 Music::start_mom () const
115 SCM l = get_mus_property ("start-moment-function");
116 if (gh_procedure_p (l))
118 SCM res = gh_call1 (l, self_scm ());
119 return *unsmob_moment (res);
127 print_alist (SCM a, SCM port)
130 SCM_EOL -> catch malformed lists.
132 for (SCM s = a; gh_pair_p (s); s = ly_cdr (s))
134 scm_display (ly_caar (s), port);
135 scm_puts (" = ", port);
136 scm_write (ly_cdar (s), port);
137 scm_puts ("\n", port);
142 Music::print_smob (SCM s, SCM p, scm_print_state*)
144 scm_puts ("#<Music ", p);
145 Music* m = unsmob_music (s);
146 scm_puts (classname (m),p);
148 print_alist (m->mutable_property_alist_, p);
149 print_alist (m->immutable_property_alist_, p);
156 Music::to_relative_octave (Pitch m)
163 Music::transpose (Pitch delta)
165 Pitch *p = unsmob_pitch (get_mus_property ("pitch"));
170 np.transpose (delta);
172 if (abs (np.alteration_) > 2)
174 warning (_f ("Transposition by %s makes accidental larger than two",
178 set_mus_property ("pitch", np.smobbed_copy ());
181 IMPLEMENT_TYPE_P (Music, "music?");
183 IMPLEMENT_SMOBS (Music);
184 IMPLEMENT_DEFAULT_EQUAL_P (Music);
186 /****************************/
189 Music::internal_get_mus_property (SCM sym) const
191 SCM s = scm_sloppy_assq (sym, mutable_property_alist_);
195 s = scm_sloppy_assq (sym, immutable_property_alist_);
196 return (s == SCM_BOOL_F) ? SCM_EOL : ly_cdr (s);
200 Music::internal_set_mus_property (SCM s, SCM v)
202 if (internal_type_checking_global_b)
203 if (!type_check_assignment (s, v, ly_symbol2scm ("music-type?")))
206 mutable_property_alist_ = scm_assq_set_x (mutable_property_alist_, s, v);
214 Music::set_spot (Input ip)
216 set_mus_property ("origin", make_input (ip));
220 Music::origin () const
222 Input *ip = unsmob_input (get_mus_property ("origin"));
223 return ip ? ip : & dummy_input_global;
232 LY_DEFINE(ly_get_mus_property,
233 "ly-get-mus-property", 2, 0, 0, (SCM mus, SCM sym),
234 "Get the property @var{sym} of music expression @var{mus}.")
236 Music * sc = unsmob_music (mus);
237 SCM_ASSERT_TYPE(sc, mus, SCM_ARG1, __FUNCTION__, "music");
238 SCM_ASSERT_TYPE(gh_symbol_p (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
240 return sc->internal_get_mus_property (sym);
243 LY_DEFINE(ly_set_mus_property,
244 "ly-set-mus-property!", 3, 0, 0,
245 (SCM mus, SCM sym, SCM val),
246 "Set property @var{sym} in music expression @var{mus} to @var{val}.")
248 Music * sc = unsmob_music (mus);
249 SCM_ASSERT_TYPE(sc, mus, SCM_ARG1, __FUNCTION__, "music");
250 SCM_ASSERT_TYPE(gh_symbol_p (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
252 bool ok = type_check_assignment (sym, val, ly_symbol2scm ("music-type?"));
255 sc->internal_set_mus_property (sym, val);
258 return SCM_UNSPECIFIED;
262 LY_DEFINE(ly_music_name, "ly-music-name", 1, 0, 0,
264 "Return the name of @var{music}.")
266 Music * m = unsmob_music (mus);
267 SCM_ASSERT_TYPE(m, mus, SCM_ARG1, __FUNCTION__ ,"music");
269 const char * nm = classname (m);
270 return scm_makfrom0str (nm);
275 // to do property args
276 LY_DEFINE(ly_extended_make_music,
277 "ly-make-bare-music", 2, 0, 0, (SCM type, SCM props),
279 Make a music object/expression of type @var{type}, init with
280 @var{props}. Warning: this interface will likely change in the near
283 Music is the data type that music expressions are stored in. The data
284 type does not yet offer many manipulations.
286 WARNING: deprecated; use make-music-by-name.
289 SCM_ASSERT_TYPE(gh_string_p (type), type, SCM_ARG1, __FUNCTION__, "string");
291 SCM s = make_music (ly_scm2string (type))->self_scm ();
292 unsmob_music (s)->immutable_property_alist_ = props;
293 scm_gc_unprotect_object (s);
297 LY_DEFINE(ly_music_list_p,"music-list?", 1, 0, 0,
298 (SCM l),"Type predicate: return true if @var{l} is a list of music objects.")
300 if (scm_list_p (l) != SCM_BOOL_T)
303 while (gh_pair_p (l))
305 if (!unsmob_music (gh_car (l)))
318 make_music_by_name (SCM sym)
320 if (!make_music_proc)
321 make_music_proc = scm_primitive_eval (ly_symbol2scm ("make-music-by-name"));
323 SCM rv = scm_call_1 (make_music_proc, sym);
328 scm_gc_protect_object (rv);
329 return unsmob_music (rv);