2 music.cc -- implement Music
4 source file of the GNU LilyPond music typesetter
6 (c) 1997--2006 Han-Wen Nienhuys <hanwen@xs4all.nl>
10 #include "music-sequence.hh"
11 #include "duration.hh"
12 #include "input-smob.hh"
13 #include "ly-smobs.icc"
20 Music is anything that has duration and supports both time compression
23 In Lily, everything that can be thought to have a length and a pitch
24 (which has a duration which can be transposed) is considered "music",
27 Music::internal_is_music_type (SCM k) const
29 SCM ifs = get_property ("types");
31 return scm_c_memq (k, ifs) != SCM_BOOL_F;
34 Music::Music (SCM init)
37 length_callback_ = SCM_EOL;
38 start_callback_ = SCM_EOL;
40 length_callback_ = get_property ("length-callback");
41 if (!ly_is_procedure (length_callback_))
42 length_callback_ = duration_length_callback_proc;
44 start_callback_ = get_property ("start-callback");
48 Music::derived_mark () const
50 scm_gc_mark (length_callback_);
51 scm_gc_mark (start_callback_);
55 Music::copy_mutable_properties () const
57 return ly_music_deep_copy (mutable_property_alist_);
61 Music::type_check_assignment (SCM s, SCM v) const
63 if (!::type_check_assignment (s, v, ly_symbol2scm ("music-type?")))
67 Music::Music (Music const &m)
70 length_callback_ = m.length_callback_;
71 start_callback_ = m.start_callback_;
74 set_spot (*m.origin ());
78 Music::get_length () const
80 SCM lst = get_property ("length");
81 if (unsmob_moment (lst))
82 return *unsmob_moment (lst);
84 if (ly_is_procedure (length_callback_))
86 SCM res = scm_call_1 (length_callback_, self_scm ());
87 return *unsmob_moment (res);
94 Music::start_mom () const
96 SCM lst = start_callback_;
97 if (ly_is_procedure (lst))
99 SCM res = scm_call_1 (lst, self_scm ());
100 return *unsmob_moment (res);
108 print_alist (SCM a, SCM port)
110 /* SCM_EOL -> catch malformed lists. */
111 for (SCM s = a; scm_is_pair (s); s = scm_cdr (s))
113 scm_display (scm_caar (s), port);
114 scm_puts (" = ", port);
115 scm_write (scm_cdar (s), port);
116 scm_puts ("\n", port);
122 Music::generic_to_relative_octave (Pitch last)
124 SCM elt = get_property ("element");
125 Pitch *old_pit = unsmob_pitch (get_property ("pitch"));
128 Pitch new_pit = *old_pit;
129 new_pit = new_pit.to_relative_octave (last);
131 SCM check = get_property ("absolute-octave");
132 if (scm_is_number (check)
133 && new_pit.get_octave () != scm_to_int (check))
135 Pitch expected_pit (scm_to_int (check),
136 new_pit.get_notename (),
137 new_pit.get_alteration ());
138 origin ()->warning (_f ("octave check failed; expected %s, found: %s",
139 expected_pit.to_string (),
140 new_pit.to_string ()));
141 new_pit = expected_pit;
144 set_property ("pitch", new_pit.smobbed_copy ());
149 if (Music *m = unsmob_music (elt))
150 last = m->to_relative_octave (last);
152 last = music_list_to_relative (get_property ("elements"), last, false);
157 Music::to_relative_octave (Pitch last)
159 SCM callback = get_property ("to-relative-callback");
160 if (ly_is_procedure (callback))
162 Pitch *p = unsmob_pitch (scm_call_2 (callback, self_scm (), last.smobbed_copy ()));
166 return generic_to_relative_octave (last);
170 Music::compress (Moment factor)
172 SCM elt = get_property ("element");
174 if (Music *m = unsmob_music (elt))
175 m->compress (factor);
177 compress_music_list (get_property ("elements"), factor);
178 Duration *d = unsmob_duration (get_property ("duration"));
180 set_property ("duration", d->compressed (factor.main_part_).smobbed_copy ());
184 Music::transpose (Pitch delta)
186 if (to_boolean (get_property ("untransposable")))
189 for (SCM s = this->get_property_alist (true); scm_is_pair (s); s = scm_cdr (s))
191 SCM entry = scm_car (s);
192 SCM val = scm_cdr (entry);
194 if (Pitch *p = unsmob_pitch (val))
196 Pitch transposed = p->transposed (delta);
197 scm_set_cdr_x (entry, transposed.smobbed_copy ());
199 if (abs (transposed.get_alteration ()) > DOUBLE_SHARP)
201 warning (_f ("transposition by %s makes alteration larger than double",
202 delta.to_string ()));
207 SCM elt = get_property ("element");
209 if (Music *m = unsmob_music (elt))
210 m->transpose (delta);
212 transpose_music_list (get_property ("elements"), delta);
215 UGH - how do this more generically?
217 SCM pa = get_property ("pitch-alist");
218 if (scm_is_pair (pa))
219 set_property ("pitch-alist", ly_transpose_key_alist (pa, delta.smobbed_copy ()));
225 Music::set_spot (Input ip)
227 set_property ("origin", make_input (ip));
231 Music::origin () const
233 Input *ip = unsmob_input (get_property ("origin"));
234 return ip ? ip : &dummy_input_global;
238 make_music_by_name (SCM sym)
240 SCM make_music_proc = ly_lily_module_constant ("make-music");
241 SCM rv = scm_call_1 (make_music_proc, sym);
244 Music *m = unsmob_music (rv);
249 MAKE_SCHEME_CALLBACK (Music, duration_length_callback, 1);
251 Music::duration_length_callback (SCM m)
253 Music *me = unsmob_music (m);
254 Duration *d = unsmob_duration (me->get_property ("duration"));
258 mom = d->get_length ();
259 return mom.smobbed_copy ();
265 return dynamic_cast<Music*> (unsmob_prob (m));