2 music.cc -- implement Music
4 source file of the GNU LilyPond music typesetter
6 (c) 1997--2001 Han-Wen Nienhuys <hanwen@cs.uu.nl>
9 #include "input-smob.hh"
11 #include "music-list.hh"
14 #include "ly-smobs.icc"
17 ly_deep_mus_copy (SCM m)
21 SCM ss = unsmob_music (m)->clone ()->self_scm ();
22 scm_gc_unprotect_object (ss);
25 else if (gh_pair_p (m))
27 return gh_cons (ly_deep_mus_copy (ly_car (m)), ly_deep_mus_copy (ly_cdr (m)));
36 immutable_property_alist_ = SCM_EOL;
37 mutable_property_alist_ = SCM_EOL;
41 Music::Music (Music const &m)
43 immutable_property_alist_ = m.immutable_property_alist_;
44 SCM c =ly_deep_mus_copy (m.mutable_property_alist_);
45 mutable_property_alist_ = c;
49 set_spot (*m.origin ());
55 immutable_property_alist_ = l;
56 mutable_property_alist_ = SCM_EOL;
62 Music::mark_smob (SCM m)
64 Music * mus = (Music *)SCM_CELL_WORD_1 (m);
65 scm_gc_mark (mus->immutable_property_alist_);
66 scm_gc_mark (mus->mutable_property_alist_);
71 Music::compress (Moment)
78 Music::length_mom () const
80 SCM l = get_mus_property ("length");
81 if (unsmob_moment (l))
82 return *unsmob_moment (l);
83 else if (gh_procedure_p (l))
85 SCM res = gh_call1 (l, self_scm ());
86 return *unsmob_moment (res);
93 Music::start_mom () const
100 print_alist (SCM a, SCM port)
102 for (SCM s = a; gh_pair_p (s); s = ly_cdr (s))
104 scm_display (ly_caar (s), port);
105 scm_puts (" = ", port);
106 scm_write (ly_cdar (s), port);
107 scm_puts ("\n", port);
112 Music::print_smob (SCM s, SCM p, scm_print_state*)
114 scm_puts ("#<Music ", p);
115 Music* m = unsmob_music (s);
116 scm_puts (classname (m),p);
118 print_alist (m->mutable_property_alist_, p);
119 print_alist (m->immutable_property_alist_, p);
126 Music::to_relative_octave (Pitch m)
133 Music::transpose (Pitch delta)
135 Pitch *p = unsmob_pitch (get_mus_property ("pitch"));
140 np.transpose (delta);
142 if (abs (np.alteration_i_) > 2)
144 warning (_f ("Transposition by %s makes accidental larger than two",
148 set_mus_property ("pitch", np.smobbed_copy ());
151 IMPLEMENT_TYPE_P (Music, "music?");
153 IMPLEMENT_SMOBS (Music);
154 IMPLEMENT_DEFAULT_EQUAL_P (Music);
156 /****************************/
159 Music::internal_get_mus_property (SCM sym) const
161 SCM s = scm_sloppy_assq (sym, mutable_property_alist_);
165 s = scm_sloppy_assq (sym, immutable_property_alist_);
166 return (s == SCM_BOOL_F) ? SCM_EOL : ly_cdr (s);
171 Remove the value associated with KEY, and return it. The result is
172 that a next call will yield SCM_EOL (and not the underlying
176 Music::remove_mus_property (const char* key)
178 SCM val = get_mus_property (key);
180 set_mus_property (key, SCM_EOL);
185 Music::get_mus_property (const char *nm) const
187 SCM sym = ly_symbol2scm (nm);
188 return get_mus_property (sym);
192 Music::set_mus_property (const char* k, SCM v)
194 SCM s = ly_symbol2scm (k);
195 set_mus_property (s, v);
199 Music::set_immutable_mus_property (SCM s, SCM v)
201 immutable_property_alist_ = gh_cons (gh_cons (s,v), mutable_property_alist_);
202 mutable_property_alist_ = scm_assq_remove_x (mutable_property_alist_, s);
207 Music::internal_set_mus_property (SCM s, SCM v)
209 mutable_property_alist_ = scm_assq_set_x (mutable_property_alist_, s, v);
215 Music::set_spot (Input ip)
217 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;
239 ly_get_mus_property (SCM mus, SCM sym)
241 Music * sc = unsmob_music (mus);
245 return sc->internal_get_mus_property (sym);
249 warning (_ ("ly_get_mus_property (): Not a Music"));
250 scm_write (mus, scm_current_error_port ());
257 ly_set_mus_property (SCM mus, SCM sym, SCM val)
259 Music * sc = unsmob_music (mus);
261 if (!gh_symbol_p (sym))
263 warning (_ ("ly_set_mus_property (): Not a symbol"));
264 scm_write (mus, scm_current_error_port ());
266 return SCM_UNSPECIFIED;
271 sc->internal_set_mus_property (sym, val);
275 warning (_ ("ly_set_mus_property (): not of type Music"));
276 scm_write (mus, scm_current_error_port ());
279 return SCM_UNSPECIFIED;
283 // to do property args
285 ly_make_music (SCM type)
287 if (!gh_string_p (type))
289 warning (_ ("ly_make_music (): Not a string"));
290 scm_write (type, scm_current_error_port ());
292 return SCM_UNSPECIFIED;
296 SCM s = get_music (ly_scm2string (type))->self_scm ();
297 scm_gc_unprotect_object (s);
303 ly_music_name (SCM mus)
305 Music * m = unsmob_music (mus);
309 warning (_ ("ly_music_name (): Not a music expression"));
310 scm_write (mus, scm_current_error_port ());
314 return ly_str02scm (nm);
320 scm_c_define_gsubr ("ly-get-mus-property", 2, 0, 0, (Scheme_function_unknown)ly_get_mus_property);
321 scm_c_define_gsubr ("ly-set-mus-property", 3, 0, 0, (Scheme_function_unknown)ly_set_mus_property);
322 scm_c_define_gsubr ("ly-make-music", 1, 0, 0, (Scheme_function_unknown)ly_make_music);
323 scm_c_define_gsubr ("ly-music-name", 1, 0, 0, (Scheme_function_unknown)ly_music_name);
325 ADD_SCM_INIT_FUNC (musicscm,init_functions);