2 music.cc -- implement Music
4 source file of the GNU LilyPond music typesetter
6 (c) 1997--2005 Han-Wen Nienhuys <hanwen@cs.uu.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
;
37 SCM nm
= get_property ("name");
38 if (scm_is_symbol (nm
))
40 return ly_symbol2string (nm
);
44 return classname (this);
48 Music::Music (SCM init
)
51 immutable_property_alist_
= init
;
52 mutable_property_alist_
= SCM_EOL
;
55 length_callback_
= get_property ("length-callback");
56 start_callback_
= get_property ("start-callback");
59 Music::Music (Music
const &m
)
61 immutable_property_alist_
= m
.immutable_property_alist_
;
62 mutable_property_alist_
= SCM_EOL
;
65 /* First we smobify_self, then we copy over the stuff. If we don't,
66 stack vars that hold the copy might be optimized away, meaning
67 that they won't be protected from GC. */
69 mutable_property_alist_
= ly_music_deep_copy (m
.mutable_property_alist_
);
70 length_callback_
= m
.length_callback_
;
71 start_callback_
= m
.start_callback_
;
72 set_spot (*m
.origin ());
82 Music::get_property_alist (bool m
) const
84 return (m
) ? mutable_property_alist_
: immutable_property_alist_
;
88 Music::mark_smob (SCM m
)
90 Music
*mus
= (Music
*) SCM_CELL_WORD_1 (m
);
91 scm_gc_mark (mus
->immutable_property_alist_
);
92 scm_gc_mark (mus
->mutable_property_alist_
);
97 Music::get_length () const
99 SCM lst
= get_property ("length");
100 if (unsmob_moment (lst
))
101 return *unsmob_moment (lst
);
103 if (ly_c_procedure_p (length_callback_
))
105 SCM res
= scm_call_1 (length_callback_
, self_scm ());
106 return *unsmob_moment (res
);
113 Music::start_mom () const
115 SCM lst
= get_property ("start-callback");
116 if (ly_c_procedure_p (lst
))
118 SCM res
= scm_call_1 (lst
, self_scm ());
119 return *unsmob_moment (res
);
127 print_alist (SCM a
, SCM port
)
129 /* SCM_EOL -> catch malformed lists. */
130 for (SCM s
= a
; scm_is_pair (s
); s
= scm_cdr (s
))
132 scm_display (scm_caar (s
), port
);
133 scm_puts (" = ", port
);
134 scm_write (scm_cdar (s
), port
);
135 scm_puts ("\n", port
);
140 Music::print_smob (SCM s
, SCM p
, scm_print_state
*)
142 scm_puts ("#<Music ", p
);
143 Music
*m
= unsmob_music (s
);
145 SCM nm
= m
->get_property ("name");
146 if (scm_is_symbol (nm
) || scm_is_string (nm
))
149 scm_puts (classname (m
), p
);
151 /* Printing properties takes a lot of time, especially during backtraces.
152 For inspecting, it is better to explicitly use an inspection
160 Music::generic_to_relative_octave (Pitch last
)
162 SCM elt
= get_property ("element");
163 Pitch
*old_pit
= unsmob_pitch (get_property ("pitch"));
166 Pitch new_pit
= *old_pit
;
167 new_pit
= new_pit
.to_relative_octave (last
);
169 SCM check
= get_property ("absolute-octave");
170 if (scm_is_number (check
)
171 && new_pit
.get_octave () != scm_to_int (check
))
173 Pitch
expected_pit (scm_to_int (check
),
174 new_pit
.get_notename (),
175 new_pit
.get_alteration ());
176 origin ()->warning (_f ("octave check failed; expected %s, found: %s",
177 expected_pit
.to_string (),
178 new_pit
.to_string ()));
179 new_pit
= expected_pit
;
182 set_property ("pitch", new_pit
.smobbed_copy ());
187 if (Music
*m
= unsmob_music (elt
))
188 last
= m
->to_relative_octave (last
);
190 last
= music_list_to_relative (get_property ("elements"), last
, false);
195 Music::to_relative_octave (Pitch last
)
197 SCM callback
= get_property ("to-relative-callback");
198 if (ly_c_procedure_p (callback
))
200 Pitch
*p
= unsmob_pitch (scm_call_2 (callback
, self_scm (), last
.smobbed_copy ()));
204 return generic_to_relative_octave (last
);
208 Music::compress (Moment factor
)
210 SCM elt
= get_property ("element");
212 if (Music
*m
= unsmob_music (elt
))
213 m
->compress (factor
);
215 compress_music_list (get_property ("elements"), factor
);
216 Duration
*d
= unsmob_duration (get_property ("duration"));
218 set_property ("duration", d
->compressed (factor
.main_part_
).smobbed_copy ());
222 Music::transpose (Pitch delta
)
224 if (to_boolean (get_property ("untransposable")))
227 for (SCM s
= this->get_property_alist (true); scm_is_pair (s
); s
= scm_cdr (s
))
229 SCM entry
= scm_car (s
);
230 SCM val
= scm_cdr (entry
);
232 if (Pitch
*p
= unsmob_pitch (val
))
234 Pitch transposed
= p
->transposed (delta
);
235 scm_set_cdr_x (entry
, transposed
.smobbed_copy ());
237 if (abs (transposed
.get_alteration ()) > DOUBLE_SHARP
)
239 warning (_f ("transposition by %s makes alteration larger than double",
240 delta
.to_string ()));
245 SCM elt
= get_property ("element");
247 if (Music
*m
= unsmob_music (elt
))
248 m
->transpose (delta
);
250 transpose_music_list (get_property ("elements"), delta
);
253 UGH - how do this more generically?
255 SCM pa
= get_property ("pitch-alist");
256 if (scm_is_pair (pa
))
258 set_property ("pitch-alist", ly_transpose_key_alist (pa
, delta
.smobbed_copy ()));
262 IMPLEMENT_TYPE_P (Music
, "ly:music?");
263 IMPLEMENT_SMOBS (Music
);
264 IMPLEMENT_DEFAULT_EQUAL_P (Music
);
267 Music::internal_get_property (SCM sym
) const
269 SCM s
= scm_sloppy_assq (sym
, mutable_property_alist_
);
273 s
= scm_sloppy_assq (sym
, immutable_property_alist_
);
274 return (s
== SCM_BOOL_F
) ? SCM_EOL
: scm_cdr (s
);
278 Music::internal_set_property (SCM s
, SCM v
)
280 if (do_internal_type_checking_global
)
281 if (!type_check_assignment (s
, v
, ly_symbol2scm ("music-type?")))
284 mutable_property_alist_
= scm_assq_set_x (mutable_property_alist_
, s
, v
);
288 Music::set_spot (Input ip
)
290 set_property ("origin", make_input (ip
));
294 Music::origin () const
296 Input
*ip
= unsmob_input (get_property ("origin"));
297 return ip
? ip
: &dummy_input_global
;
301 Music::duration_log () const
303 if (is_mus_type ("rhythmic-event"))
304 return unsmob_duration (get_property ("duration"))->duration_log ();
309 make_music_by_name (SCM sym
)
311 SCM make_music_proc
= ly_lily_module_constant ("make-music");
312 SCM rv
= scm_call_1 (make_music_proc
, sym
);
315 scm_gc_protect_object (rv
);
316 return unsmob_music (rv
);