lily/music-scheme.cc

   1 /*
   2   music-scheme.cc -- implement Music bindings
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 2005 Han-Wen Nienhuys <hanwen@xs4all.nl>
   7 */
   8
   9 #include "duration.hh"
  10 #include "warn.hh"
  11 #include "music.hh"
  12 #include "pitch.hh"
  13
  14 LY_DEFINE (ly_music_length, "ly:music-length",
  15            1, 0, 0, (SCM mus),
  16            "Get the length of music expression @var{mus}, and return as a @code{Moment} object.")
  17 {
  18   Music *sc = unsmob_music (mus);
  19   SCM_ASSERT_TYPE (sc, mus, SCM_ARG1, __FUNCTION__, "music");
  20   return sc->get_length ().smobbed_copy ();
  21 }
  22
  23 LY_DEFINE (ly_music_property,
  24            "ly:music-property", 2, 0, 0, (SCM mus, SCM sym),
  25            "Get the property @var{sym} of music expression @var{mus}.\n"
  26            "If @var{sym} is undefined, return @code{' ()}.\n")
  27 {
  28   Music *sc = unsmob_music (mus);
  29   SCM_ASSERT_TYPE (sc, mus, SCM_ARG1, __FUNCTION__, "music");
  30   SCM_ASSERT_TYPE (scm_is_symbol (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
  31
  32   return sc->internal_get_property (sym);
  33 }
  34
  35 LY_DEFINE (ly_music_set_property, "ly:music-set-property!",
  36            3, 0, 0, (SCM mus, SCM sym, SCM val),
  37            "Set property @var{sym} in music expression @var{mus} to @var{val}.")
  38 {
  39   Music *sc = unsmob_music (mus);
  40   SCM_ASSERT_TYPE (sc, mus, SCM_ARG1, __FUNCTION__, "music");
  41   SCM_ASSERT_TYPE (scm_is_symbol (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
  42
  43   bool ok = type_check_assignment (sym, val, ly_symbol2scm ("music-type?"));
  44   if (ok)
  45     sc->internal_set_property (sym, val);
  46
  47   return SCM_UNSPECIFIED;
  48 }
  49
  50 LY_DEFINE (ly_music_name, "ly:music-name",
  51            1, 0, 0, (SCM mus),
  52            "Return the name of @var{music}.")
  53 {
  54   Music *m = unsmob_music (mus);
  55   SCM_ASSERT_TYPE (m, mus, SCM_ARG1, __FUNCTION__, "music");
  56
  57   char const *nm = classname (m);
  58   return scm_makfrom0str (nm);
  59 }
  60
  61 /* todo:  property args */
  62 LY_DEFINE (ly_make_music, "ly:make-music",
  63            1, 0, 0, (SCM props),
  64            "Make a C++ Music object, initialize with\n"
  65            "@var{props}. \n\n"
  66            ""
  67            "This function is for internal use, and is only called by "
  68            "@code{make-music}, which is the preferred interface "
  69            "for creating music objects. ")
  70 {
  71   Music *ms = new Music (props);
  72   return ms->unprotect ();
  73 }
  74
  75 /* todo: property args */
  76 LY_DEFINE (ly_music_mutable_properties, "ly:music-mutable-properties",
  77            1, 0, 0, (SCM mus),
  78            "Return an alist containing the mutable properties of @var{mus}.\n"
  79            "The immutable properties are not available, since "
  80            "they are constant and initialized by the "
  81            "@code{make-music} function.\n")
  82 {
  83   Music *m = unsmob_music (mus);
  84   SCM_ASSERT_TYPE (m, mus, SCM_ARG1, __FUNCTION__, "music");
  85   return m->get_property_alist (true);
  86 }
  87
  88 LY_DEFINE (ly_music_list_p, "ly:music-list?",
  89            1, 0, 0, (SCM lst),
  90            "Type predicate: return true if @var{lst} is a list "
  91            "of music objects.")
  92 {
  93   if (scm_list_p (lst) == SCM_BOOL_T)
  94     while (scm_is_pair (lst))
  95       {
  96         if (!unsmob_music (scm_car (lst)))
  97           return SCM_BOOL_F;
  98         lst = scm_cdr (lst);
  99       }
 100
 101   return SCM_BOOL_T;
 102 }
 103
 104 LY_DEFINE (ly_music_deep_copy, "ly:music-deep-copy",
 105            1, 0, 0, (SCM m),
 106            "Copy @var{m} and all sub expressions of @var{m}")
 107 {
 108   SCM copy = m;
 109   if (unsmob_music (m))
 110     {
 111       Music *mcopy = unsmob_music (m)->clone ();
 112       copy = mcopy->unprotect ();
 113     }
 114   else if (scm_is_pair (m))
 115     copy = scm_cons (ly_music_deep_copy (scm_car (m)),
 116                      ly_music_deep_copy (scm_cdr (m)));
 117   return copy;
 118 }
 119
 120 LY_DEFINE (ly_music_transpose, "ly:music-transpose",
 121            2, 0, 0, (SCM m, SCM p),
 122            "Transpose @var{m} such that central C is mapped to @var{p}. "
 123            "Return @var{m}.")
 124 {
 125   Music *sc = unsmob_music (m);
 126   Pitch *sp = unsmob_pitch (p);
 127   SCM_ASSERT_TYPE (sc, m, SCM_ARG1, __FUNCTION__, "music");
 128   SCM_ASSERT_TYPE (sp, p, SCM_ARG2, __FUNCTION__, "pitch");
 129
 130   sc->transpose (*sp);
 131   // SCM_UNDEFINED ?
 132   return sc->self_scm ();
 133 }
 134
 135 /*
 136   TODO: should take moment factor?
 137 */
 138 LY_DEFINE (ly_music_compress, "ly:music-compress",
 139            2, 0, 0, (SCM m, SCM factor),
 140            "Compress music object @var{m} by moment @var{factor}.")
 141 {
 142   Music *sc = unsmob_music (m);
 143
 144   SCM_ASSERT_TYPE (sc, m, SCM_ARG1, __FUNCTION__, "music");
 145   SCM_ASSERT_TYPE (unsmob_moment (factor), factor, SCM_ARG2, __FUNCTION__, "moment");
 146
 147   sc->compress (*unsmob_moment (factor));
 148   return sc->self_scm ();
 149 }
 150
 151 LY_DEFINE (ly_music_duration_length, "ly:music-duration-length", 1, 0, 0,
 152            (SCM mus),
 153            "Extract the duration field from @var{mus}, and return the length.")
 154 {
 155   Music *m = unsmob_music (mus);
 156   SCM_ASSERT_TYPE (m, mus, SCM_ARG1, __FUNCTION__, "Music");
 157
 158   Duration *d = unsmob_duration (m->get_property ("duration"));
 159   Moment len;
 160
 161   if (d)
 162     len = d->get_length ();
 163   else
 164     programming_error ("music has no duration");
 165   return len.smobbed_copy ();
 166 }
 167
 168 LY_DEFINE (ly_music_duration_compress, "ly:music-duration-compress", 2, 0, 0,
 169            (SCM mus, SCM fact),
 170            "Compress @var{mus} by factor @var{fact}, which is a @code{Moment}.")
 171 {
 172   Music *m = unsmob_music (mus);
 173   Moment *f = unsmob_moment (fact);
 174   SCM_ASSERT_TYPE (m, mus, SCM_ARG1, __FUNCTION__, "Music");
 175   SCM_ASSERT_TYPE (f, fact, SCM_ARG2, __FUNCTION__, "Moment");
 176
 177   Duration *d = unsmob_duration (m->get_property ("duration"));
 178   if (d)
 179     m->set_property ("duration", d->compressed (f->main_part_).smobbed_copy ());
 180   return SCM_UNSPECIFIED;
 181 }
 182
 183 /*
 184   This is hairy, since the scale in a key-change event may contain
 185   octaveless notes.
 186
 187
 188   TODO: this should use ly:pitch.
 189 */
 190 LY_DEFINE (ly_transpose_key_alist, "ly:transpose-key-alist",
 191            2, 0, 0, (SCM l, SCM pit),
 192            "Make a new key alist of @var{l} transposed by pitch @var{pit}")
 193 {
 194   SCM newlist = SCM_EOL;
 195   Pitch *p = unsmob_pitch (pit);
 196
 197   for (SCM s = l; scm_is_pair (s); s = scm_cdr (s))
 198     {
 199       SCM key = scm_caar (s);
 200       SCM alter = scm_cdar (s);
 201       if (scm_is_pair (key))
 202         {
 203           Pitch orig (scm_to_int (scm_car (key)),
 204                       scm_to_int (scm_cdr (key)),
 205                       scm_to_int (alter));
 206
 207           orig = orig.transposed (*p);
 208
 209           SCM key = scm_cons (scm_from_int (orig.get_octave ()),
 210                               scm_from_int (orig.get_notename ()));
 211
 212           newlist = scm_cons (scm_cons (key, scm_from_int (orig.get_alteration ())),
 213                               newlist);
 214         }
 215       else if (scm_is_number (key))
 216         {
 217           Pitch orig (0, scm_to_int (key), scm_to_int (alter));
 218           orig = orig.transposed (*p);
 219
 220           key = scm_from_int (orig.get_notename ());
 221           alter = scm_from_int (orig.get_alteration ());
 222           newlist = scm_cons (scm_cons (key, alter), newlist);
 223         }
 224     }
 225   return scm_reverse_x (newlist, SCM_EOL);
 226 }