X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Fmusic.cc;h=be1fb2ed131cb0451ab4e373db8e46d52dd9982a;hb=0619c6dfd6d2a744e70fc0b3f97a8b9adfc5d987;hp=178a602aa74a1340a0a5f5a25a520e957cd3f7d9;hpb=0817e0513d1016ff22a633b6fee20ddba2a062f2;p=lilypond.git

diff --git a/lily/music.cc b/lily/music.cc
index 178a602aa7..be1fb2ed13 100644
--- a/lily/music.cc
+++ b/lily/music.cc
@@ -1,312 +1,351 @@
 /*
-  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--2012 Han-Wen Nienhuys <hanwen@xs4all.nl>
 
-  (c)  1997--2001 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 "input-smob.hh"
 #include "music.hh"
-#include "music-list.hh"
-#include "debug.hh"
-#include "pitch.hh"
-#include "ly-smobs.icc"
 
-SCM
-ly_deep_mus_copy (SCM m)
-{
-  if (unsmob_music (m))
-    {
-      SCM ss =  unsmob_music (m)->clone ()->self_scm ();
-      scm_gc_unprotect_object (ss);
-      return ss;
-    }
-  else if (gh_pair_p (m))
-    {
-      return gh_cons (ly_deep_mus_copy (ly_car (m)), ly_deep_mus_copy (ly_cdr (m)));
-    }
-  else
-    return m;
-}
+#include "context.hh"
+#include "dispatcher.hh"
+#include "duration.hh"
+#include "input.hh"
+#include "international.hh"
+#include "ly-smobs.icc"
+#include "main.hh"
+#include "music-sequence.hh"
+#include "score.hh"
+#include "warn.hh"
 
+/*
+  Music is anything that has (possibly zero) duration and supports
+  both time compression and transposition.
 
-Music::Music ()
+  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
 {
-  immutable_property_alist_ = SCM_EOL;
-  mutable_property_alist_ = SCM_EOL;
-  smobify_self ();
+  SCM ifs = get_property ("types");
+
+  return scm_c_memq (k, ifs) != SCM_BOOL_F;
 }
 
-Music::Music (Music const &m)
+Music::Music (SCM init)
+  : Prob (ly_symbol2scm ("Music"), init)
 {
-  immutable_property_alist_ = m.immutable_property_alist_;
-  SCM c =ly_deep_mus_copy (m.mutable_property_alist_);
-  mutable_property_alist_ = c;
+  length_callback_ = SCM_EOL;
+  start_callback_ = SCM_EOL;
 
-  smobify_self ();
+  length_callback_ = get_property ("length-callback");
+  if (!ly_is_procedure (length_callback_))
+    length_callback_ = duration_length_callback_proc;
 
-  set_spot (*m.origin ());
+  start_callback_ = get_property ("start-callback");
 }
 
-
-Music::Music (SCM l)
+void
+Music::derived_mark () const
 {
-  immutable_property_alist_ = l;
-  mutable_property_alist_ = SCM_EOL;
-  smobify_self ();
+  scm_gc_mark (length_callback_);
+  scm_gc_mark (start_callback_);
 }
 
-
 SCM
-Music::mark_smob (SCM m)
+Music::copy_mutable_properties () const
 {
-  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;
+  return ly_music_deep_copy (mutable_property_alist_);
 }
 
-void    
-Music::compress (Moment)
+void
+Music::type_check_assignment (SCM s, SCM v) const
 {
+  ::type_check_assignment (s, v, ly_symbol2scm ("music-type?"));
 }
 
+Music::Music (Music const &m)
+  : Prob (m)
+{
+  length_callback_ = m.length_callback_;
+  start_callback_ = m.start_callback_;
 
+  /// why?
+  set_spot (*m.origin ());
+}
 
 Moment
-Music::length_mom () const
+Music::get_length () const
 {
-  SCM l = get_mus_property ("length");
-  if (unsmob_moment (l))
-    return *unsmob_moment (l);
-  else if (gh_procedure_p (l))
+  SCM lst = get_property ("length");
+  if (unsmob_moment (lst))
+    return *unsmob_moment (lst);
+
+  if (ly_is_procedure (length_callback_))
     {
-      SCM res = gh_call1 (l, self_scm ());
+      SCM res = scm_call_1 (length_callback_, self_scm ());
       return *unsmob_moment (res);
     }
-    
-  return 0;
+
+  return Moment (0);
 }
 
 Moment
 Music::start_mom () const
 {
-  Moment m ;
+  SCM lst = start_callback_;
+  if (ly_is_procedure (lst))
+    {
+      SCM res = scm_call_1 (lst, self_scm ());
+      return *unsmob_moment (res);
+    }
+
+  Moment m;
   return m;
 }
 
 void
 print_alist (SCM a, SCM port)
 {
-  for (SCM s = a; gh_pair_p (s); s = ly_cdr (s))
+  /* SCM_EOL  -> catch malformed lists.  */
+  for (SCM s = a; scm_is_pair (s); s = scm_cdr (s))
     {
-      scm_display (ly_caar (s), port);
-      scm_puts (" = ", port); 
-      scm_write (ly_cdar (s), port);
+      scm_display (scm_caar (s), port);
+      scm_puts (" = ", port);
+      scm_write (scm_cdar (s), port);
       scm_puts ("\n", 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_puts (classname (m),p);
-
-  print_alist (m->mutable_property_alist_, p);
-  print_alist (m->immutable_property_alist_, p);
-  
-  scm_puts (">",p);
-  return 1;
+  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;
+    }
+
+  if (Music *m = unsmob_music (elt))
+    last = m->to_relative_octave (last);
+
+  (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 m)
+Music::to_relative_octave (Pitch last)
 {
-  return m;
-}
+  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;
+    }
 
