X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Fmusic.cc;h=bbf7fe4f585da5c8ed909088627346767bb1971d;hb=3af0951f9a11677240efa6228683dd4fcea13eaf;hp=edaed5e3f3abf1670fab5f6f90bccdc5fa924a21;hpb=4034396f1e07d5453d81103532bcc2969e131b92;p=lilypond.git

diff --git a/lily/music.cc b/lily/music.cc
index edaed5e3f3..bbf7fe4f58 100644
--- a/lily/music.cc
+++ b/lily/music.cc
@@ -1,116 +1,116 @@
 /*
-  music.cc -- implement Music
+  This file is part of LilyPond, the GNU music typesetter.
 
-  source file of the GNU LilyPond music typesetter
+  Copyright (C) 1997--2015 Han-Wen Nienhuys <hanwen@xs4all.nl>
 
-  (c) 1997--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+  LilyPond is free software: you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation, either version 3 of the License, or
+  (at your option) any later version.
+
+  LilyPond is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
 */
 
 #include "music.hh"
 
+#include "context.hh"
+#include "dispatcher.hh"
 #include "duration.hh"
-#include "input-smob.hh"
-#include "ly-smobs.icc"
+#include "input.hh"
+#include "international.hh"
 #include "main.hh"
-#include "music-list.hh"
-#include "pitch.hh"
+#include "music-sequence.hh"
 #include "score.hh"
 #include "warn.hh"
+#include "lily-imports.hh"
 
+/*
+  Music is anything that has (possibly zero) duration and supports
+  both time compression and transposition.
+
+  In Lily, everything that can be thought to have a length and a pitch
+  (which has a duration which can be transposed) is considered "music".
+*/
 bool
 Music::internal_is_music_type (SCM k) const
 {
   SCM ifs = get_property ("types");
 
-  return scm_c_memq (k, ifs) != SCM_BOOL_F;
-}
-
-String
-Music::name () const
-{
-  SCM nm = get_property ("name");
-  if (scm_is_symbol (nm))
-    {
-      return ly_symbol2string (nm);
-    }
-  else
-    {
-      return classname (this);
-    }
+  return scm_is_true (scm_c_memq (k, ifs));
 }
 
 Music::Music (SCM init)
+  : Prob (ly_symbol2scm ("Music"), init)
 {
-  self_scm_ = SCM_EOL;
-  immutable_property_alist_ = init;
-  mutable_property_alist_ = SCM_EOL;
-  smobify_self ();
+  length_callback_ = SCM_EOL;
+  start_callback_ = SCM_EOL;
 
   length_callback_ = get_property ("length-callback");
+  if (!ly_is_procedure (length_callback_))
+    length_callback_ = duration_length_callback_proc;
+
   start_callback_ = get_property ("start-callback");
 }
 
-Music::Music (Music const &m)
+void
+Music::derived_mark () const
 {
-  immutable_property_alist_ = m.immutable_property_alist_;
-  mutable_property_alist_ = SCM_EOL;
-  self_scm_ = SCM_EOL;
-
-  /* First we smobify_self, then we copy over the stuff.  If we don't,
-     stack vars that hold the copy might be optimized away, meaning
-     that they won't be protected from GC. */
-  smobify_self ();
-  mutable_property_alist_ = ly_music_deep_copy (m.mutable_property_alist_);
-  length_callback_ = m.length_callback_;
-  start_callback_ = m.start_callback_;
-  set_spot (*m.origin ());
+  scm_gc_mark (length_callback_);
+  scm_gc_mark (start_callback_);
 }
 
-Music::~Music ()
+SCM
+Music::copy_mutable_properties () const
 {
+  return music_deep_copy (mutable_property_alist_);
 }
 
-ADD_MUSIC (Music);
-
-SCM
-Music::get_property_alist (bool m) const
+void
+Music::type_check_assignment (SCM s, SCM v) const
 {
-  return (m) ? mutable_property_alist_ : immutable_property_alist_;
+  ::type_check_assignment (s, v, ly_symbol2scm ("music-type?"));
 }
 
