lily/music.cc

   1 /*
   2   music.cc -- implement Music
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c)  1997--2002 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7 */
   8
   9 #include "main.hh"
  10 #include "input-smob.hh"
  11 #include "music.hh"
  12 #include "music-list.hh"
  13 #include "warn.hh"
  14 #include "pitch.hh"
  15 #include "ly-smobs.icc"
  16
  17 SCM
  18 ly_deep_mus_copy (SCM m)
  19 {
  20   if (unsmob_music (m))
  21     {
  22       SCM ss =  unsmob_music (m)->clone ()->self_scm ();
  23       scm_gc_unprotect_object (ss);
  24       return ss;
  25     }
  26   else if (gh_pair_p (m))
  27     {
  28       return gh_cons (ly_deep_mus_copy (ly_car (m)), ly_deep_mus_copy (ly_cdr (m)));
  29     }
  30   else
  31     return m;
  32 }
  33
  34
  35 Music::Music ()
  36 {
  37   immutable_property_alist_ = SCM_EOL;
  38   mutable_property_alist_ = SCM_EOL;
  39   smobify_self ();
  40 }
  41
  42 Music::Music (Music const &m)
  43 {
  44   immutable_property_alist_ = m.immutable_property_alist_;
  45   mutable_property_alist_ = SCM_EOL;
  46
  47   /*
  48     First we smobify_self, then we copy over the stuff.  If we don't,
  49     stack vars that hold the copy might be optimized away, meaning
  50     that they won't be protected from GC.
  51    */
  52   smobify_self ();
  53   mutable_property_alist_ = ly_deep_mus_copy (m.mutable_property_alist_);
  54   set_spot (*m.origin ());
  55 }
  56
  57
  58 Music::Music (SCM l)
  59 {
  60   immutable_property_alist_ = l;
  61   mutable_property_alist_ = SCM_EOL;
  62   smobify_self ();
  63 }
  64
  65
  66 SCM
  67 Music::mark_smob (SCM m)
  68 {
  69   Music * mus = (Music *)SCM_CELL_WORD_1 (m);
  70   scm_gc_mark (mus->immutable_property_alist_);
  71   scm_gc_mark (mus->mutable_property_alist_);
  72   return SCM_EOL;
  73 }
  74
  75 void
  76 Music::compress (Moment)
  77 {
  78 }
  79
  80
  81
  82 Moment
  83 Music::length_mom () const
  84 {
  85   SCM l = get_mus_property ("length");
  86   if (unsmob_moment (l))
  87     return *unsmob_moment (l);
  88   else if (gh_procedure_p (l))
  89     {
  90       SCM res = gh_call1 (l, self_scm ());
  91       return *unsmob_moment (res);
  92     }
  93
  94   return 0;
  95 }
  96
  97 Moment
  98 Music::start_mom () const
  99 {
 100   SCM l = get_mus_property ("start-moment-function");
 101   if (gh_procedure_p (l))
 102     {
 103       SCM res = gh_call1 (l, self_scm ());
 104       return *unsmob_moment (res);
 105     }
 106
 107   Moment m ;
 108   return m;
 109 }
 110
 111 void
 112 print_alist (SCM a, SCM port)
 113 {
 114   /*
 115     SCM_EOL  -> catch malformed lists.
 116   */
 117   for (SCM s = a; s != SCM_EOL; s = ly_cdr (s))
 118     {
 119       scm_display (ly_caar (s), port);
 120       scm_puts (" = ", port);
 121       scm_write (ly_cdar (s), port);
 122       scm_puts ("\n", port);
 123     }
 124 }
 125
 126 int
 127 Music::print_smob (SCM s, SCM p, scm_print_state*)
 128 {
 129   scm_puts ("#<Music ", p);
 130   Music* m = unsmob_music (s);
 131   scm_puts (classname (m),p);
 132
 133   print_alist (m->mutable_property_alist_, p);
 134   print_alist (m->immutable_property_alist_, p);
 135
 136   scm_puts (">",p);
 137   return 1;
 138 }
 139
 140 Pitch
 141 Music::to_relative_octave (Pitch m)
 142 {
 143   return m;
 144 }
 145
 146
 147 void
 148 Music::transpose (Pitch delta)
 149 {
 150   Pitch *p = unsmob_pitch (get_mus_property ("pitch"));
 151   if (!p)
 152     return ;
 153
 154   Pitch np = *p;
 155   np.transpose (delta);
 156
 157   if (abs (np.alteration_) > 2)
 158     {
 159         warning (_f ("Transposition by %s makes accidental larger than two",
 160           delta.string ()));
 161     }
 162
 163   set_mus_property ("pitch", np.smobbed_copy ());
 164 }
 165
 166 IMPLEMENT_TYPE_P (Music, "music?");
 167
 168 IMPLEMENT_SMOBS (Music);
 169 IMPLEMENT_DEFAULT_EQUAL_P (Music);
 170
 171 /****************************/
 172
 173 SCM
 174 Music::internal_get_mus_property (SCM sym) const
 175 {
 176   SCM s = scm_sloppy_assq (sym, mutable_property_alist_);
 177   if (s != SCM_BOOL_F)
 178     return ly_cdr (s);
 179
 180   s = scm_sloppy_assq (sym, immutable_property_alist_);
 181   return (s == SCM_BOOL_F) ? SCM_EOL : ly_cdr (s);
 182 }
 183
 184 void
 185 Music::internal_set_mus_property (SCM s, SCM v)
 186 {
 187   if (internal_type_checking_global_b)
 188     if (!type_check_assignment (s, v, ly_symbol2scm ("music-type?")))
 189       abort ();
 190
 191   mutable_property_alist_ =  scm_assq_set_x (mutable_property_alist_, s, v);
 192 }
 193
 194
 195
 196 #include "main.hh"
 197
 198 void
 199 Music::set_spot (Input ip)
 200 {
 201   set_mus_property ("origin", make_input (ip));
 202 }
 203
 204 Input*
 205 Music::origin () const
 206 {
 207   Input *ip = unsmob_input (get_mus_property ("origin"));
 208   return ip ? ip : & dummy_input_global;
 209 }
 210
 211
 212 Music::~Music ()
 213 {
 214
 215 }
 216
 217 LY_DEFINE(ly_get_mus_property,
 218           "ly-get-mus-property", 2, 0, 0,  (SCM mus, SCM sym),
 219           "Get the property @var{sym} of music expression @var{mus}.")
 220 {
 221   Music * sc = unsmob_music (mus);
 222   SCM_ASSERT_TYPE(sc, mus, SCM_ARG1, __FUNCTION__, "music");
 223   SCM_ASSERT_TYPE(gh_symbol_p (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
 224
 225   return sc->internal_get_mus_property (sym);
 226 }
 227
 228 LY_DEFINE(ly_set_mus_property,
 229           "ly-set-mus-property!", 3, 0, 0,
 230           (SCM mus, SCM sym, SCM val),
 231           "Set property @var{sym} in music expression @var{mus} to @var{val}.")
 232 {
 233   Music * sc = unsmob_music (mus);
 234   SCM_ASSERT_TYPE(sc, mus, SCM_ARG1, __FUNCTION__, "music");
 235   SCM_ASSERT_TYPE(gh_symbol_p (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
 236
 237   bool ok = type_check_assignment (sym, val, ly_symbol2scm ("music-type?"));
 238   if (ok)
 239     {
 240       sc->internal_set_mus_property (sym, val);
 241     }
 242
 243   return SCM_UNSPECIFIED;
 244 }
 245
 246
 247 // to do  property args
 248 LY_DEFINE(ly_make_music,
 249           "ly-make-music", 1, 0, 0,  (SCM type),
 250           "
 251 Make a music object/expression of type @var{name}. Warning: this
 252 interface will likely change in the near future.
 253
 254
 255
 256 Music is the data type that music expressions are stored in. The data
 257 type does not yet offer many manipulations.
 258 ")
 259 {
 260   SCM_ASSERT_TYPE(gh_string_p (type), type, SCM_ARG1, __FUNCTION__, "string");
 261
 262   SCM s = make_music (ly_scm2string (type))->self_scm ();
 263   scm_gc_unprotect_object (s);
 264
 265   return s;
 266 }
 267
 268 LY_DEFINE(ly_music_name, "ly-music-name", 1, 0, 0,
 269   (SCM mus),
 270   "Return the name of @var{music}.")
 271 {
 272   Music * m = unsmob_music (mus);
 273   SCM_ASSERT_TYPE(m, mus, SCM_ARG1, __FUNCTION__ ,"music");
 274
 275   const char * nm = classname (m);
 276   return scm_makfrom0str (nm);
 277 }
 278
 279 LY_DEFINE(ly_music_list_p,"music-list?", 1, 0, 0,
 280   (SCM l),"Type predicate: return true if @var{l} is a list of music objects.")
 281 {
 282   if (scm_list_p (l) != SCM_BOOL_T)
 283     return SCM_BOOL_F;
 284
 285   while (gh_pair_p (l))
 286     {
 287       if (!unsmob_music (gh_car (l)))
 288         return SCM_BOOL_F;
 289       l =gh_cdr (l);
 290     }
 291   return SCM_BOOL_T;
 292 }
 293 ADD_MUSIC(Music);
 294