+  return generic_to_relative_octave (last);
+}
 
 void
-Music::transpose (Pitch)
+Music::compress (Moment factor)
 {
-}
-
-IMPLEMENT_TYPE_P (Music, "music?");
+  SCM elt = get_property ("element");
 
-IMPLEMENT_SMOBS (Music);
-IMPLEMENT_DEFAULT_EQUAL_P (Music);
+  if (Music *m = unsmob_music (elt))
+    m->compress (factor);
 
-/****************************/
-
-SCM
-Music::internal_get_mus_property (SCM sym) const
-{
-  SCM s = scm_sloppy_assq (sym, mutable_property_alist_);
-  if (s != SCM_BOOL_F)
-    return ly_cdr (s);
-
-  s = scm_sloppy_assq (sym, immutable_property_alist_);
-  return (s == SCM_BOOL_F) ? SCM_EOL : ly_cdr (s); 
+  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 ());
 }
 
-#if 0
 /*
-  Remove the value associated with KEY, and return it. The result is
-  that a next call will yield SCM_EOL (and not the underlying
-  `basic' property.
+  This mutates alist.  Hence, make sure that it is not shared
 */
-SCM
-Music::remove_mus_property (const char* key)
-{
-  SCM val = get_mus_property (key);
-  if (val != SCM_EOL)
-    set_mus_property (key, SCM_EOL);
-  return val;
-}
-
-SCM
-Music::get_mus_property (const char *nm) const
-{
-  SCM sym = ly_symbol2scm (nm);
-  return get_mus_property (sym);
-}
-
 void
-Music::set_mus_property (const char* k, SCM v)
+transpose_mutable (SCM alist, Pitch delta)
 {
-  SCM s = ly_symbol2scm (k);
-  set_mus_property (s, v);
+  for (SCM s = alist; scm_is_pair (s); s = scm_cdr (s))
+    {
+      SCM entry = scm_car (s);
+      SCM prop = scm_car (entry);
+      SCM val = scm_cdr (entry);
+      SCM new_val = val;
+
+      if (Pitch *p = unsmob_pitch (val))
+        {
+          Pitch transposed = p->transposed (delta);
+          if (transposed.get_alteration ().abs () > Rational (1, 1))
+            {
+              string delta_str;
+              if (delta.get_alteration ().abs () > Rational (1, 1))
+                delta_str = (delta.normalized ().to_string ()
+                             + " " + _ ("(normalized pitch)"));
+              else
+                delta_str = delta.to_string ();
+
+              warning (_f ("Transposing %s by %s makes alteration larger than double",
+                           p->to_string (),
+                           delta_str));
+              transposed = transposed.normalized ();
+            }
+
+          if (prop == ly_symbol2scm ("tonic"))
+            transposed = Pitch (-1, transposed.get_notename (),
+                                transposed.get_alteration ());
+
+          new_val = transposed.smobbed_copy ();
+        }
+      else if (prop == ly_symbol2scm ("element"))
+        {
+          if (Music *m = unsmob_music (val))
+            m->transpose (delta);
+        }
+      else if (prop == ly_symbol2scm ("elements")
+               || prop == ly_symbol2scm ("articulations"))
+        transpose_music_list (val, delta);
+      else if (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);
+    }
 }
 
 void
-Music::set_immutable_mus_property (SCM s, SCM v)
+Music::transpose (Pitch delta)
 {
-  immutable_property_alist_ = gh_cons (gh_cons (s,v), mutable_property_alist_);
-  mutable_property_alist_ = scm_assq_remove_x (mutable_property_alist_, s);
-}
-#endif
+  if (to_boolean (get_property ("untransposable")))
+    return;
 
-void
-Music::internal_set_mus_property (SCM s, SCM v)
-{
-  mutable_property_alist_ = scm_assq_set_x (mutable_property_alist_, s, v);
+  transpose_mutable (mutable_property_alist_, delta);
 }
 
