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