-SCM
-Music::mark_smob (SCM m)
+Music::Music (Music const &m)
+  : Prob (m)
 {
-  Music *mus = (Music*) SCM_CELL_WORD_1 (m);
-  scm_gc_mark (mus->immutable_property_alist_);
-  scm_gc_mark (mus->mutable_property_alist_);
-  return SCM_EOL;
+  length_callback_ = m.length_callback_;
+  start_callback_ = m.start_callback_;
+
+  /// why?
+  set_spot (*m.origin ());
 }
 
 Moment
 Music::get_length () const
 {
   SCM lst = get_property ("length");
-  if (unsmob_moment (lst))
-    return *unsmob_moment (lst);
+  if (unsmob<Moment> (lst))
+    return *unsmob<Moment> (lst);
 
-  if (ly_c_procedure_p (length_callback_))
+  if (ly_is_procedure (length_callback_))
     {
       SCM res = scm_call_1 (length_callback_, self_scm ());
-      return *unsmob_moment (res);
+      return *unsmob<Moment> (res);
     }
 
-  return Moment(0);
+  return Moment (0);
 }
 
 Moment
 Music::start_mom () const
 {
-  SCM lst = get_property ("start-callback");
-  if (ly_c_procedure_p (lst))
+  SCM lst = start_callback_;
+  if (ly_is_procedure (lst))
     {
       SCM res = scm_call_1 (lst, self_scm ());
-      return *unsmob_moment (res);
+      return *unsmob<Moment> (res);
     }
 
   Moment m;
@@ -130,36 +130,54 @@ print_alist (SCM a, SCM port)
     }
 }
 
-int
-Music::print_smob (SCM s, SCM p, scm_print_state*)
+Pitch
+Music::generic_to_relative_octave (Pitch last)
 {
-  scm_puts ("#<Music ", p);
-  Music* m = unsmob_music (s);
-
-  SCM nm = m->get_property ("name");
-  if (scm_is_symbol (nm) || scm_is_string (nm))
-    scm_display (nm, p);
-  else
-    scm_puts (classname (m),p);
+  SCM elt = get_property ("element");
+  Pitch *old_pit = unsmob<Pitch> (get_property ("pitch"));
+  if (old_pit)
+    {
+      Pitch new_pit = *old_pit;
+      new_pit = new_pit.to_relative_octave (last);
+
+      SCM check = get_property ("absolute-octave");
+      if (scm_is_number (check)
+          && new_pit.get_octave () != scm_to_int (check))
+        {
+          Pitch expected_pit (scm_to_int (check),
+                              new_pit.get_notename (),
+                              new_pit.get_alteration ());
+          origin ()->warning (_f ("octave check failed; expected \"%s\", found: \"%s\"",
+                                  expected_pit.to_string (),
+                                  new_pit.to_string ()));
+          new_pit = expected_pit;
+        }
+
+      set_property ("pitch", new_pit.smobbed_copy ());
+
+      last = new_pit;
+    }
 
-  /* Printing properties takes a lot of time, especially during backtraces.
-     For inspecting, it is better to explicitly use an inspection
-     function.  */
+  if (Music *m = unsmob<Music> (elt))
+    last = m->to_relative_octave (last);
 
-  scm_puts (">",p);
-  return 1;
+  (void) music_list_to_relative (get_property ("articulations"), last, true);
+  last = music_list_to_relative (get_property ("elements"), last, false);
+  return last;
 }
 
 Pitch
-Music::to_relative_octave (Pitch p)
+Music::to_relative_octave (Pitch last)
 {
-  SCM elt = get_property ("element");
-
-  if (Music *m = unsmob_music (elt))
-    p = m->to_relative_octave (p);
+  SCM callback = get_property ("to-relative-callback");
+  if (ly_is_procedure (callback))
+    {
+      Pitch *p = unsmob<Pitch> (scm_call_2 (callback, self_scm (),
+                                           last.smobbed_copy ()));
+      return *p;
+    }
 
-  p = music_list_to_relative (get_property ("elements"), p, false);
-  return p;
+  return generic_to_relative_octave (last);
 }
 
 void
