2 This file is part of LilyPond, the GNU music typesetter.
4 Copyright (C) 1997--2014 Han-Wen Nienhuys <hanwen@xs4all.nl>
6 LilyPond is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 LilyPond is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
23 #include "dispatcher.hh"
24 #include "duration.hh"
26 #include "international.hh"
27 #include "ly-smobs.icc"
29 #include "music-sequence.hh"
34 Music is anything that has (possibly zero) duration and supports
35 both time compression and transposition.
37 In Lily, everything that can be thought to have a length and a pitch
38 (which has a duration which can be transposed) is considered "music".
41 Music::internal_is_music_type (SCM k) const
43 SCM ifs = get_property ("types");
45 return scm_c_memq (k, ifs) != SCM_BOOL_F;
48 Music::Music (SCM init)
49 : Prob (ly_symbol2scm ("Music"), init)
51 length_callback_ = SCM_EOL;
52 start_callback_ = SCM_EOL;
54 length_callback_ = get_property ("length-callback");
55 if (!ly_is_procedure (length_callback_))
56 length_callback_ = duration_length_callback_proc;
58 start_callback_ = get_property ("start-callback");
62 Music::derived_mark () const
64 scm_gc_mark (length_callback_);
65 scm_gc_mark (start_callback_);
69 Music::copy_mutable_properties () const
71 return ly_music_deep_copy (mutable_property_alist_);
75 Music::type_check_assignment (SCM s, SCM v) const
77 ::type_check_assignment (s, v, ly_symbol2scm ("music-type?"));
80 Music::Music (Music const &m)
83 length_callback_ = m.length_callback_;
84 start_callback_ = m.start_callback_;
87 set_spot (*m.origin ());
91 Music::get_length () const
93 SCM lst = get_property ("length");
94 if (Moment::unsmob (lst))
95 return *Moment::unsmob (lst);
97 if (ly_is_procedure (length_callback_))
99 SCM res = scm_call_1 (length_callback_, self_scm ());
100 return *Moment::unsmob (res);
107 Music::start_mom () const
109 SCM lst = start_callback_;
110 if (ly_is_procedure (lst))
112 SCM res = scm_call_1 (lst, self_scm ());
113 return *Moment::unsmob (res);
121 print_alist (SCM a, SCM port)
123 /* SCM_EOL -> catch malformed lists. */
124 for (SCM s = a; scm_is_pair (s); s = scm_cdr (s))
126 scm_display (scm_caar (s), port);
127 scm_puts (" = ", port);
128 scm_write (scm_cdar (s), port);
129 scm_puts ("\n", port);
134 Music::generic_to_relative_octave (Pitch last)
136 SCM elt = get_property ("element");
137 Pitch *old_pit = Pitch::unsmob (get_property ("pitch"));
140 Pitch new_pit = *old_pit;
141 new_pit = new_pit.to_relative_octave (last);
143 SCM check = get_property ("absolute-octave");
144 if (scm_is_number (check)
145 && new_pit.get_octave () != scm_to_int (check))
147 Pitch expected_pit (scm_to_int (check),
148 new_pit.get_notename (),
149 new_pit.get_alteration ());
150 origin ()->warning (_f ("octave check failed; expected \"%s\", found: \"%s\"",
151 expected_pit.to_string (),
152 new_pit.to_string ()));
153 new_pit = expected_pit;
156 set_property ("pitch", new_pit.smobbed_copy ());
161 if (Music *m = Music::unsmob (elt))
162 last = m->to_relative_octave (last);
164 (void) music_list_to_relative (get_property ("articulations"), last, true);
165 last = music_list_to_relative (get_property ("elements"), last, false);
170 Music::to_relative_octave (Pitch last)
172 SCM callback = get_property ("to-relative-callback");
173 if (ly_is_procedure (callback))
175 Pitch *p = Pitch::unsmob (scm_call_2 (callback, self_scm (),
176 last.smobbed_copy ()));
180 return generic_to_relative_octave (last);
184 Music::compress (Moment factor)
186 SCM elt = get_property ("element");
188 if (Music *m = Music::unsmob (elt))
189 m->compress (factor);
191 compress_music_list (get_property ("elements"), factor);
192 Duration *d = Duration::unsmob (get_property ("duration"));
194 set_property ("duration",
195 d->compressed (factor.main_part_).smobbed_copy ());
199 This mutates alist. Hence, make sure that it is not shared
202 transpose_mutable (SCM alist, Pitch delta)
204 for (SCM s = alist; scm_is_pair (s); s = scm_cdr (s))
206 SCM entry = scm_car (s);
207 SCM prop = scm_car (entry);
208 SCM val = scm_cdr (entry);
211 if (Pitch *p = Pitch::unsmob (val))
213 Pitch transposed = p->transposed (delta);
215 if (prop == ly_symbol2scm ("tonic"))
216 transposed = Pitch (-1, transposed.get_notename (),
217 transposed.get_alteration ());
219 new_val = transposed.smobbed_copy ();
221 else if (prop == ly_symbol2scm ("element"))
223 if (Music *m = Music::unsmob (val))
224 m->transpose (delta);
226 else if (prop == ly_symbol2scm ("elements")
227 || prop == ly_symbol2scm ("articulations"))
228 transpose_music_list (val, delta);
229 else if (prop == ly_symbol2scm ("pitch-alist")
230 && scm_is_pair (val))
231 new_val = ly_transpose_key_alist (val, delta.smobbed_copy ());
234 scm_set_cdr_x (entry, new_val);
239 Music::transpose (Pitch delta)
241 if (to_boolean (get_property ("untransposable")))
244 transpose_mutable (mutable_property_alist_, delta);
248 Music::set_spot (Input ip)
250 set_property ("origin", make_input (ip));
254 Music::origin () const
256 Input *ip = Input::unsmob (get_property ("origin"));
257 return ip ? ip : &dummy_input_global;
261 ES TODO: This method should probably be reworked or junked.
264 Music::to_event () const
266 SCM class_name = ly_camel_case_2_lisp_identifier (get_property ("name"));
268 // catch programming mistakes.
269 if (!internal_is_music_type (class_name))
270 programming_error ("Not a music type");
272 Stream_event *e = new Stream_event
273 (scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), class_name),
274 mutable_property_alist_);
275 Moment length = get_length ();
276 if (length.to_bool ())
277 e->set_property ("length", length.smobbed_copy ());
279 // articulations as events.
280 SCM art_mus = e->get_property ("articulations");
281 if (scm_is_pair (art_mus))
283 SCM art_ev = SCM_EOL;
284 for (; scm_is_pair (art_mus); art_mus = scm_cdr (art_mus))
286 Music *m = Music::unsmob (scm_car (art_mus));
287 art_ev = scm_cons (m->to_event ()->unprotect (), art_ev);
289 e->set_property ("articulations", scm_reverse_x (art_ev, SCM_EOL));
293 ES TODO: This is a temporary fix. Stream_events should not be
296 e->set_property ("music-cause", self_scm ());
302 Music::send_to_context (Context *c)
304 Stream_event *ev = to_event ();
305 c->event_source ()->broadcast (ev);
310 make_music_by_name (SCM sym)
312 SCM make_music_proc = ly_lily_module_constant ("make-music");
313 SCM rv = scm_call_1 (make_music_proc, sym);
316 Music *m = Music::unsmob (rv);
321 MAKE_SCHEME_CALLBACK (Music, duration_length_callback, 1);
323 Music::duration_length_callback (SCM m)
325 Music *me = Music::unsmob (m);
326 Duration *d = Duration::unsmob (me->get_property ("duration"));
330 mom = d->get_length ();
331 return mom.smobbed_copy ();
335 Music::unsmob (SCM m)
337 return dynamic_cast<Music *> (Prob::unsmob (m));