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 bool
  35 Music::internal_is_music_type (SCM k)const
  36 {
  37   SCM ifs = get_mus_property ("types");
  38
  39   return scm_memq (k, ifs) != SCM_BOOL_F;
  40 }
  41
  42 String
  43 Music::name ()const
  44 {
  45   SCM nm = get_mus_property ("name");
  46   if (gh_string_p (nm))
  47     {
  48       return ly_scm2string (nm);
  49     }
  50   else
  51     {
  52       return classname (this);
  53     }
  54 }
  55
  56 void
  57 Music::transpose (Pitch)
  58 {
  59 }
  60
  61 void
  62 Music::compress (Moment)
  63 {
  64 }
  65
  66
  67 Music::Music (Music const &m)
  68 {
  69   immutable_property_alist_ = m.immutable_property_alist_;
  70   mutable_property_alist_ = SCM_EOL;
  71   self_scm_ = SCM_EOL;
  72
  73   /*
  74     First we smobify_self, then we copy over the stuff.  If we don't,
  75     stack vars that hold the copy might be optimized away, meaning
  76     that they won't be protected from GC.
  77    */
  78   smobify_self ();
  79   mutable_property_alist_ = ly_deep_mus_copy (m.mutable_property_alist_);
  80   set_spot (*m.origin ());
  81 }
  82
  83 Music::Music ()
  84 {
  85   self_scm_ = SCM_EOL;
  86   immutable_property_alist_ = SCM_EOL;
  87   mutable_property_alist_ = SCM_EOL;
  88   smobify_self ();
  89 }
  90
  91 SCM
  92 Music::get_property_alist (bool m) const
  93 {
  94   return (m) ? mutable_property_alist_ : immutable_property_alist_;
  95 }
  96
  97 SCM
  98 Music::mark_smob (SCM m)
  99 {
 100   Music * mus = (Music *)SCM_CELL_WORD_1 (m);
 101   scm_gc_mark (mus->immutable_property_alist_);
 102   scm_gc_mark (mus->mutable_property_alist_);
 103   return SCM_EOL;
 104 }
 105
 106 Moment
 107 Music::get_length () const
 108 {
 109   SCM l = get_mus_property ("length");
 110   if (unsmob_moment (l))
 111     return *unsmob_moment (l);
 112   else if (gh_procedure_p (l))
 113     {
 114       SCM res = gh_call1 (l, self_scm ());
 115       return *unsmob_moment (res);
 116     }
 117
 118   return 0;
 119 }
 120
 121 Moment
 122 Music::start_mom () const
 123 {
 124   SCM l = get_mus_property ("start-moment-function");
 125   if (gh_procedure_p (l))
 126     {
 127       SCM res = gh_call1 (l, self_scm ());
 128       return *unsmob_moment (res);
 129     }
 130
 131   Moment m ;
 132   return m;
 133 }
 134
 135 void
 136 print_alist (SCM a, SCM port)
 137 {
 138   /*
 139     SCM_EOL  -> catch malformed lists.
 140   */
 141   for (SCM s = a; gh_pair_p (s); s = ly_cdr (s))
 142     {
 143       scm_display (ly_caar (s), port);
 144       scm_puts (" = ", port);
 145       scm_write (ly_cdar (s), port);
 146       scm_puts ("\n", port);
 147     }
 148 }
 149
 150 int
 151 Music::print_smob (SCM s, SCM p, scm_print_state*)
 152 {
 153   scm_puts ("#<Music ", p);
 154   Music* m = unsmob_music (s);
 155   scm_puts (classname (m),p);
 156
 157   print_alist (m->mutable_property_alist_, p);
 158   print_alist (m->immutable_property_alist_, p);
 159
 160   scm_puts (">",p);
 161   return 1;
 162 }
 163
 164 Pitch
 165 Music::to_relative_octave (Pitch m)
 166 {
 167   return m;
 168 }
 169
 170
 171 IMPLEMENT_TYPE_P (Music, "music?");
 172
 173 IMPLEMENT_SMOBS (Music);
 174 IMPLEMENT_DEFAULT_EQUAL_P (Music);
 175
 176 /****************************/
 177
 178 SCM
 179 Music::internal_get_mus_property (SCM sym) const
 180 {
 181   SCM s = scm_sloppy_assq (sym, mutable_property_alist_);
 182   if (s != SCM_BOOL_F)
 183     return ly_cdr (s);
 184
 185   s = scm_sloppy_assq (sym, immutable_property_alist_);
 186   return (s == SCM_BOOL_F) ? SCM_EOL : ly_cdr (s);
 187 }
 188
 189 void
 190 Music::internal_set_mus_property (SCM s, SCM v)
 191 {
 192   if (internal_type_checking_global_b)
 193     if (!type_check_assignment (s, v, ly_symbol2scm ("music-type?")))
 194       abort ();
 195
 196   mutable_property_alist_ =  scm_assq_set_x (mutable_property_alist_, s, v);
 197 }
 198
 199
 200
 201 #include "main.hh"
 202
 203 void
 204 Music::set_spot (Input ip)
 205 {
 206   set_mus_property ("origin", make_input (ip));
 207 }
 208
 209 Input*
 210 Music::origin () const
 211 {
 212   Input *ip = unsmob_input (get_mus_property ("origin"));
 213   return ip ? ip : & dummy_input_global;
 214 }
 215
 216
 217 Music::~Music ()
 218 {
 219
 220 }
 221
 222 LY_DEFINE(ly_get_mus_property,
 223           "ly-get-mus-property", 2, 0, 0,  (SCM mus, SCM sym),
 224           "Get the property @var{sym} of music expression @var{mus}.")
 225 {
 226   Music * sc = unsmob_music (mus);
 227   SCM_ASSERT_TYPE(sc, mus, SCM_ARG1, __FUNCTION__, "music");
 228   SCM_ASSERT_TYPE(gh_symbol_p (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
 229
 230   return sc->internal_get_mus_property (sym);
 231 }
 232
 233 LY_DEFINE(ly_set_mus_property,
 234           "ly-set-mus-property!", 3, 0, 0,
 235           (SCM mus, SCM sym, SCM val),
 236           "Set property @var{sym} in music expression @var{mus} to @var{val}.")
 237 {
 238   Music * sc = unsmob_music (mus);
 239   SCM_ASSERT_TYPE(sc, mus, SCM_ARG1, __FUNCTION__, "music");
 240   SCM_ASSERT_TYPE(gh_symbol_p (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
 241
 242   bool ok = type_check_assignment (sym, val, ly_symbol2scm ("music-type?"));
 243   if (ok)
 244     {
 245       sc->internal_set_mus_property (sym, val);
 246     }
 247
 248   return SCM_UNSPECIFIED;
 249 }
 250
 251
 252 LY_DEFINE(ly_music_name, "ly-music-name", 1, 0, 0,
 253   (SCM mus),
 254   "Return the name of @var{music}.")
 255 {
 256   Music * m = unsmob_music (mus);
 257   SCM_ASSERT_TYPE(m, mus, SCM_ARG1, __FUNCTION__ ,"music");
 258
 259   const char * nm = classname (m);
 260   return scm_makfrom0str (nm);
 261 }
 262
 263
 264
 265 // to do  property args
 266 LY_DEFINE(ly_extended_make_music,
 267           "ly-make-bare-music", 2, 0, 0,  (SCM type, SCM props),
 268           "
 269 Make a music object/expression of type @var{type}, init with
 270 @var{props}. Warning: this interface will likely change in the near
 271 future.
 272
 273 Music is the data type that music expressions are stored in. The data
 274 type does not yet offer many manipulations.
 275
 276 WARNING: deprecated; use make-music-by-name.
 277 ")
 278 {
 279   SCM_ASSERT_TYPE(gh_string_p (type), type, SCM_ARG1, __FUNCTION__, "string");
 280
 281   SCM s = make_music (ly_scm2string (type))->self_scm ();
 282   unsmob_music (s)->immutable_property_alist_ = props;
 283   scm_gc_unprotect_object (s);
 284   return s;
 285 }
 286
 287 // to do  property args
 288 LY_DEFINE(ly_get_mutable_properties,
 289           "ly-get-mutable-properties", 1, 0, 0,  (SCM mus),
 290           "
 291 Return an alist signifying the mutable properties of @var{mus}.
 292 The immutable properties are not available; they should be initialized
 293 by the functions make-music-by-name function.
 294   ")
 295 {
 296   Music *m = unsmob_music (mus);
 297   SCM_ASSERT_TYPE(m, mus, SCM_ARG1, __FUNCTION__, "music");
 298
 299   return m->get_property_alist (true);
 300 }
 301
 302 LY_DEFINE(ly_music_list_p,"music-list?", 1, 0, 0,
 303   (SCM l),"Type predicate: return true if @var{l} is a list of music objects.")
 304 {
 305   if (scm_list_p (l) != SCM_BOOL_T)
 306     return SCM_BOOL_F;
 307
 308   while (gh_pair_p (l))
 309     {
 310       if (!unsmob_music (gh_car (l)))
 311         return SCM_BOOL_F;
 312       l =gh_cdr (l);
 313     }
 314   return SCM_BOOL_T;
 315 }
 316 ADD_MUSIC(Music);
 317
 318
 319 SCM make_music_proc;
 320
 321
 322 Music*
 323 make_music_by_name (SCM sym)
 324 {
 325   if (!make_music_proc)
 326     make_music_proc = scm_primitive_eval (ly_symbol2scm ("make-music-by-name"));
 327
 328   SCM rv = scm_call_1 (make_music_proc, sym);
 329
 330   /*
 331     UGH.
 332   */
 333   scm_gc_protect_object (rv);
 334   return unsmob_music (rv);
 335 }