lily/music.cc

   1 /*
   2   music.cc -- implement Music
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 1997--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7 */
   8
   9 #include "music.hh"
  10
  11 #include "duration.hh"
  12 #include "input-smob.hh"
  13 #include "ly-smobs.icc"
  14 #include "main.hh"
  15 #include "music-list.hh"
  16 #include "pitch.hh"
  17 #include "score.hh"
  18 #include "warn.hh"
  19
  20 bool
  21 Music::internal_is_music_type (SCM k) const
  22 {
  23   SCM ifs = get_property ("types");
  24
  25   return scm_c_memq (k, ifs) != SCM_BOOL_F;
  26 }
  27
  28 String
  29 Music::name () const
  30 {
  31   SCM nm = get_property ("name");
  32   if (scm_is_symbol (nm))
  33     {
  34       return ly_symbol2string (nm);
  35     }
  36   else
  37     {
  38       return classname (this);
  39     }
  40 }
  41
  42 Music::Music (SCM init)
  43 {
  44   self_scm_ = SCM_EOL;
  45   immutable_property_alist_ = init;
  46   mutable_property_alist_ = SCM_EOL;
  47   smobify_self ();
  48
  49   length_callback_ = get_property ("length-callback");
  50   start_callback_ = get_property ("start-callback");
  51 }
  52
  53 Music::Music (Music const &m)
  54 {
  55   immutable_property_alist_ = m.immutable_property_alist_;
  56   mutable_property_alist_ = SCM_EOL;
  57   self_scm_ = SCM_EOL;
  58
  59   /* First we smobify_self, then we copy over the stuff.  If we don't,
  60      stack vars that hold the copy might be optimized away, meaning
  61      that they won't be protected from GC. */
  62   smobify_self ();
  63   mutable_property_alist_ = ly_music_deep_copy (m.mutable_property_alist_);
  64   length_callback_ = m.length_callback_;
  65   start_callback_ = m.start_callback_;
  66   set_spot (*m.origin ());
  67 }
  68
  69 Music::~Music ()
  70 {
  71 }
  72
  73 ADD_MUSIC (Music);
  74
  75 SCM
  76 Music::get_property_alist (bool m) const
  77 {
  78   return (m) ? mutable_property_alist_ : immutable_property_alist_;
  79 }
  80
  81 SCM
  82 Music::mark_smob (SCM m)
  83 {
  84   Music *mus = (Music*) SCM_CELL_WORD_1 (m);
  85   scm_gc_mark (mus->immutable_property_alist_);
  86   scm_gc_mark (mus->mutable_property_alist_);
  87   return SCM_EOL;
  88 }
  89
  90 Moment
  91 Music::get_length () const
  92 {
  93   SCM lst = get_property ("length");
  94   if (unsmob_moment (lst))
  95     return *unsmob_moment (lst);
  96
  97   if (ly_c_procedure_p (length_callback_))
  98     {
  99       SCM res = scm_call_1 (length_callback_, self_scm ());
 100       return *unsmob_moment (res);
 101     }
 102
 103   return Moment(0);
 104 }
 105
 106 Moment
 107 Music::start_mom () const
 108 {
 109   SCM lst = get_property ("start-callback");
 110   if (ly_c_procedure_p (lst))
 111     {
 112       SCM res = scm_call_1 (lst, self_scm ());
 113       return *unsmob_moment (res);
 114     }
 115
 116   Moment m;
 117   return m;
 118 }
 119
 120 void
 121 print_alist (SCM a, SCM port)
 122 {
 123   /* SCM_EOL  -> catch malformed lists.  */
 124   for (SCM s = a; scm_is_pair (s); s = scm_cdr (s))
 125     {
 126       scm_display (scm_caar (s), port);
 127       scm_puts (" = ", port);
 128       scm_write (scm_cdar (s), port);
 129       scm_puts ("\n", port);
 130     }
 131 }
 132
 133 int
 134 Music::print_smob (SCM s, SCM p, scm_print_state*)
 135 {
 136   scm_puts ("#<Music ", p);
 137   Music* m = unsmob_music (s);
 138
 139   SCM nm = m->get_property ("name");
 140   if (scm_is_symbol (nm) || scm_is_string (nm))
 141     scm_display (nm, p);
 142   else
 143     scm_puts (classname (m),p);
 144
 145   /* Printing properties takes a lot of time, especially during backtraces.
 146      For inspecting, it is better to explicitly use an inspection
 147      function.  */
 148
 149   scm_puts (">",p);
 150   return 1;
 151 }
 152
 153 Pitch
 154 Music::to_relative_octave (Pitch p)
 155 {
 156   SCM elt = get_property ("element");
 157
 158   if (Music *m = unsmob_music (elt))
 159     p = m->to_relative_octave (p);
 160
 161   p = music_list_to_relative (get_property ("elements"), p, false);
 162   return p;
 163 }
 164
 165 void
 166 Music::compress (Moment factor)
 167 {
 168   SCM elt = get_property ("element");
 169
 170   if (Music *m = unsmob_music (elt))
 171     m->compress (factor);
 172
 173   compress_music_list (get_property ("elements"), factor);
 174   Duration *d =  unsmob_duration (get_property ("duration"));
 175   if (d)
 176     set_property ("duration", d ->compressed (m.main_part_).smobbed_copy ());
 177 }
 178
 179 void
 180 Music::transpose (Pitch delta)
 181 {
 182   for (SCM s = this->get_property_alist (true); scm_is_pair (s); s = scm_cdr (s))
 183     {
 184       SCM entry = scm_car (s);
 185       SCM val = scm_cdr (entry);
 186
 187       if (Pitch * p = unsmob_pitch (val))
 188         {
 189           Pitch transposed =  p->transposed (delta);
 190           scm_set_cdr_x (entry, transposed.smobbed_copy ());
 191
 192           if (abs (transposed.get_alteration ()) > DOUBLE_SHARP)
 193             {
 194               warning (_f ("Transposition by %s makes alteration larger than two",
 195                            delta.to_string ()));
 196             }
 197         }
 198     }
 199
 200   SCM elt = get_property ("element");
 201
 202   if (Music* m = unsmob_music (elt))
 203     m->transpose (delta);
 204
 205   transpose_music_list (get_property ("elements"), delta);
 206 }
 207
 208 IMPLEMENT_TYPE_P (Music, "ly:music?");
 209 IMPLEMENT_SMOBS (Music);
 210 IMPLEMENT_DEFAULT_EQUAL_P (Music);
 211
 212 SCM
 213 Music::internal_get_property (SCM sym) const
 214 {
 215   SCM s = scm_sloppy_assq (sym, mutable_property_alist_);
 216   if (s != SCM_BOOL_F)
 217     return scm_cdr (s);
 218
 219   s = scm_sloppy_assq (sym, immutable_property_alist_);
 220   return (s == SCM_BOOL_F) ? SCM_EOL : scm_cdr (s);
 221 }
 222
 223 void
 224 Music::internal_set_property (SCM s, SCM v)
 225 {
 226   if (do_internal_type_checking_global)
 227     if (!type_check_assignment (s, v, ly_symbol2scm ("music-type?")))
 228       abort ();
 229
 230   mutable_property_alist_ = scm_assq_set_x (mutable_property_alist_, s, v);
 231 }
 232
 233 void
 234 Music::set_spot (Input ip)
 235 {
 236   set_property ("origin", make_input (ip));
 237 }
 238
 239 Input*
 240 Music::origin () const
 241 {
 242   Input *ip = unsmob_input (get_property ("origin"));
 243   return ip ? ip : & dummy_input_global;
 244 }
 245
 246 int
 247 Music::duration_log () const
 248 {
 249   if (is_mus_type ("rhythmic-event"))
 250     return unsmob_duration (get_property ("duration"))->duration_log ();
 251   return 0;
 252 }
 253
 254 Music*
 255 make_music_by_name (SCM sym)
 256 {
 257   SCM make_music_proc = ly_lily_module_constant ("make-music");
 258   SCM rv = scm_call_1 (make_music_proc, sym);
 259
 260   /* UGH. */
 261   scm_gc_protect_object (rv);
 262   return unsmob_music (rv);
 263 }