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