@@ -167,94 +185,179 @@ Music::compress (Moment factor)
 {
   SCM elt = get_property ("element");
 
-  if (Music *m = unsmob_music (elt))
+  if (Music *m = unsmob<Music> (elt))
     m->compress (factor);
 
   compress_music_list (get_property ("elements"), factor);
+  Duration *d = unsmob<Duration> (get_property ("duration"));
+  if (d)
+    set_property ("duration",
+                  d->compressed (factor.main_part_).smobbed_copy ());
 }
 
+/*
+  This mutates alist.  Hence, make sure that it is not shared
+*/
+
 void
-Music::transpose (Pitch delta)
+Prob::transpose (Pitch delta)
 {
-  for (SCM s = this->get_property_alist (true); scm_is_pair (s); s = scm_cdr (s))
+  if (to_boolean (get_property ("untransposable")))
+    return;
+
+  for (SCM s = mutable_property_alist_; scm_is_pair (s); s = scm_cdr (s))
     {
       SCM entry = scm_car (s);
+      SCM prop = scm_car (entry);
       SCM val = scm_cdr (entry);
-
-      if (Pitch * p = unsmob_pitch (val))
-	{
-	  Pitch transposed =  p->transposed (delta);
-	  scm_set_cdr_x (entry, transposed.smobbed_copy ());
-
-	  if (abs (transposed.get_alteration ()) > DOUBLE_SHARP)
-	    {
-	      warning (_f ("Transposition by %s makes alteration larger than two",
-			   delta.to_string ()));
-	    }
-	}
+      SCM new_val = val;
+
+      if (Pitch *p = unsmob<Pitch> (val))
+        {
+          Pitch transposed = p->transposed (delta);
+
+          if (scm_is_eq (prop, ly_symbol2scm ("tonic")))
+            transposed = Pitch (-1, transposed.get_notename (),
+                                transposed.get_alteration ());
+
+          new_val = transposed.smobbed_copy ();
+        }
+      else if (scm_is_eq (prop, ly_symbol2scm ("element")))
+        {
+          if (Prob *m = unsmob<Prob> (val))
+            m->transpose (delta);
+        }
+      else if (scm_is_eq (prop, ly_symbol2scm ("elements"))
+               || scm_is_eq (prop, ly_symbol2scm ("articulations")))
+        transpose_music_list (val, delta);
+      else if (scm_is_eq (prop, ly_symbol2scm ("pitch-alist"))
+               && scm_is_pair (val))
+        new_val = ly_transpose_key_alist (val, delta.smobbed_copy ());
+
+      if (val != new_val)
+        scm_set_cdr_x (entry, new_val);
     }
- 
-  SCM elt = get_property ("element");
-
-  if (Music* m = unsmob_music (elt))
-    m->transpose (delta);
-
-  transpose_music_list (get_property ("elements"), delta);
 }
 
-IMPLEMENT_TYPE_P (Music, "ly:music?");
-IMPLEMENT_SMOBS (Music);
-IMPLEMENT_DEFAULT_EQUAL_P (Music);
-
-SCM
-Music::internal_get_property (SCM sym) const
+void
+Music::set_spot (Input ip)
 {
-  SCM s = scm_sloppy_assq (sym, mutable_property_alist_);
-  if (s != SCM_BOOL_F)
-    return scm_cdr (s);
+  set_property ("origin", ip.smobbed_copy ());
+}
 
-  s = scm_sloppy_assq (sym, immutable_property_alist_);
-  return (s == SCM_BOOL_F) ? SCM_EOL : scm_cdr (s);
+Input *
+Music::origin () const
+{
+  Input *ip = unsmob<Input> (get_property ("origin"));
+  return ip ? ip : &dummy_input_global;
 }
 
