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 }
 175
 176 void
 177 Music::transpose (Pitch delta)
 178 {
 179   for (SCM s = this->get_property_alist (true); scm_is_pair (s); s = scm_cdr (s))
 180     {
 181       SCM entry = scm_car (s);
 182       SCM val = scm_cdr (entry);
 183
 184       if (Pitch * p = unsmob_pitch (val))
 185         {
 186           Pitch transposed =  p->transposed (delta);
 187           scm_set_cdr_x (entry, transposed.smobbed_copy ());
 188
 189           if (abs (transposed.get_alteration ()) > DOUBLE_SHARP)
 190             {
 191               warning (_f ("Transposition by %s makes alteration larger than two",
 192                            delta.to_string ()));
 193             }
 194         }
 195     }
 196
 197   SCM elt = get_property ("element");
 198
 199   if (Music* m = unsmob_music (elt))
 200     m->transpose (delta);
 201
 202   transpose_music_list (get_property ("elements"), delta);
 203 }
 204
 205 IMPLEMENT_TYPE_P (Music, "ly:music?");
 206 IMPLEMENT_SMOBS (Music);
 207 IMPLEMENT_DEFAULT_EQUAL_P (Music);
 208
 209 SCM
 210 Music::internal_get_property (SCM sym) const
 211 {
 212   SCM s = scm_sloppy_assq (sym, mutable_property_alist_);
 213   if (s != SCM_BOOL_F)
 214     return scm_cdr (s);
 215
 216   s = scm_sloppy_assq (sym, immutable_property_alist_);
 217   return (s == SCM_BOOL_F) ? SCM_EOL : scm_cdr (s);
 218 }
 219
 220 void
 221 Music::internal_set_property (SCM s, SCM v)
 222 {
 223   if (do_internal_type_checking_global)
 224     if (!type_check_assignment (s, v, ly_symbol2scm ("music-type?")))
 225       abort ();
 226
 227   mutable_property_alist_ = scm_assq_set_x (mutable_property_alist_, s, v);
 228 }
 229
 230 void
 231 Music::set_spot (Input ip)
 232 {
 233   set_property ("origin", make_input (ip));
 234 }
 235
 236 Input*
 237 Music::origin () const
 238 {
 239   Input *ip = unsmob_input (get_property ("origin"));
 240   return ip ? ip : & dummy_input_global;
 241 }
 242
 243 int
 244 Music::duration_log () const
 245 {
 246   if (is_mus_type ("rhythmic-event"))
 247     return unsmob_duration (get_property ("duration"))->duration_log ();
 248   return 0;
 249 }
 250
 251 Music*
 252 make_music_by_name (SCM sym)
 253 {
 254   SCM make_music_proc = ly_lily_module_constant ("make-music");
 255   SCM rv = scm_call_1 (make_music_proc, sym);
 256
 257   /* UGH. */
 258   scm_gc_protect_object (rv);
 259   return unsmob_music (rv);
 260 }