lily/music.cc

   1 /*
   2   music.cc -- implement Music
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c)  1997--2001 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7 */
   8
   9 #include "input-smob.hh"
  10 #include "music.hh"
  11 #include "music-list.hh"
  12 #include "debug.hh"
  13 #include "pitch.hh"
  14 #include "ly-smobs.icc"
  15
  16 SCM
  17 ly_deep_mus_copy (SCM m)
  18 {
  19   if (unsmob_music (m))
  20     {
  21       SCM ss =  unsmob_music (m)->clone ()->self_scm ();
  22       scm_gc_unprotect_object (ss);
  23       return ss;
  24     }
  25   else if (gh_pair_p (m))
  26     {
  27       return gh_cons (ly_deep_mus_copy (gh_car (m)), ly_deep_mus_copy (gh_cdr (m)));
  28     }
  29   else
  30     return m;
  31 }
  32
  33
  34 Music::Music ()
  35 {
  36   immutable_property_alist_ = SCM_EOL;
  37   mutable_property_alist_ = SCM_EOL;
  38   smobify_self ();
  39 }
  40
  41 Music::Music (Music const &m)
  42 {
  43   immutable_property_alist_ = m.immutable_property_alist_;
  44   mutable_property_alist_ = SCM_EOL;
  45
  46   /*
  47     First we smobify_self, then we copy over the stuff.  If we don't,
  48     stack vars that hold the copy might be optimized away, meaning
  49     that they won't be protected from GC.
  50    */
  51   smobify_self ();
  52   mutable_property_alist_ = ly_deep_mus_copy (m.mutable_property_alist_);
  53   set_spot (*m.origin ());
  54 }
  55
  56
  57 Music::Music (SCM l)
  58 {
  59   immutable_property_alist_ = l;
  60   mutable_property_alist_ = SCM_EOL;
  61   smobify_self ();
  62 }
  63
  64
  65 SCM
  66 Music::mark_smob (SCM m)
  67 {
  68   Music * mus = (Music *)SCM_CELL_WORD_1 (m);
  69   scm_gc_mark (mus->immutable_property_alist_);
  70   scm_gc_mark (mus->mutable_property_alist_);
  71   return SCM_EOL;
  72 }
  73
  74 void
  75 Music::compress (Moment)
  76 {
  77 }
  78
  79
  80
  81 Moment
  82 Music::length_mom () const
  83 {
  84   SCM l = get_mus_property ("length");
  85   if (unsmob_moment (l))
  86     return *unsmob_moment (l);
  87   else if (gh_procedure_p (l))
  88     {
  89       SCM res = gh_call1 (l, self_scm ());
  90       return *unsmob_moment (res);
  91     }
  92
  93   return 0;
  94 }
  95
  96 void
  97 print_alist (SCM a, SCM port)
  98 {
  99   for (SCM s = a; gh_pair_p (s); s = gh_cdr (s))
 100     {
 101       scm_display (gh_caar (s), port);
 102       scm_puts (" = ", port);
 103       scm_write (gh_cdar (s), port);
 104       scm_puts ("\n", port);
 105     }
 106 }
 107
 108 int
 109 Music::print_smob (SCM s, SCM p, scm_print_state*)
 110 {
 111   scm_puts ("#<Music ", p);
 112   Music* m = unsmob_music (s);
 113   scm_puts (classname (m),p);
 114
 115   print_alist (m->mutable_property_alist_, p);
 116   print_alist (m->immutable_property_alist_, p);
 117
 118   scm_puts (">",p);
 119   return 1;
 120 }
 121
 122 Pitch
 123 Music::to_relative_octave (Pitch m)
 124 {
 125   return m;
 126 }
 127
 128
 129 void
 130 Music::transpose (Pitch)
 131 {
 132 }
 133
 134 IMPLEMENT_TYPE_P (Music, "music?");
 135 IMPLEMENT_UNSMOB (Music,music);
 136 IMPLEMENT_SMOBS (Music);
 137 IMPLEMENT_DEFAULT_EQUAL_P (Music);
 138
 139 /****************************/
 140
 141 SCM
 142 Music::get_mus_property (const char *nm) const
 143 {
 144   SCM sym = ly_symbol2scm (nm);
 145   return get_mus_property (sym);
 146 }
 147
 148 SCM
 149 Music::get_mus_property (SCM sym) const
 150 {
 151   SCM s = scm_sloppy_assq (sym, mutable_property_alist_);
 152   if (s != SCM_BOOL_F)
 153     return gh_cdr (s);
 154
 155   s = scm_sloppy_assq (sym, immutable_property_alist_);
 156   return (s == SCM_BOOL_F) ? SCM_EOL : gh_cdr (s);
 157 }
 158
 159 /*
 160   Remove the value associated with KEY, and return it. The result is
 161   that a next call will yield SCM_EOL (and not the underlying
 162   `basic' property.
 163 */
 164 SCM
 165 Music::remove_mus_property (const char* key)
 166 {
 167   SCM val = get_mus_property (key);
 168   if (val != SCM_EOL)
 169     set_mus_property (key, SCM_EOL);
 170   return val;
 171 }
 172
 173 void
 174 Music::set_mus_property (const char* k, SCM v)
 175 {
 176   SCM s = ly_symbol2scm (k);
 177   set_mus_property (s, v);
 178 }
 179
 180 void paranoia_check (Music*);
 181
 182 void
 183 Music::set_immutable_mus_property (const char*k, SCM v)
 184 {
 185   SCM s = ly_symbol2scm (k);
 186   set_immutable_mus_property (s, v);
 187 }
 188
 189 void
 190 Music::set_immutable_mus_property (SCM s, SCM v)
 191 {
 192   immutable_property_alist_ = gh_cons (gh_cons (s,v), mutable_property_alist_);
 193   mutable_property_alist_ = scm_assq_remove_x (mutable_property_alist_, s);
 194 }
 195 void
 196 Music::set_mus_property (SCM s, SCM v)
 197 {
 198   mutable_property_alist_ = scm_assq_set_x (mutable_property_alist_, s, v);
 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
 210
 211 Input*
 212 Music::origin () const
 213 {
 214   Input *ip = unsmob_input (get_mus_property ("origin"));
 215   return ip ? ip : & dummy_input_global;
 216 }
 217
 218
 219
 220
 221
 222 Music::~Music ()
 223 {
 224
 225 }
 226
 227 SCM
 228 ly_get_mus_property (SCM mus, SCM sym)
 229 {
 230   Music * sc = unsmob_music (mus);
 231
 232   if (sc)
 233     {
 234       return sc->get_mus_property (sym);
 235     }
 236   else
 237     {
 238       warning (_ ("ly_get_mus_property (): Not a Music"));
 239       scm_write (mus, scm_current_error_port ());
 240     }
 241   return SCM_EOL;
 242 }
 243
 244
 245 SCM
 246 ly_set_mus_property (SCM mus, SCM sym, SCM val)
 247 {
 248   Music * sc = unsmob_music (mus);
 249
 250   if (!gh_symbol_p (sym))
 251     {
 252       warning (_ ("ly_set_mus_property (): Not a symbol"));
 253       scm_write (mus, scm_current_error_port ());
 254
 255       return SCM_UNSPECIFIED;
 256     }
 257
 258   if (sc)
 259     {
 260       sc->set_mus_property (sym, val);
 261     }
 262   else
 263     {
 264       warning (_ ("ly_set_mus_property ():  not of type Music"));
 265       scm_write (mus, scm_current_error_port ());
 266     }
 267
 268   return SCM_UNSPECIFIED;
 269 }
 270
 271
 272 // to do  property args
 273 SCM
 274 ly_make_music (SCM type)
 275 {
 276   if (!gh_string_p (type))
 277     {
 278       warning (_ ("ly_make_music (): Not a string"));
 279       scm_write (type, scm_current_error_port ());
 280
 281       return SCM_UNSPECIFIED;
 282     }
 283   else
 284     {
 285       SCM s =       get_music (ly_scm2string (type))->self_scm ();
 286       scm_gc_unprotect_object (s);
 287       return s;
 288     }
 289 }
 290
 291 SCM
 292 ly_music_name (SCM mus)
 293 {
 294   Music * m = unsmob_music (mus);
 295   const char *nm ="";
 296   if (!m)
 297     {
 298       warning (_ ("ly_music_name (): Not a music expression"));
 299       scm_write (mus, scm_current_error_port ());
 300     }
 301    else
 302      nm = classname (m);
 303    return ly_str02scm (nm);
 304 }
 305
 306 static void
 307 init_functions ()
 308 {
 309   scm_c_define_gsubr ("ly-get-mus-property", 2, 0, 0, (Scheme_function_unknown)ly_get_mus_property);
 310   scm_c_define_gsubr ("ly-set-mus-property", 3, 0, 0, (Scheme_function_unknown)ly_set_mus_property);
 311   scm_c_define_gsubr ("ly-make-music", 1, 0, 0, (Scheme_function_unknown)ly_make_music);
 312   scm_c_define_gsubr ("ly-music-name", 1, 0, 0, (Scheme_function_unknown)ly_music_name);
 313 }
 314 ADD_SCM_INIT_FUNC (musicscm,init_functions);
 315 ADD_MUSIC(Music);
 316