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_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_property ("duration"));
  29   if (d)
  30     set_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_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_property ("pitch", np.smobbed_copy ());
  54 }
  55
  56 Pitch
  57 Event::to_relative_octave (Pitch last)
  58 {
  59   Pitch *old_pit = unsmob_pitch (get_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_property ("absolute-octave");
  66       if (ly_c_number_p (check) &&
  67           new_pit.get_octave () != scm_to_int (check))
  68         {
  69           Pitch expected_pit (scm_to_int (check),
  70                               new_pit.get_notename (),
  71                               new_pit.get_alteration ());
  72           origin ()->warning (_f ("octave check failed; expected %s, found: %s",
  73                                   expected_pit.to_string (),
  74                                   new_pit.to_string ()));
  75           new_pit = expected_pit;
  76         }
  77
  78       set_property ("pitch", new_pit.smobbed_copy ());
  79
  80       return new_pit;
  81     }
  82   return last;
  83 }
  84
  85 Event::Event ()
  86   : Music ()
  87 {
  88 }
  89
  90 ADD_MUSIC (Event);
  91
  92 LY_DEFINE (ly_music_duration_length, "ly:music-duration-length", 1, 0,0,
  93           (SCM mus),
  94           "Extract the duration field from @var{mus}, and return the length.")
  95 {
  96   Music* m =   unsmob_music (mus);
  97   SCM_ASSERT_TYPE (m, mus, SCM_ARG1, __FUNCTION__, "Music");
  98
  99   Duration *d = unsmob_duration (m->get_property ("duration"));
 100
 101   Moment l ;
 102
 103   if (d)
 104     {
 105       l = d->get_length ();
 106     }
 107   else
 108     programming_error ("Music has no duration");
 109   return l.smobbed_copy ();
 110
 111 }
 112
 113
 114 LY_DEFINE (ly_music_duration_compress, "ly:music-duration-compress", 2, 0,0,
 115           (SCM mus, SCM fact),
 116           "Compress @var{mus} by factor @var{fact}, which is a @code{Moment}.")
 117 {
 118   Music* m =   unsmob_music (mus);
 119   Moment * f = unsmob_moment (fact);
 120   SCM_ASSERT_TYPE (m, mus, SCM_ARG1, __FUNCTION__, "Music");
 121   SCM_ASSERT_TYPE (f, fact, SCM_ARG2, __FUNCTION__, "Moment");
 122
 123   Duration *d = unsmob_duration (m->get_property ("duration"));
 124   if (d)
 125     m->set_property ("duration", d->compressed (f->main_part_).smobbed_copy ());
 126   return SCM_UNSPECIFIED;
 127 }
 128
 129
 130
 131 /*
 132   This is hairy, since the scale in a key-change event may contain
 133   octaveless notes.
 134
 135
 136   TODO: this should use ly:pitch.
 137  */
 138 LY_DEFINE (ly_transpose_key_alist, "ly:transpose-key-alist",
 139           2, 0, 0, (SCM l, SCM pit),
 140           "Make a new key alist of @var{l} transposed by pitch @var{pit}")
 141 {
 142   SCM newlist = SCM_EOL;
 143   Pitch *p = unsmob_pitch (pit);
 144
 145   for (SCM s = l; ly_c_pair_p (s); s = ly_cdr (s))
 146     {
 147       SCM key = ly_caar (s);
 148       SCM alter = ly_cdar (s);
 149       if (ly_c_pair_p (key))
 150         {
 151           Pitch orig (scm_to_int (ly_car (key)),
 152                       scm_to_int (ly_cdr (key)),
 153                       scm_to_int (alter));
 154
 155           orig =orig.transposed (*p);
 156
 157           SCM key = scm_cons (scm_int2num (orig.get_octave ()),
 158                              scm_int2num (orig.get_notename ()));
 159
 160           newlist = scm_cons (scm_cons (key, scm_int2num (orig.get_alteration ())),
 161                              newlist);
 162         }
 163       else if (ly_c_number_p (key))
 164         {
 165           Pitch orig (0, scm_to_int (key), scm_to_int (alter));
 166           orig = orig.transposed (*p);
 167
 168           key =scm_int2num (orig.get_notename ());
 169           alter = scm_int2num (orig.get_alteration ());
 170           newlist = scm_cons (scm_cons (key, alter), newlist);
 171         }
 172     }
 173   return scm_reverse_x (newlist, SCM_EOL);
 174 }
 175
 176 void
 177 Key_change_ev::transpose (Pitch p)
 178 {
 179   SCM pa = get_property ("pitch-alist");
 180
 181   set_property ("pitch-alist", ly_transpose_key_alist (pa, p.smobbed_copy ()));
 182   Pitch tonic = *unsmob_pitch (get_property ("tonic"));
 183   set_property ("tonic",
 184                     tonic.smobbed_copy ());
 185 }
 186
 187 bool
 188 alist_equal_p (SCM a, SCM b)
 189 {
 190   for (SCM s = a;
 191        ly_c_pair_p (s); s = ly_cdr (s))
 192     {
 193       SCM key = ly_caar (s);
 194       SCM val = ly_cdar (s);
 195       SCM l = scm_assoc (key, b);
 196
 197       if (l == SCM_BOOL_F
 198           || !ly_c_equal_p ( ly_cdr (l), val))
 199
 200         return false;
 201     }
 202   return true;
 203 }
 204 ADD_MUSIC (Key_change_ev);