lily/music.cc

   1 /*
   2   music.cc -- implement Music
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 1997--2006 Han-Wen Nienhuys <hanwen@xs4all.nl>
   7 */
   8
   9 #include "music.hh"
  10
  11 #include "context.hh"
  12 #include "dispatcher.hh"
  13 #include "duration.hh"
  14 #include "input.hh"
  15 #include "international.hh"
  16 #include "ly-smobs.icc"
  17 #include "main.hh"
  18 #include "music-sequence.hh"
  19 #include "score.hh"
  20 #include "warn.hh"
  21
  22 /*
  23   Music is anything that has (possibly zero) duration and supports
  24   both time compression and transposition.
  25
  26   In Lily, everything that can be thought to have a length and a pitch
  27   (which has a duration which can be transposed) is considered "music".
  28 */
  29 bool
  30 Music::internal_is_music_type (SCM k) const
  31 {
  32   SCM ifs = get_property ("types");
  33
  34   return scm_c_memq (k, ifs) != SCM_BOOL_F;
  35 }
  36
  37 Music::Music (SCM init)
  38   : Prob (ly_symbol2scm ("Music"), init)
  39 {
  40   length_callback_ = SCM_EOL;
  41   start_callback_ = SCM_EOL;
  42
  43   length_callback_ = get_property ("length-callback");
  44   if (!ly_is_procedure (length_callback_))
  45     length_callback_ = duration_length_callback_proc;
  46
  47   start_callback_ = get_property ("start-callback");
  48 }
  49
  50 void
  51 Music::derived_mark () const
  52 {
  53   scm_gc_mark (length_callback_);
  54   scm_gc_mark (start_callback_);
  55 }
  56
  57 SCM
  58 Music::copy_mutable_properties () const
  59 {
  60   return ly_music_deep_copy (mutable_property_alist_);
  61 }
  62
  63 void
  64 Music::type_check_assignment (SCM s, SCM v) const
  65 {
  66   if (!::type_check_assignment (s, v, ly_symbol2scm ("music-type?")))
  67     abort ();
  68 }
  69
  70 Music::Music (Music const &m)
  71   : Prob (m)
  72 {
  73   length_callback_ = m.length_callback_;
  74   start_callback_ = m.start_callback_;
  75
  76   /// why?
  77   set_spot (*m.origin ());
  78 }
  79
  80 Moment
  81 Music::get_length () const
  82 {
  83   SCM lst = get_property ("length");
  84   if (unsmob_moment (lst))
  85     return *unsmob_moment (lst);
  86
  87   if (ly_is_procedure (length_callback_))
  88     {
  89       SCM res = scm_call_1 (length_callback_, self_scm ());
  90       return *unsmob_moment (res);
  91     }
  92
  93   return Moment (0);
  94 }
  95
  96 Moment
  97 Music::start_mom () const
  98 {
  99   SCM lst = start_callback_;
 100   if (ly_is_procedure (lst))
 101     {
 102       SCM res = scm_call_1 (lst, self_scm ());
 103       return *unsmob_moment (res);
 104     }
 105
 106   Moment m;
 107   return m;
 108 }
 109
 110 void
 111 print_alist (SCM a, SCM port)
 112 {
 113   /* SCM_EOL  -> catch malformed lists.  */
 114   for (SCM s = a; scm_is_pair (s); s = scm_cdr (s))
 115     {
 116       scm_display (scm_caar (s), port);
 117       scm_puts (" = ", port);
 118       scm_write (scm_cdar (s), port);
 119       scm_puts ("\n", port);
 120     }
 121 }
 122
 123
 124 Pitch
 125 Music::generic_to_relative_octave (Pitch last)
 126 {
 127   SCM elt = get_property ("element");
 128   Pitch *old_pit = unsmob_pitch (get_property ("pitch"));
 129   if (old_pit)
 130     {
 131       Pitch new_pit = *old_pit;
 132       new_pit = new_pit.to_relative_octave (last);
 133
 134       SCM check = get_property ("absolute-octave");
 135       if (scm_is_number (check)
 136           && new_pit.get_octave () != scm_to_int (check))
 137         {
 138           Pitch expected_pit (scm_to_int (check),
 139                               new_pit.get_notename (),
 140                               new_pit.get_alteration ());
 141           origin ()->warning (_f ("octave check failed; expected \"%s\", found: %s",
 142                                   expected_pit.to_string (),
 143                                   new_pit.to_string ()));
 144           new_pit = expected_pit;
 145         }
 146
 147       set_property ("pitch", new_pit.smobbed_copy ());
 148
 149       last = new_pit;
 150     }
 151
 152   if (Music *m = unsmob_music (elt))
 153     last = m->to_relative_octave (last);
 154
 155   last = music_list_to_relative (get_property ("elements"), last, false);
 156   return last;
 157 }
 158
 159 Pitch
 160 Music::to_relative_octave (Pitch last)
 161 {
 162   SCM callback = get_property ("to-relative-callback");
 163   if (ly_is_procedure (callback))
 164     {
 165       Pitch *p = unsmob_pitch (scm_call_2 (callback, self_scm (), last.smobbed_copy ()));
 166       return *p;
 167     }
 168
 169   return generic_to_relative_octave (last);
 170 }
 171
 172 void
 173 Music::compress (Moment factor)
 174 {
 175   SCM elt = get_property ("element");
 176
 177   if (Music *m = unsmob_music (elt))
 178     m->compress (factor);
 179
 180   compress_music_list (get_property ("elements"), factor);
 181   Duration *d = unsmob_duration (get_property ("duration"));
 182   if (d)
 183     set_property ("duration", d->compressed (factor.main_part_).smobbed_copy ());
 184 }
 185
 186 /*
 187 TODO: make transposition non-destructive
 188 */
 189 SCM
 190 transpose_mutable (SCM alist, Pitch delta)
 191 {
 192   SCM retval = SCM_EOL;
 193
 194   for (SCM s = alist; scm_is_pair (s); s = scm_cdr (s))
 195     {
 196       SCM entry = scm_car (s);
 197       SCM prop = scm_car (entry);
 198       SCM val = scm_cdr (entry);
 199
 200       if (Pitch *p = unsmob_pitch (val))
 201         {
 202           Pitch transposed = p->transposed (delta);
 203           scm_set_cdr_x (entry, transposed.smobbed_copy ());
 204
 205           if (abs (transposed.get_alteration ()) > DOUBLE_SHARP)
 206             {
 207               warning (_f ("transposition by %s makes alteration larger than double",
 208                            delta.to_string ()));
 209             }
 210         }
 211       else if (prop == ly_symbol2scm ("element"))
 212         {
 213           if (Music *m = unsmob_music (val))
 214             m->transpose (delta);
 215         }
 216       else if (prop == ly_symbol2scm ("elements"))
 217         transpose_music_list (val, delta);
 218       else if (prop == ly_symbol2scm ("pitch-alist") &&
 219                scm_is_pair (val))
 220         entry = scm_cons (prop, ly_transpose_key_alist (val, delta.smobbed_copy ()));
 221       retval = scm_cons (entry, retval);
 222     }
 223
 224   return scm_reverse_x (retval, SCM_EOL);
 225 }
 226
 227 void
 228 Music::transpose (Pitch delta)
 229 {
 230   if (to_boolean (get_property ("untransposable")))
 231     return;
 232
 233   mutable_property_alist_ = transpose_mutable (mutable_property_alist_, delta);
 234 }
 235
 236 void
 237 Music::set_spot (Input ip)
 238 {
 239   set_property ("origin", make_input (ip));
 240 }
 241
 242 Input *
 243 Music::origin () const
 244 {
 245   Input *ip = unsmob_input (get_property ("origin"));
 246   return ip ? ip : &dummy_input_global;
 247 }
 248
 249 /*
 250   ES TODO: This method should probably be reworked or junked.
 251 */
 252 Stream_event *
 253 Music::to_event () const
 254 {
 255   SCM class_name = ly_camel_case_to_lisp_identifier (get_property ("name"));
 256
 257   // catch programming mistakes.
 258   if (!internal_is_music_type (class_name))
 259     {
 260       programming_error ("Not a music type");
 261     }
 262
 263   Stream_event *e = new Stream_event (class_name, mutable_property_alist_);
 264   Moment length = get_length ();
 265   if (length.to_bool ())
 266     e->set_property ("length", length.smobbed_copy ());
 267
 268   // articulations as events.
 269   SCM art_mus = e->get_property ("articulations");
 270   if (scm_is_pair (art_mus))
 271     {
 272       SCM art_ev = SCM_EOL;
 273       for (; scm_is_pair (art_mus); art_mus = scm_cdr (art_mus))
 274         {
 275           Music *m = unsmob_music (scm_car (art_mus));
 276           SCM ev = m ? m->to_event ()->unprotect () : scm_car (art_mus);
 277           art_ev = scm_cons (ev, art_ev);
 278         }
 279       e->set_property ("articulations", scm_reverse_x (art_ev, SCM_EOL));
 280     }
 281
 282   /*
 283     ES TODO: This is a temporary fix. Stream_events should not be
 284     aware of music.
 285   */
 286   e->set_property ("music-cause", self_scm ());
 287
 288   return e;
 289 }
 290
 291 void
 292 Music::send_to_context (Context *c)
 293 {
 294   Stream_event *ev = to_event ();
 295   c->event_source ()->broadcast (ev);
 296   ev->unprotect ();
 297 }
 298
 299 Music *
 300 make_music_by_name (SCM sym)
 301 {
 302   SCM make_music_proc = ly_lily_module_constant ("make-music");
 303   SCM rv = scm_call_1 (make_music_proc, sym);
 304
 305   /* UGH. */
 306   Music *m = unsmob_music (rv);
 307   m->protect ();
 308   return m;
 309 }
 310
 311 MAKE_SCHEME_CALLBACK (Music, duration_length_callback, 1);
 312 SCM
 313 Music::duration_length_callback (SCM m)
 314 {
 315   Music *me = unsmob_music (m);
 316   Duration *d = unsmob_duration (me->get_property ("duration"));
 317
 318   Moment mom;
 319   if (d)
 320     mom = d->get_length ();
 321   return mom.smobbed_copy ();
 322 }
 323
 324 Music *
 325 unsmob_music (SCM m)
 326 {
 327   return dynamic_cast<Music*> (unsmob_prob (m));
 328 }
 329