lily/event.cc

   1 /*
   2   event.cc -- implement Event
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 1996--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7 */
   8
   9 #include "event.hh"
  10 #include "warn.hh"
  11 #include "event.hh"
  12
  13 Moment
  14 Event::get_length () const
  15 {
  16   Duration *d = unsmob_duration (get_mus_property ("duration"));
  17   if (!d)
  18     {
  19       Moment m ;
  20       return m;
  21     }
  22   return d->get_length ();
  23 }
  24
  25 void
  26 Event::compress (Moment m)
  27 {
  28   Duration *d =  unsmob_duration (get_mus_property ("duration"));
  29   if (d)
  30     set_mus_property ("duration", d ->compressed (m.main_part_).smobbed_copy ());
  31 }
  32
  33 void
  34 Event::transpose (Pitch delta)
  35 {
  36   /*
  37     TODO: should change music representation such that
  38     _all_ pitch values are transposed automatically.
  39    */
  40
  41   Pitch *p = unsmob_pitch (get_mus_property ("pitch"));
  42   if (!p)
  43     return ;
  44
  45   Pitch np = p->transposed (delta);
  46
  47   if (abs (np.get_alteration ()) > DOUBLE_SHARP)
  48     {
  49         warning (_f ("Transposition by %s makes alteration larger than two",
  50           delta.to_string ()));
  51     }
  52
  53   set_mus_property ("pitch", np.smobbed_copy ());
  54 }
  55
  56 Pitch
  57 Event::to_relative_octave (Pitch last)
  58 {
  59   Pitch *old_pit = unsmob_pitch (get_mus_property ("pitch"));
  60   if (old_pit)
  61     {
  62       Pitch new_pit = *old_pit;
  63       new_pit = new_pit.to_relative_octave (last);
  64
  65       SCM check = get_mus_property ("absolute-octave");
  66       if (gh_number_p (check) &&
  67           new_pit.get_octave () != gh_scm2int (check))
  68         {
  69           String s =_("Failed octave check, got: ");
  70           s += new_pit.to_string ();
  71           new_pit = Pitch (gh_scm2int (check),
  72                            new_pit.get_notename (),
  73                            new_pit.get_alteration ());
  74
  75           s += " expected ";
  76           s += new_pit.to_string ();
  77           origin ()->warning (s);
  78         }
  79
  80       set_mus_property ("pitch", new_pit.smobbed_copy ());
  81
  82       return new_pit;
  83     }
  84   return last;
  85 }
  86
  87 Event::Event ()
  88   : Music ()
  89 {
  90 }
  91
  92 ADD_MUSIC(Event);
  93 LY_DEFINE(ly_music_duration_length, "ly:music-duration-length", 1, 0,0,
  94           (SCM mus),
  95           "Extract the duration field from @var{mus}, and return the length.")
  96 {
  97   Music* m =   unsmob_music(mus);
  98   SCM_ASSERT_TYPE(m, mus, SCM_ARG1, __FUNCTION__, "Music");
  99
 100   Duration *d = unsmob_duration (m->get_mus_property ("duration"));
 101
 102   Moment l ;
 103
 104   if (d)
 105     {
 106       l = d->get_length ();
 107     }
 108   else
 109     programming_error("Music has no duration");
 110   return l.smobbed_copy();
 111
 112 }
 113
 114
 115 LY_DEFINE(ly_music_duration_compress, "ly:music-duration-compress", 2, 0,0,
 116           (SCM mus, SCM factor),
 117           "Extract the duration field from @var{mus}, and compress it.")
 118 {
 119   Music* m =   unsmob_music(mus);
 120   Moment * f = unsmob_moment (factor);
 121   SCM_ASSERT_TYPE(m, mus, SCM_ARG1, __FUNCTION__, "Music");
 122   SCM_ASSERT_TYPE(f, factor, SCM_ARG2, __FUNCTION__, "Moment");
 123
 124   Duration *d = unsmob_duration (m->get_mus_property ("duration"));
 125   if (d)
 126     m->set_mus_property ("duration", d->compressed (f->main_part_).smobbed_copy());
 127   return SCM_UNSPECIFIED;
 128 }
 129
 130
 131
 132 /*
 133   This is hairy, since the scale in a key-change event may contain
 134   octaveless notes.
 135
 136
 137   TODO: this should use ly:pitch.
 138  */
 139 LY_DEFINE(ly_transpose_key_alist, "ly:transpose-key-alist",
 140           2, 0,0, (SCM l, SCM pitch),
 141           "Make a new key alist of @var{l} transposed by pitch @var{pitch}")
 142 {
 143   SCM newlist = SCM_EOL;
 144   Pitch *p = unsmob_pitch (pitch);
 145
 146   for (SCM s = l; gh_pair_p (s); s = ly_cdr (s))
 147     {
 148       SCM key = ly_caar (s);
 149       SCM alter = ly_cdar (s);
 150       if (gh_pair_p (key))
 151         {
 152           Pitch orig (gh_scm2int (ly_car (key)),
 153                       gh_scm2int (ly_cdr (key)),
 154                       gh_scm2int (alter));
 155
 156           orig =orig.transposed (*p);
 157
 158           SCM key = gh_cons (scm_int2num (orig.get_octave ()),
 159                              scm_int2num (orig.get_notename ()));
 160
 161           newlist = gh_cons (gh_cons (key, scm_int2num (orig.get_alteration ())),
 162                              newlist);
 163         }
 164       else if (gh_number_p (key))
 165         {
 166           Pitch orig (0, gh_scm2int (key), gh_scm2int (alter));
 167           orig = orig.transposed (*p);
 168
 169           key =scm_int2num (orig.get_notename ());
 170           alter = scm_int2num (orig.get_alteration());
 171           newlist = gh_cons (gh_cons (key, alter), newlist);
 172         }
 173     }
 174   return scm_reverse_x (newlist, SCM_EOL);
 175 }
 176
 177 void
 178 Key_change_ev::transpose (Pitch p)
 179 {
 180   SCM pa = get_mus_property ("pitch-alist");
 181
 182   set_mus_property ("pitch-alist", ly_transpose_key_alist (pa, p.smobbed_copy()));
 183   Pitch tonic = *unsmob_pitch (get_mus_property ("tonic"));
 184   set_mus_property ("tonic",
 185                     tonic.smobbed_copy ());
 186 }
 187
 188 bool
 189 alist_equal_p (SCM a, SCM b)
 190 {
 191   for (SCM s = a;
 192        gh_pair_p (s); s = ly_cdr (s))
 193     {
 194       SCM key = ly_caar (s);
 195       SCM val = ly_cdar (s);
 196       SCM l = scm_assoc (key, b);
 197
 198       if (l == SCM_BOOL_F
 199           || !gh_equal_p ( ly_cdr (l), val))
 200
 201         return false;
 202     }
 203   return true;
 204 }
 205 ADD_MUSIC (Key_change_ev);