lily/music.cc

   1 /*
   2   music.cc -- implement Music
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c)  1997--2000 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 "musical-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_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 (Music const &m)
  35 {
  36   immutable_property_alist_ = m.immutable_property_alist_;
  37   SCM c =ly_deep_mus_copy (m.mutable_property_alist_);
  38   mutable_property_alist_ = c;
  39
  40   smobify_self ();
  41
  42   set_spot (*m.origin ());
  43 }
  44
  45
  46 Music::Music()
  47 {
  48   immutable_property_alist_ = SCM_EOL;
  49   mutable_property_alist_ = SCM_EOL;
  50   smobify_self ();
  51 }
  52
  53 SCM
  54 Music::mark_smob (SCM m)
  55 {
  56   Music * mus = (Music *)SCM_CELL_WORD_1(m);
  57   scm_gc_mark (mus->immutable_property_alist_);
  58   scm_gc_mark (mus->mutable_property_alist_);
  59   return SCM_EOL;
  60 }
  61
  62 void
  63 Music::compress (Moment)
  64 {
  65 }
  66
  67
  68
  69 Moment
  70 Music::length_mom () const
  71 {
  72   SCM l = get_mus_property ("length");
  73   if (unsmob_moment (l))
  74     return *unsmob_moment(l);
  75   else if (gh_procedure_p (l))
  76     {
  77       SCM res = gh_call1(l, self_scm( ));
  78       return *unsmob_moment(res);
  79     }
  80
  81   return 0;
  82 }
  83
  84 int
  85 Music::print_smob(SCM s, SCM p, scm_print_state*)
  86 {
  87   scm_puts ("#<Music ", p);
  88   scm_puts (classname(unsmob_music (s)),p);
  89   scm_puts (">",p);
  90   return 1;
  91 }
  92
  93 Musical_pitch
  94 Music::to_relative_octave (Musical_pitch m)
  95 {
  96   return m;
  97 }
  98
  99
 100 void
 101 Music::transpose (Musical_pitch )
 102 {
 103 }
 104
 105
 106 IMPLEMENT_UNSMOB(Music,music);
 107 IMPLEMENT_SMOBS(Music);
 108 IMPLEMENT_DEFAULT_EQUAL_P(Music);
 109
 110 /****************************/
 111
 112 SCM
 113 Music::get_mus_property (const char *nm) const
 114 {
 115   SCM sym = ly_symbol2scm (nm);
 116   return get_mus_property (sym);
 117 }
 118
 119 SCM
 120 Music::get_mus_property (SCM sym) const
 121 {
 122   SCM s = scm_sloppy_assq(sym, mutable_property_alist_);
 123   if (s != SCM_BOOL_F)
 124     return gh_cdr (s);
 125
 126   s = scm_sloppy_assq (sym, immutable_property_alist_);
 127   return (s == SCM_BOOL_F) ? SCM_EOL : gh_cdr (s);
 128 }
 129
 130 /*
 131   Remove the value associated with KEY, and return it. The result is
 132   that a next call will yield SCM_EOL (and not the underlying
 133   `basic' property.
 134 */
 135 SCM
 136 Music::remove_mus_property (const char* key)
 137 {
 138   SCM val = get_mus_property (key);
 139   if (val != SCM_EOL)
 140     set_mus_property (key, SCM_EOL);
 141   return val;
 142 }
 143
 144 void
 145 Music::set_mus_property (const char* k, SCM v)
 146 {
 147   SCM s = ly_symbol2scm (k);
 148   set_mus_property (s, v);
 149 }
 150
 151 void
 152 Music::set_immutable_mus_property (const char*k, SCM v)
 153 {
 154   SCM s = ly_symbol2scm (k);
 155   set_immutable_mus_property (s, v);
 156 }
 157
 158 void
 159 Music::set_immutable_mus_property (SCM s, SCM v)
 160 {
 161   immutable_property_alist_ = gh_cons (gh_cons (s,v), mutable_property_alist_);
 162   mutable_property_alist_ = scm_assq_remove_x (mutable_property_alist_, s);
 163 }
 164 void
 165 Music::set_mus_property (SCM s, SCM v)
 166 {
 167   mutable_property_alist_ = scm_assq_set_x (mutable_property_alist_, s, v);
 168 }
 169
 170 void
 171 Music::set_spot (Input ip)
 172 {
 173    set_mus_property ("origin", make_input (ip));
 174 }
 175
 176
 177
 178 Input*
 179 Music::origin () const
 180 {
 181   Input *ip = unsmob_input (get_mus_property ("origin"));
 182   return ip ? ip : & dummy_input_global;
 183 }
 184
 185
 186
 187
 188
 189 Music::~Music ()
 190 {
 191
 192 }
 193
 194 SCM
 195 ly_get_mus_property (SCM mus, SCM sym)
 196 {
 197   Music * sc = unsmob_music (mus);
 198
 199   if (sc)
 200     {
 201       return sc->get_mus_property (sym);
 202     }
 203   else
 204     {
 205       warning (_("ly_get_mus_property (): Not a Music"));
 206       scm_write (mus, scm_current_error_port ());
 207     }
 208   return SCM_EOL;
 209 }
 210
 211
 212 SCM
 213 ly_set_mus_property (SCM mus, SCM sym, SCM val)
 214 {
 215   Music * sc = unsmob_music (mus);
 216
 217   if (!gh_symbol_p (sym))
 218     {
 219       warning (_("ly_set_mus_property (): Not a symbol"));
 220       scm_write (mus, scm_current_error_port ());
 221
 222       return SCM_UNSPECIFIED;
 223     }
 224
 225   if (sc)
 226     {
 227       sc->set_mus_property (sym, val);
 228     }
 229   else
 230     {
 231       warning (_("ly_set_mus_property ():  not of type Music"));
 232       scm_write (mus, scm_current_error_port ());
 233     }
 234
 235   return SCM_UNSPECIFIED;
 236 }
 237
 238 static void
 239 init_functions ()
 240 {
 241   scm_make_gsubr ("ly-get-mus-property", 2, 0, 0, (Scheme_function_unknown)ly_get_mus_property);
 242   scm_make_gsubr ("ly-set-mus-property", 3, 0, 0, (Scheme_function_unknown)ly_set_mus_property);
 243 }
 244 ADD_SCM_INIT_FUNC(musicscm,init_functions);