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 if (!ly_is_procedure (length_callback_
))
58 length_callback_
= duration_length_callback_proc
;
61 start_callback_
= get_property ("start-callback");
64 Music::Music (Music
const &m
)
66 immutable_property_alist_
= m
.immutable_property_alist_
;
67 mutable_property_alist_
= SCM_EOL
;
70 /* First we smobify_self, then we copy over the stuff. If we don't,
71 stack vars that hold the copy might be optimized away, meaning
72 that they won't be protected from GC. */
74 mutable_property_alist_
= ly_music_deep_copy (m
.mutable_property_alist_
);
75 length_callback_
= m
.length_callback_
;
76 start_callback_
= m
.start_callback_
;
77 set_spot (*m
.origin ());
85 Music::get_property_alist (bool m
) const
87 return (m
) ? mutable_property_alist_
: immutable_property_alist_
;
91 Music::mark_smob (SCM m
)
93 Music
*mus
= (Music
*) SCM_CELL_WORD_1 (m
);
94 scm_gc_mark (mus
->immutable_property_alist_
);
95 return mus
->mutable_property_alist_
;
99 Music::get_length () const
101 SCM lst
= get_property ("length");
102 if (unsmob_moment (lst
))
103 return *unsmob_moment (lst
);
105 if (ly_is_procedure (length_callback_
))
107 SCM res
= scm_call_1 (length_callback_
, self_scm ());
108 return *unsmob_moment (res
);
115 Music::start_mom () const
117 SCM lst
= start_callback_
;
118 if (ly_is_procedure (lst
))
120 SCM res
= scm_call_1 (lst
, self_scm ());
121 return *unsmob_moment (res
);
129 print_alist (SCM a
, SCM port
)
131 /* SCM_EOL -> catch malformed lists. */
132 for (SCM s
= a
; scm_is_pair (s
); s
= scm_cdr (s
))
134 scm_display (scm_caar (s
), port
);
135 scm_puts (" = ", port
);
136 scm_write (scm_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
);
147 SCM nm
= m
->get_property ("name");
148 if (scm_is_symbol (nm
) || scm_is_string (nm
))
151 scm_puts (classname (m
), p
);
153 /* Printing properties takes a lot of time, especially during backtraces.
154 For inspecting, it is better to explicitly use an inspection
162 Music::generic_to_relative_octave (Pitch last
)
164 SCM elt
= get_property ("element");
165 Pitch
*old_pit
= unsmob_pitch (get_property ("pitch"));
168 Pitch new_pit
= *old_pit
;
169 new_pit
= new_pit
.to_relative_octave (last
);
171 SCM check
= get_property ("absolute-octave");
172 if (scm_is_number (check
)
173 && new_pit
.get_octave () != scm_to_int (check
))
175 Pitch
expected_pit (scm_to_int (check
),
176 new_pit
.get_notename (),
177 new_pit
.get_alteration ());
178 origin ()->warning (_f ("octave check failed; expected %s, found: %s",
179 expected_pit
.to_string (),
180 new_pit
.to_string ()));
181 new_pit
= expected_pit
;
184 set_property ("pitch", new_pit
.smobbed_copy ());
189 if (Music
*m
= unsmob_music (elt
))
190 last
= m
->to_relative_octave (last
);
192 last
= music_list_to_relative (get_property ("elements"), last
, false);
197 Music::to_relative_octave (Pitch last
)
199 SCM callback
= get_property ("to-relative-callback");
200 if (ly_is_procedure (callback
))
202 Pitch
*p
= unsmob_pitch (scm_call_2 (callback
, self_scm (), last
.smobbed_copy ()));
206 return generic_to_relative_octave (last
);
210 Music::compress (Moment factor
)
212 SCM elt
= get_property ("element");
214 if (Music
*m
= unsmob_music (elt
))
215 m
->compress (factor
);
217 compress_music_list (get_property ("elements"), factor
);
218 Duration
*d
= unsmob_duration (get_property ("duration"));
220 set_property ("duration", d
->compressed (factor
.main_part_
).smobbed_copy ());
224 Music::transpose (Pitch delta
)
226 if (to_boolean (get_property ("untransposable")))
229 for (SCM s
= this->get_property_alist (true); scm_is_pair (s
); s
= scm_cdr (s
))
231 SCM entry
= scm_car (s
);
232 SCM val
= scm_cdr (entry
);
234 if (Pitch
*p
= unsmob_pitch (val
))
236 Pitch transposed
= p
->transposed (delta
);
237 scm_set_cdr_x (entry
, transposed
.smobbed_copy ());
239 if (abs (transposed
.get_alteration ()) > DOUBLE_SHARP
)
241 warning (_f ("transposition by %s makes alteration larger than double",
242 delta
.to_string ()));
247 SCM elt
= get_property ("element");
249 if (Music
*m
= unsmob_music (elt
))
250 m
->transpose (delta
);
252 transpose_music_list (get_property ("elements"), delta
);
255 UGH - how do this more generically?
257 SCM pa
= get_property ("pitch-alist");
258 if (scm_is_pair (pa
))
260 set_property ("pitch-alist", ly_transpose_key_alist (pa
, delta
.smobbed_copy ()));
264 IMPLEMENT_TYPE_P (Music
, "ly:music?");
265 IMPLEMENT_SMOBS (Music
);
266 IMPLEMENT_DEFAULT_EQUAL_P (Music
);
269 Music::internal_get_property (SCM sym
) const
271 SCM s
= scm_sloppy_assq (sym
, mutable_property_alist_
);
275 s
= scm_sloppy_assq (sym
, immutable_property_alist_
);
276 return (s
== SCM_BOOL_F
) ? SCM_EOL
: scm_cdr (s
);
280 Music::internal_get_object (SCM s
) const
282 return internal_get_property (s
);
286 Music::internal_set_object (SCM s
, SCM v
)
288 return internal_set_property (s
, v
);
292 Music::internal_set_property (SCM s
, SCM v
)
294 if (do_internal_type_checking_global
)
295 if (!type_check_assignment (s
, v
, ly_symbol2scm ("music-type?")))
298 mutable_property_alist_
= scm_assq_set_x (mutable_property_alist_
, s
, v
);
302 Music::set_spot (Input ip
)
304 set_property ("origin", make_input (ip
));
308 Music::origin () const
310 Input
*ip
= unsmob_input (get_property ("origin"));
311 return ip
? ip
: &dummy_input_global
;
315 make_music_by_name (SCM sym
)
317 SCM make_music_proc
= ly_lily_module_constant ("make-music");
318 SCM rv
= scm_call_1 (make_music_proc
, sym
);
321 Music
*m
= unsmob_music (rv
);
326 MAKE_SCHEME_CALLBACK (Music
, duration_length_callback
, 1);
328 Music::duration_length_callback (SCM m
)
330 Music
*me
= unsmob_music (m
);
331 Duration
*d
= unsmob_duration (me
->get_property ("duration"));
336 mom
= d
->get_length ();
338 return mom
.smobbed_copy ();