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 "debug.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   SCM c =ly_deep_mus_copy (m.mutable_property_alist_);
  46   mutable_property_alist_ = c;
  47
  48   smobify_self ();
  49
  50   set_spot (*m.origin ());
  51 }
  52
  53
  54 Music::Music (SCM l)
  55 {
  56   immutable_property_alist_ = l;
  57   mutable_property_alist_ = SCM_EOL;
  58   smobify_self ();
  59 }
  60
  61
  62 SCM
  63 Music::mark_smob (SCM m)
  64 {
  65   Music * mus = (Music *)SCM_CELL_WORD_1 (m);
  66   scm_gc_mark (mus->immutable_property_alist_);
  67   scm_gc_mark (mus->mutable_property_alist_);
  68   return SCM_EOL;
  69 }
  70
  71 void
  72 Music::compress (Moment)
  73 {
  74 }
  75
  76
  77
  78 Moment
  79 Music::length_mom () const
  80 {
  81   SCM l = get_mus_property ("length");
  82   if (unsmob_moment (l))
  83     return *unsmob_moment (l);
  84   else if (gh_procedure_p (l))
  85     {
  86       SCM res = gh_call1 (l, self_scm ());
  87       return *unsmob_moment (res);
  88     }
  89
  90   return 0;
  91 }
  92
  93 Moment
  94 Music::start_mom () const
  95 {
  96   Moment m ;
  97   return m;
  98 }
  99
 100 void
 101 print_alist (SCM a, SCM port)
 102 {
 103   for (SCM s = a; gh_pair_p (s); s = ly_cdr (s))
 104     {
 105       scm_display (ly_caar (s), port);
 106       scm_puts (" = ", port);
 107       scm_write (ly_cdar (s), port);
 108       scm_puts ("\n", port);
 109     }
 110 }
 111
 112 int
 113 Music::print_smob (SCM s, SCM p, scm_print_state*)
 114 {
 115   scm_puts ("#<Music ", p);
 116   Music* m = unsmob_music (s);
 117   scm_puts (classname (m),p);
 118
 119   print_alist (m->mutable_property_alist_, p);
 120   print_alist (m->immutable_property_alist_, p);
 121
 122   scm_puts (">",p);
 123   return 1;
 124 }
 125
 126 Pitch
 127 Music::to_relative_octave (Pitch m)
 128 {
 129   return m;
 130 }
 131
 132
 133 void
 134 Music::transpose (Pitch delta)
 135 {
 136   Pitch *p = unsmob_pitch (get_mus_property ("pitch"));
 137   if (!p)
 138     return ;
 139
 140   Pitch np = *p;
 141   np.transpose (delta);
 142
 143   if (abs (np.alteration_i_) > 2)
 144     {
 145         warning (_f ("Transposition by %s makes accidental larger than two",
 146           delta.str ()));
 147     }
 148
 149   set_mus_property ("pitch", np.smobbed_copy ());
 150 }
 151
 152 IMPLEMENT_TYPE_P (Music, "music?");
 153
 154 IMPLEMENT_SMOBS (Music);
 155 IMPLEMENT_DEFAULT_EQUAL_P (Music);
 156
 157 /****************************/
 158
 159 SCM
 160 Music::internal_get_mus_property (SCM sym) const
 161 {
 162   SCM s = scm_sloppy_assq (sym, mutable_property_alist_);
 163   if (s != SCM_BOOL_F)
 164     return ly_cdr (s);
 165
 166   s = scm_sloppy_assq (sym, immutable_property_alist_);
 167   return (s == SCM_BOOL_F) ? SCM_EOL : ly_cdr (s);
 168 }
 169
 170
 171
 172 void
 173 Music::internal_set_mus_property (SCM s, SCM v)
 174 {
 175 #ifndef NDEBUG
 176   if (internal_type_checking_global_b)
 177     assert (type_check_assignment (s, v, ly_symbol2scm ("music-type?")));
 178 #endif
 179
 180
 181   mutable_property_alist_ = scm_assq_set_x (mutable_property_alist_, s, v);
 182 }
 183
 184 #include "main.hh"
 185
 186 void
 187 Music::set_spot (Input ip)
 188 {
 189   set_mus_property ("origin", make_input (ip));
 190 }
 191
 192
 193
 194 Input*
 195 Music::origin () const
 196 {
 197   Input *ip = unsmob_input (get_mus_property ("origin"));
 198   return ip ? ip : & dummy_input_global;
 199 }
 200
 201
 202
 203
 204
 205 Music::~Music ()
 206 {
 207
 208 }
 209
 210 SCM
 211 ly_get_mus_property (SCM mus, SCM sym)
 212 {
 213   Music * sc = unsmob_music (mus);
 214
 215   if (sc)
 216     {
 217       return sc->internal_get_mus_property (sym);
 218     }
 219   else
 220     {
 221       warning (_ ("ly_get_mus_property (): Not a Music"));
 222       scm_write (mus, scm_current_error_port ());
 223     }
 224   return SCM_EOL;
 225 }
 226
 227
 228 SCM
 229 ly_set_mus_property (SCM mus, SCM sym, SCM val)
 230 {
 231   Music * sc = unsmob_music (mus);
 232
 233   if (!gh_symbol_p (sym))
 234     {
 235       warning (_ ("ly_set_mus_property (): Not a symbol"));
 236       scm_write (mus, scm_current_error_port ());
 237
 238       return SCM_UNSPECIFIED;
 239     }
 240
 241   if (!sc)
 242     {
 243       warning (_ ("ly_set_mus_property ():  not of type Music: "));
 244       scm_write (mus, scm_current_error_port ());
 245       return SCM_UNSPECIFIED;
 246     }
 247
 248
 249   bool ok = type_check_assignment (sym, val, ly_symbol2scm ("music-type?"));
 250   if (ok)
 251     {
 252       sc->internal_set_mus_property (sym, val);
 253     }
 254
 255   return SCM_UNSPECIFIED;
 256 }
 257
 258
 259 // to do  property args
 260 SCM
 261 ly_make_music (SCM type)
 262 {
 263   if (!gh_string_p (type))
 264     {
 265       warning (_ ("ly_make_music (): Not a string"));
 266       scm_write (type, scm_current_error_port ());
 267
 268       return SCM_UNSPECIFIED;
 269     }
 270   else
 271     {
 272       SCM s = get_music (ly_scm2string (type))->self_scm ();
 273       scm_gc_unprotect_object (s);
 274
 275       return s;
 276     }
 277 }
 278
 279 SCM
 280 ly_music_name (SCM mus)
 281 {
 282   Music * m = unsmob_music (mus);
 283   const char *nm ="";
 284   if (!m)
 285     {
 286       warning (_ ("ly_music_name (): Not a music expression"));
 287       scm_write (mus, scm_current_error_port ());
 288     }
 289    else
 290      nm = classname (m);
 291    return ly_str02scm (nm);
 292 }
 293
 294 SCM
 295 ly_music_list_p (SCM l)
 296 {
 297   if (scm_list_p (l) != SCM_BOOL_T)
 298     return SCM_BOOL_F;
 299
 300   while (gh_pair_p (l))
 301     {
 302       if (!unsmob_music (gh_car (l)))
 303         return SCM_BOOL_F;
 304       l =gh_cdr (l);
 305     }
 306   return SCM_BOOL_T;
 307 }
 308
 309 static void
 310 init_functions ()
 311 {
 312   scm_c_define_gsubr ("music-list?", 1, 0, 0, (Scheme_function_unknown)ly_music_list_p);
 313   scm_c_define_gsubr ("ly-get-mus-property", 2, 0, 0, (Scheme_function_unknown)ly_get_mus_property);
 314   scm_c_define_gsubr ("ly-set-mus-property", 3, 0, 0, (Scheme_function_unknown)ly_set_mus_property);
 315   scm_c_define_gsubr ("ly-make-music", 1, 0, 0, (Scheme_function_unknown)ly_make_music);
 316   scm_c_define_gsubr ("ly-music-name", 1, 0, 0, (Scheme_function_unknown)ly_music_name);
 317 }
 318 ADD_SCM_INIT_FUNC (musicscm,init_functions);
 319 ADD_MUSIC(Music);