-#include "main.hh"
-
 void
 Music::set_spot (Input ip)
 {
-  set_mus_property ("origin", make_input (ip));
+  set_property ("origin", make_input (ip));
 }
 
-
-
-Input*
+Input *
 Music::origin () const
 {
-  Input *ip = unsmob_input (get_mus_property ("origin"));
-  return ip ? ip : & dummy_input_global; 
+  Input *ip = unsmob_input (get_property ("origin"));
+  return ip ? ip : &dummy_input_global;
 }
 
-
-
-
-
-Music::~Music ()
+/*
+  ES TODO: This method should probably be reworked or junked.
+*/
+Stream_event *
+Music::to_event (Context *c) const
 {
-  
-}
-
-SCM
-ly_get_mus_property (SCM mus, SCM sym)
-{
-  Music * sc = unsmob_music (mus);
-  
-  if (sc)
-    {
-      return sc->internal_get_mus_property (sym);
-    }
-  else
-    {
-      warning (_ ("ly_get_mus_property (): Not a Music"));
-      scm_write (mus, scm_current_error_port ());
-    }
-  return SCM_EOL;
-}
+  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");
 
-SCM
-ly_set_mus_property (SCM mus, SCM sym, SCM val)
-{
-  Music * sc = unsmob_music (mus);
+  Stream_event *e = new Stream_event (c->make_event_class (class_name),
+                                      mutable_property_alist_);
+  Moment length = get_length ();
+  if (length.to_bool ())
+    e->set_property ("length", length.smobbed_copy ());
 
-  if (!gh_symbol_p (sym))
+  // articulations as events.
+  SCM art_mus = e->get_property ("articulations");
+  if (scm_is_pair (art_mus))
     {
-      warning (_ ("ly_set_mus_property (): Not a symbol"));
-      scm_write (mus, scm_current_error_port ());      
-
-      return SCM_UNSPECIFIED;
+      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 (c)->unprotect (), art_ev);
+        }
+      e->set_property ("articulations", scm_reverse_x (art_ev, SCM_EOL));
     }
 
-  if (sc)
-    {
-      sc->internal_set_mus_property (sym, val);
-    }
-  else
-    {
-      warning (_ ("ly_set_mus_property ():  not of type Music"));
-      scm_write (mus, scm_current_error_port ());
-    }
+  /*
+    ES TODO: This is a temporary fix. Stream_events should not be
+    aware of music.
+  */
+  e->set_property ("music-cause", self_scm ());
 
-  return SCM_UNSPECIFIED;
+  return e;
 }
 
+void
+Music::send_to_context (Context *c)
+{
+  Stream_event *ev = to_event (c);
+  c->event_source ()->broadcast (ev);
+  ev->unprotect ();
+}
 
-// to do  property args 
-SCM
-ly_make_music (SCM type)
+Music *
+make_music_by_name (SCM sym)
 {
-  if (!gh_string_p (type))
-    {
-      warning (_ ("ly_make_music (): Not a string"));
-      scm_write (type, scm_current_error_port ());      
+  SCM make_music_proc = ly_lily_module_constant ("make-music");
+  SCM rv = scm_call_1 (make_music_proc, sym);
 
-      return SCM_UNSPECIFIED;
-    }
-  else
-    {
-      SCM s =       get_music (ly_scm2string (type))->self_scm ();
-      scm_gc_unprotect_object (s);
-      return s;
-    }
+  /* UGH. */
+  Music *m = unsmob_music (rv);
+  m->protect ();
+  return m;
 }
 
+MAKE_SCHEME_CALLBACK (Music, duration_length_callback, 1);
 SCM
-ly_music_name (SCM mus)
+Music::duration_length_callback (SCM m)
 {
-  Music * m = unsmob_music (mus);
-  const char *nm ="";
-  if (!m)
-    {
-      warning (_ ("ly_music_name (): Not a music expression"));
-      scm_write (mus, scm_current_error_port ());      
-    }
-   else
-     nm = classname (m);
-   return ly_str02scm (nm);
+  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 ();
 }
 
-static void
-init_functions ()
+Music *
+unsmob_music (SCM m)
 {
-  scm_c_define_gsubr ("ly-get-mus-property", 2, 0, 0, (Scheme_function_unknown)ly_get_mus_property);
-  scm_c_define_gsubr ("ly-set-mus-property", 3, 0, 0, (Scheme_function_unknown)ly_set_mus_property);
-  scm_c_define_gsubr ("ly-make-music", 1, 0, 0, (Scheme_function_unknown)ly_make_music);
-  scm_c_define_gsubr ("ly-music-name", 1, 0, 0, (Scheme_function_unknown)ly_music_name);    
+  return dynamic_cast<Music *> (unsmob_prob (m));
 }
-ADD_SCM_INIT_FUNC (musicscm,init_functions);
-ADD_MUSIC(Music);