-void
-Music::internal_set_property (SCM s, SCM v)
+/*
+  ES TODO: This method should probably be reworked or junked.
+*/
+Stream_event *
+Music::to_event () const
 {
-  if (do_internal_type_checking_global)
-    if (!type_check_assignment (s, v, ly_symbol2scm ("music-type?")))
-      abort ();
+  SCM class_name = ly_camel_case_2_lisp_identifier (get_property ("name"));
+
+  // catch programming mistakes.
+  if (!internal_is_music_type (class_name))
+    programming_error ("Not a music type");
+
+  Stream_event *e = new Stream_event
+    (Lily::ly_make_event_class (class_name),
+     mutable_property_alist_);
+  Moment length = get_length ();
+  if (length.to_bool ())
+    e->set_property ("length", length.smobbed_copy ());
+
+  // articulations as events.
+  SCM art_mus = e->get_property ("articulations");
+  if (scm_is_pair (art_mus))
+    {
+      SCM art_ev = SCM_EOL;
+      for (; scm_is_pair (art_mus); art_mus = scm_cdr (art_mus))
+        {
+          Music *m = unsmob<Music> (scm_car (art_mus));
+          art_ev = scm_cons (m->to_event ()->unprotect (), art_ev);
+        }
+      e->set_property ("articulations", scm_reverse_x (art_ev, SCM_EOL));
+    }
+
+  /*
+    ES TODO: This is a temporary fix. Stream_events should not be
+    aware of music.
+  */
+  e->set_property ("music-cause", self_scm ());
 
-  mutable_property_alist_ = scm_assq_set_x (mutable_property_alist_, s, v);
+  return e;
 }
 
 void
-Music::set_spot (Input ip)
+Music::send_to_context (Context *c)
 {
-  set_property ("origin", make_input (ip));
+  Stream_event *ev = to_event ();
+  c->event_source ()->broadcast (ev);
+  ev->unprotect ();
 }
 
-Input*
-Music::origin () const
+Music *
+make_music_by_name (SCM sym)
 {
-  Input *ip = unsmob_input (get_property ("origin"));
-  return ip ? ip : & dummy_input_global;
+  SCM rv = Lily::make_music (sym);
+
+  /* UGH. */
+  Music *m = unsmob<Music> (rv);
+  m->protect ();
+  return m;
 }
 
-int
-Music::duration_log () const
+MAKE_SCHEME_CALLBACK (Music, duration_length_callback, 1);
+SCM
+Music::duration_length_callback (SCM m)
 {
-  if (is_mus_type ("rhythmic-event"))
-    return unsmob_duration (get_property ("duration"))->duration_log ();
-  return 0;
+  Music *me = unsmob<Music> (m);
+  Duration *d = unsmob<Duration> (me->get_property ("duration"));
+
+  Moment mom;
+  if (d)
+    mom = d->get_length ();
+  return mom.smobbed_copy ();
 }
 
-Music*
-make_music_by_name (SCM sym)
+SCM
+music_deep_copy (SCM m)
 {
-  SCM make_music_proc = ly_lily_module_constant ("make-music");
-  SCM rv = scm_call_1 (make_music_proc, sym);
+  if (Music *mus = unsmob<Music> (m))
+      return mus->clone ()->unprotect ();
+  if (scm_is_pair (m))
+    {
+      SCM copy = SCM_EOL;
+      do
+        {
+          copy = scm_cons (music_deep_copy (scm_car (m)), copy);
+          m = scm_cdr (m);
+        }
+      while (scm_is_pair (m));
+      // Oh, come on, GUILE.  Why do you require the second argument
+      // of scm_reverse_x to be a proper list?  That makes no sense.
+      // return scm_reverse_x (copy, music_deep_copy (m));
+      SCM last_cons = copy;
+      copy = scm_reverse_x (copy, SCM_EOL);
+      scm_set_cdr_x (last_cons, music_deep_copy (m));
+      return copy;
+    }
+  return m;
+}
 
-  /* UGH. */
-  scm_gc_protect_object (rv);
-  return unsmob_music (rv);
+void
+set_origin (SCM m, SCM origin)
+{
+  while (scm_is_pair (m))
+    {
+      set_origin (scm_car (m), origin);
+      m = scm_cdr (m);
+    }
+  if (Music *mus = unsmob<Music> (m))
+    mus->set_property ("origin", origin);
 }