lily/music.cc

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