X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Fmusic.cc;h=4d882ba98339d42d9b2237309a6bbbb94bd11f4c;hb=712b6f387c98454e0fc8c5b6c7f0848acf4b29ec;hp=df19f5cb36f4140cdceb9c9897219c00353f464b;hpb=ed2f7473be57e99f15acc48c06fe18fed27d43b3;p=lilypond.git diff --git a/lily/music.cc b/lily/music.cc index df19f5cb36..4d882ba983 100644 --- a/lily/music.cc +++ b/lily/music.cc @@ -6,14 +6,14 @@ (c) 1997--2004 Han-Wen Nienhuys */ -#include "main.hh" #include "input-smob.hh" -#include "music.hh" -#include "music-list.hh" -#include "warn.hh" -#include "pitch.hh" #include "ly-smobs.icc" #include "main.hh" +#include "music-list.hh" +#include "music.hh" +#include "pitch.hh" +#include "score.hh" +#include "warn.hh" bool @@ -28,7 +28,7 @@ String Music::name () const { SCM nm = get_property ("name"); - if (gh_symbol_p (nm)) + if (ly_c_symbol_p (nm)) { return ly_symbol2string (nm); } @@ -87,9 +87,9 @@ Music::get_length () const SCM lst = get_property ("length"); if (unsmob_moment (lst)) return *unsmob_moment (lst); - else if (gh_procedure_p (lst)) + else if (ly_c_procedure_p (lst)) { - SCM res = gh_call1 (lst, self_scm ()); + SCM res = scm_call_1 (lst, self_scm ()); return *unsmob_moment (res); } @@ -100,9 +100,9 @@ Moment Music::start_mom () const { SCM lst = get_property ("start-moment-function"); - if (gh_procedure_p (lst)) + if (ly_c_procedure_p (lst)) { - SCM res = gh_call1 (lst, self_scm ()); + SCM res = scm_call_1 (lst, self_scm ()); return *unsmob_moment (res); } @@ -114,7 +114,7 @@ void print_alist (SCM a, SCM port) { /* SCM_EOL -> catch malformed lists. */ - for (SCM s = a; gh_pair_p (s); s = ly_cdr (s)) + for (SCM s = a; ly_c_pair_p (s); s = ly_cdr (s)) { scm_display (ly_caar (s), port); scm_puts (" = ", port); @@ -130,7 +130,7 @@ Music::print_smob (SCM s, SCM p, scm_print_state*) Music* m = unsmob_music (s); SCM nm = m->get_property ("name"); - if (gh_symbol_p (nm) || gh_string_p (nm)) + if (ly_c_symbol_p (nm) || ly_c_string_p (nm)) scm_display (nm, p); else scm_puts (classname (m),p); @@ -215,6 +215,18 @@ Music::origin () const return ip ? ip : & dummy_input_global; } + +Music* +make_music_by_name (SCM sym) +{ + SCM make_music_proc = ly_scheme_function ("make-music"); + SCM rv = scm_call_1 (make_music_proc, sym); + + /* UGH. */ + scm_gc_protect_object (rv); + return unsmob_music (rv); +} + LY_DEFINE (ly_music_length, "ly:music-length", 1, 0, 0, (SCM mus), "Get the length of music expression @var{mus}, and return as a @code{Moment} object.") @@ -231,7 +243,7 @@ LY_DEFINE (ly_music_property, { Music * sc = unsmob_music (mus); SCM_ASSERT_TYPE (sc, mus, SCM_ARG1, __FUNCTION__, "music"); - SCM_ASSERT_TYPE (gh_symbol_p (sym), sym, SCM_ARG2, __FUNCTION__, "symbol"); + SCM_ASSERT_TYPE (ly_c_symbol_p (sym), sym, SCM_ARG2, __FUNCTION__, "symbol"); return sc->internal_get_property (sym); } @@ -242,7 +254,7 @@ LY_DEFINE (ly_music_set_property, "ly:music-set-property!", { Music * sc = unsmob_music (mus); SCM_ASSERT_TYPE (sc, mus, SCM_ARG1, __FUNCTION__, "music"); - SCM_ASSERT_TYPE (gh_symbol_p (sym), sym, SCM_ARG2, __FUNCTION__, "symbol"); + SCM_ASSERT_TYPE (ly_c_symbol_p (sym), sym, SCM_ARG2, __FUNCTION__, "symbol"); bool ok = type_check_assignment (sym, val, ly_symbol2scm ("music-type?")); if (ok) @@ -275,7 +287,7 @@ LY_DEFINE (ly_extended_make_music, "ly:make-bare-music", "for creating music objects. " ) { - SCM_ASSERT_TYPE (gh_string_p (type), type, SCM_ARG1, __FUNCTION__, "string"); + SCM_ASSERT_TYPE (ly_c_string_p (type), type, SCM_ARG1, __FUNCTION__, "string"); SCM s = make_music (ly_scm2string (type))->self_scm (); unsmob_music (s)->immutable_property_alist_ = props; scm_gc_unprotect_object (s); @@ -283,7 +295,7 @@ LY_DEFINE (ly_extended_make_music, "ly:make-bare-music", } /* todo: property args */ -LY_DEFINE (ly_mutable_music_properties, "ly:mutable-music-properties", +LY_DEFINE (ly_music_mutable_properties, "ly:music-mutable-properties", 1, 0, 0, (SCM mus), "Return an alist containing the mutable properties of @var{mus}.\n" "The immutable properties are not available, since " @@ -301,11 +313,11 @@ LY_DEFINE (ly_music_list_p,"ly:music-list?", "of music objects.") { if (scm_list_p (lst) == SCM_BOOL_T) - while (gh_pair_p (lst)) + while (ly_c_pair_p (lst)) { - if (!unsmob_music (gh_car (lst))) + if (!unsmob_music (ly_car (lst))) return SCM_BOOL_F; - lst = gh_cdr (lst); + lst = ly_cdr (lst); } return SCM_BOOL_T; @@ -321,8 +333,8 @@ LY_DEFINE (ly_deep_mus_copy, "ly:music-deep-copy", copy = unsmob_music (m)->clone ()->self_scm (); scm_gc_unprotect_object (copy); } - else if (gh_pair_p (m)) - copy = gh_cons (ly_deep_mus_copy (ly_car (m)), + else if (ly_c_pair_p (m)) + copy = scm_cons (ly_deep_mus_copy (ly_car (m)), ly_deep_mus_copy (ly_cdr (m))); return copy; } @@ -342,16 +354,39 @@ LY_DEFINE (ly_music_transpose, "ly:music-transpose", return sc->self_scm (); } - -Music* -make_music_by_name (SCM sym) +/* + TODO: should take moment factor? + */ +LY_DEFINE (ly_music_compress, "ly:music-compress", + 2, 0, 0, (SCM m, SCM factor), + "Compress music object @var{m} by moment @var{factor}." + ) { - SCM make_music_proc = ly_scheme_function ("make-music"); - - SCM rv = scm_call_1 (make_music_proc, sym); + Music * sc = unsmob_music (m); - /* UGH. */ - scm_gc_protect_object (rv); - return unsmob_music (rv); + SCM_ASSERT_TYPE (sc, m, SCM_ARG1, __FUNCTION__, "music"); + SCM_ASSERT_TYPE (unsmob_moment (factor), factor, SCM_ARG2, __FUNCTION__, "moment"); + + sc->compress (*unsmob_moment (factor)); + return sc->self_scm (); } +LY_DEFINE (ly_music_scorify, "ly:music-scorify", + 1, 0, 0, + (SCM music), + "Return MUSIC encapsulated in SCORE.") +{ +#if 0 + SCM_ASSERT_TYPE (ly_c_music_p (music), music, SCM_ARG1, __FUNCTION__, "music"); +#endif + Score *score = new Score; + + /* URG? */ + SCM check_funcs = ly_scheme_function ("toplevel-music-functions"); + for (; ly_c_pair_p (check_funcs); check_funcs = ly_cdr (check_funcs)) + music = scm_call_1 (ly_car (check_funcs), music); + + score->music_ = music; + scm_gc_unprotect_object (score->self_scm ()); + return score->self_scm (); +}