lily/music-scheme.cc

   1 /*
   2   This file is part of LilyPond, the GNU music typesetter.
   3
   4   Copyright (C) 2005--2015 Han-Wen Nienhuys <hanwen@xs4all.nl>
   5
   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.
  10
  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.
  15
  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/>.
  18 */
  19
  20 #include "music.hh"
  21
  22 #include "duration.hh"
  23 #include "input.hh"
  24 #include "lily-imports.hh"
  25 #include "program-option.hh"
  26 #include "warn.hh"
  27
  28 LY_DEFINE (ly_music_length, "ly:music-length",
  29            1, 0, 0, (SCM mus),
  30            "Get the length of music expression @var{mus} and return"
  31            " it as a @code{Moment} object.")
  32 {
  33   LY_ASSERT_SMOB (Music, mus, 1);
  34   Music *sc = unsmob<Music> (mus);
  35   return sc->get_length ().smobbed_copy ();
  36 }
  37
  38 LY_DEFINE (ly_music_property, "ly:music-property",
  39            2, 1, 0, (SCM mus, SCM sym, SCM val),
  40            "Return the value for property @var{sym} of music expression"
  41            " @var{mus}.  If no value is found, return @var{val} or"
  42            " @code{'()} if @var{val} is not specified.")
  43 {
  44   LY_ASSERT_SMOB (Music, mus, 1);
  45   return ly_prob_property (mus, sym, val);
  46 }
  47
  48 LY_DEFINE (ly_music_set_property_x, "ly:music-set-property!",
  49            3, 0, 0, (SCM mus, SCM sym, SCM val),
  50            "Set property @var{sym} in music expression @var{mus} to"
  51            " @var{val}.")
  52 {
  53   LY_ASSERT_SMOB (Music, mus, 1);
  54
  55   return ly_prob_set_property_x (mus, sym, val);
  56 }
  57
  58 /* todo:  property args */
  59 LY_DEFINE (ly_make_music, "ly:make-music",
  60            1, 0, 0, (SCM props),
  61            "Make a C++ @code{Music} object and initialize it with"
  62            " @var{props}.\n"
  63            "\n"
  64            "This function is for internal use and is only called by"
  65            " @code{make-music}, which is the preferred interface"
  66            " for creating music objects.")
  67 {
  68   Music *ms = new Music (props);
  69   return ms->unprotect ();
  70 }
  71
  72 LY_DEFINE (ly_music_p, "ly:music?",
  73            1, 0, 0, (SCM obj),
  74            "Is @var{obj} a music object?")
  75 {
  76   return ly_bool2scm (unsmob<Music> (obj));
  77 }
  78
  79 LY_DEFINE (ly_event_p, "ly:event?",
  80            1, 0, 0, (SCM obj),
  81            "Is @var{obj} a proper (non-rhythmic) event object?")
  82 {
  83   if (Music *m = unsmob<Music> (obj))
  84     {
  85       return scm_from_bool (m->is_mus_type ("post-event"));
  86     }
  87   return SCM_BOOL_F;
  88 }
  89
  90 /* todo: property args */
  91 LY_DEFINE (ly_music_mutable_properties, "ly:music-mutable-properties",
  92            1, 0, 0, (SCM mus),
  93            "Return an alist containing the mutable properties of @var{mus}."
  94            "  The immutable properties are not available, since they are"
  95            " constant and initialized by the @code{make-music} function.")
  96 {
  97   LY_ASSERT_SMOB (Music, mus, 1);
  98   Music *m = unsmob<Music> (mus);
  99   return m->get_property_alist (true);
 100 }
 101
 102 LY_DEFINE (ly_music_list_p, "ly:music-list?",
 103            1, 0, 0, (SCM lst),
 104            "Is @var{lst} a list of music objects?")
 105 {
 106   if (!ly_is_list (lst))
 107     return SCM_BOOL_F;
 108
 109   while (scm_is_pair (lst))
 110     {
 111       if (!unsmob<Music> (scm_car (lst)))
 112         return SCM_BOOL_F;
 113       lst = scm_cdr (lst);
 114     }
 115
 116   return SCM_BOOL_T;
 117 }
 118
 119 LY_DEFINE (ly_music_deep_copy, "ly:music-deep-copy",
 120            1, 1, 0, (SCM m, SCM origin),
 121            "Copy @var{m} and all sub expressions of@tie{}@var{m}."
 122            " @var{m} may be an arbitrary type; cons cells and music"
 123            " are copied recursively.  If @var{origin} is given,"
 124            " it is used as the origin for one level of music by calling"
 125            " @code{ly:set-origin!} on the copy.")
 126 {
 127   m = music_deep_copy (m);
 128
 129   if (SCM_UNBNDP (origin))
 130     return m;
 131
 132   if (Music *mus = unsmob<Music> (origin))
 133       origin = mus->get_property ("origin");
 134
 135   if (scm_is_false (origin) || scm_is_null (origin))
 136     return m;
 137
 138   LY_ASSERT_SMOB (Input, origin, 2);
 139
 140   set_origin (m, origin);
 141   return m;
 142 }
 143
 144 LY_DEFINE (ly_set_origin_x, "ly:set-origin!",
 145            1, 1, 0, (SCM m, SCM origin),
 146            "This sets the origin given in @var{origin} to @var{m}. "
 147            " @var{m} will typically be a music expression or a list"
 148            " of music.  List structures are searched recursively,"
 149            " but recursion stops at the changed music expressions"
 150            " themselves. "
 151            " @var{origin} is generally of type @code{ly:input-location?},"
 152            " defaulting to @code{(*location*)}.  Other valid values for"
 153            " @code{origin} are a music expression which is then used as"
 154            " the source of location information, or @code{#f}"
 155            " or @code{'()} in which case no action is performed. "
 156            " The return value is @var{m} itself.")
 157 {
 158   if (SCM_UNBNDP (origin))
 159     origin = scm_fluid_ref (Lily::f_location);
 160   else if (Music *mus = unsmob<Music> (origin))
 161     origin = mus->get_property ("origin");
 162
 163   if (scm_is_false (origin) || scm_is_null (origin))
 164     return m;
 165
 166   LY_ASSERT_SMOB (Input, origin, 2);
 167
 168   set_origin (m, origin);
 169   return m;
 170 }
 171
 172 LY_DEFINE (ly_music_transpose, "ly:music-transpose",
 173            2, 0, 0, (SCM m, SCM p),
 174            "Transpose @var{m} such that central@tie{}C is mapped"
 175            " to@tie{}@var{p}.  Return@tie{}@var{m}.")
 176 {
 177   LY_ASSERT_SMOB (Music, m, 1);
 178   LY_ASSERT_SMOB (Pitch, p, 2);
 179
 180   Music *sc = unsmob<Music> (m);
 181   Pitch *sp = unsmob<Pitch> (p);
 182
 183   sc->transpose (*sp);
 184   // SCM_UNDEFINED ?
 185   return sc->self_scm ();
 186 }
 187
 188 /*
 189   TODO: should take moment factor?
 190 */
 191 LY_DEFINE (ly_music_compress, "ly:music-compress",
 192            2, 0, 0, (SCM m, SCM factor),
 193            "Compress music object@tie{}@var{m} by moment @var{factor}.")
 194 {
 195   LY_ASSERT_SMOB (Music, m, 1);
 196   LY_ASSERT_SMOB (Moment, factor, 2);
 197
 198   Music *sc = unsmob<Music> (m);
 199   sc->compress (*unsmob<Moment> (factor));
 200   return sc->self_scm ();
 201 }
 202
 203 LY_DEFINE (ly_make_music_relative_x, "ly:make-music-relative!",
 204            2, 0, 0, (SCM music, SCM pitch),
 205            "Make @var{music} relative to @var{pitch},"
 206            " return final pitch.")
 207 {
 208   LY_ASSERT_SMOB (Music, music, 1);
 209   LY_ASSERT_SMOB (Pitch, pitch, 2);
 210
 211   Pitch start = *unsmob<Pitch> (pitch);
 212   Music *m = unsmob<Music> (music);
 213   Pitch last = m->to_relative_octave (start);
 214
 215   return last.smobbed_copy ();
 216 }
 217
 218 LY_DEFINE (ly_music_duration_length, "ly:music-duration-length", 1, 0, 0,
 219            (SCM mus),
 220            "Extract the duration field from @var{mus} and return the"
 221            " length.")
 222 {
 223   LY_ASSERT_SMOB (Music, mus, 1);
 224   Music *m = unsmob<Music> (mus);
 225
 226   Duration *d = unsmob<Duration> (m->get_property ("duration"));
 227   Moment len;
 228
 229   if (d)
 230     len = d->get_length ();
 231   else
 232     programming_error ("music has no duration");
 233   return len.smobbed_copy ();
 234 }
 235
 236 LY_DEFINE (ly_music_duration_compress, "ly:music-duration-compress", 2, 0, 0,
 237            (SCM mus, SCM fact),
 238            "Compress @var{mus} by factor @var{fact}, which is a"
 239            " @code{Moment}.")
 240 {
 241   LY_ASSERT_SMOB (Music, mus, 1);
 242   LY_ASSERT_SMOB (Moment, fact, 2);
 243
 244   Music *m = unsmob<Music> (mus);
 245   Moment *f = unsmob<Moment> (fact);
 246
 247   Duration *d = unsmob<Duration> (m->get_property ("duration"));
 248   if (d)
 249     m->set_property ("duration", d->compressed (f->main_part_).smobbed_copy ());
 250   return SCM_UNSPECIFIED;
 251 }
 252
 253 /*
 254   This is hairy, since the scale in a key-change event may contain
 255   octaveless notes.
 256
 257
 258   TODO: this should use ly:pitch.
 259 */
 260 LY_DEFINE (ly_transpose_key_alist, "ly:transpose-key-alist",
 261            2, 0, 0, (SCM l, SCM pit),
 262            "Make a new key alist of@tie{}@var{l} transposed by"
 263            " pitch @var{pit}.")
 264 {
 265   SCM newlist = SCM_EOL;
 266   Pitch *p = unsmob<Pitch> (pit);
 267
 268   for (SCM s = l; scm_is_pair (s); s = scm_cdr (s))
 269     {
 270       SCM key = scm_caar (s);
 271       SCM alter = scm_cdar (s);
 272       if (scm_is_pair (key))
 273         {
 274           Pitch orig (scm_to_int (scm_car (key)),
 275                       scm_to_int (scm_cdr (key)),
 276                       ly_scm2rational (alter));
 277
 278           orig = orig.transposed (*p);
 279
 280           SCM key = scm_cons (scm_from_int (orig.get_octave ()),
 281                               scm_from_int (orig.get_notename ()));
 282
 283           newlist = scm_cons (scm_cons (key, ly_rational2scm (orig.get_alteration ())),
 284                               newlist);
 285         }
 286       else if (scm_is_number (key))
 287         {
 288           Pitch orig (0, scm_to_int (key), ly_scm2rational (alter));
 289           orig = orig.transposed (*p);
 290
 291           key = scm_from_int (orig.get_notename ());
 292           alter = ly_rational2scm (orig.get_alteration ());
 293           newlist = scm_cons (scm_cons (key, alter), newlist);
 294         }
 295     }
 296   return scm_reverse_x (newlist, SCM_EOL);
 297 }