X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Fmusic-scheme.cc;h=dc01ff7e4c8260e8ba5268a0b3787c60ed6ca438;hb=c93997ee6226dae036e411b39e5af873b8726293;hp=672e6f022ec3eeee16c12994d7c8b40b1379e157;hpb=eea589c2d7bee6ab38bc611eb205d4c74e2011f7;p=lilypond.git

diff --git a/lily/music-scheme.cc b/lily/music-scheme.cc
index 672e6f022e..dc01ff7e4c 100644
--- a/lily/music-scheme.cc
+++ b/lily/music-scheme.cc
@@ -1,5 +1,5 @@
 /*
-  music-scheme.cc --  implement
+  music-scheme.cc -- implement Music bindings
 
   source file of the GNU LilyPond music typesetter
 
@@ -7,6 +7,8 @@
 
 */
 
+#include "duration.hh"
+#include "warn.hh"
 #include "music.hh"
 #include "pitch.hh"
 
@@ -53,7 +55,7 @@ LY_DEFINE (ly_music_name, "ly:music-name",
 	   "Return the name of @var{music}.")
 {
   Music *m = unsmob_music (mus);
-  SCM_ASSERT_TYPE (m, mus, SCM_ARG1, __FUNCTION__ ,"music");
+  SCM_ASSERT_TYPE (m, mus, SCM_ARG1, __FUNCTION__ , "music");
 
   char const *nm = classname (m);
   return scm_makfrom0str (nm);
@@ -71,8 +73,7 @@ LY_DEFINE (ly_extended_make_music, "ly:make-bare-music",
 	  )
 {
   SCM_ASSERT_TYPE (scm_is_string (type), type, SCM_ARG1, __FUNCTION__, "string");
-  SCM s = make_music (ly_scm2string (type))->self_scm ();
-  unsmob_music (s)->immutable_property_alist_ = props;
+  SCM s = make_music (ly_scm2string (type), props)->self_scm ();
   scm_gc_unprotect_object (s);
   return s;
 }
@@ -90,7 +91,7 @@ LY_DEFINE (ly_music_mutable_properties, "ly:music-mutable-properties",
   return m->get_property_alist (true);
 }
 
-LY_DEFINE (ly_music_list_p,"ly:music-list?",
+LY_DEFINE (ly_music_list_p, "ly:music-list?",
 	   1, 0, 0, (SCM lst),
 	   "Type predicate: return true if @var{lst} is a list "
 	   "of music objects.")
@@ -154,3 +155,86 @@ LY_DEFINE (ly_music_compress, "ly:music-compress",
   return sc->self_scm ();
 }
 
+LY_DEFINE (ly_music_duration_length, "ly:music-duration-length", 1, 0, 0,
+	  (SCM mus),
+	  "Extract the duration field from @var{mus}, and return the length.")
+{
+  Music* m =   unsmob_music (mus);
+  SCM_ASSERT_TYPE (m, mus, SCM_ARG1, __FUNCTION__, "Music");
+  
+  Duration *d = unsmob_duration (m->get_property ("duration"));
+
+  Moment l ;
+  
+  if (d)
+    {
+      l = d->get_length ();  
+    }
+  else
+    programming_error ("Music has no duration");
+  return l.smobbed_copy ();
+  
+}
+
+
+LY_DEFINE (ly_music_duration_compress, "ly:music-duration-compress", 2, 0, 0,
+	  (SCM mus, SCM fact),
+	  "Compress @var{mus} by factor @var{fact}, which is a @code{Moment}.")
+{
+  Music* m =   unsmob_music (mus);
+  Moment * f = unsmob_moment (fact);
+  SCM_ASSERT_TYPE (m, mus, SCM_ARG1, __FUNCTION__, "Music");
+  SCM_ASSERT_TYPE (f, fact, SCM_ARG2, __FUNCTION__, "Moment");
+  
+  Duration *d = unsmob_duration (m->get_property ("duration"));
+  if (d)
+    m->set_property ("duration", d->compressed (f->main_part_).smobbed_copy ());
+  return SCM_UNSPECIFIED;
+}
+
+
+
+/*
+  This is hairy, since the scale in a key-change event may contain
+  octaveless notes.
+
+
+  TODO: this should use ly:pitch. 
+ */
+LY_DEFINE (ly_transpose_key_alist, "ly:transpose-key-alist",
+	  2, 0, 0, (SCM l, SCM pit),
+	  "Make a new key alist of @var{l} transposed by pitch @var{pit}")
+{
+  SCM newlist = SCM_EOL;
+  Pitch *p = unsmob_pitch (pit);
+  
+  for (SCM s = l; scm_is_pair (s); s = scm_cdr (s))
+    {
+      SCM key = scm_caar (s);
+      SCM alter = scm_cdar (s);
+      if (scm_is_pair (key))
+	{
+	  Pitch orig (scm_to_int (scm_car (key)),
+		      scm_to_int (scm_cdr (key)),
+		      scm_to_int (alter));
+
+	  orig = orig.transposed (*p);
+
+	  SCM key = scm_cons (scm_int2num (orig.get_octave ()),
+			     scm_int2num (orig.get_notename ()));
+
+	  newlist = scm_cons (scm_cons (key, scm_int2num (orig.get_alteration ())),
+			     newlist);
+	}
+      else if (scm_is_number (key))
+	{
+	  Pitch orig (0, scm_to_int (key), scm_to_int (alter));
+	  orig = orig.transposed (*p);
+
+	  key = scm_int2num (orig.get_notename ());
+	  alter = scm_int2num (orig.get_alteration ());
+	  newlist = scm_cons (scm_cons (key, alter), newlist);
+	}
+    }
+  return scm_reverse_x (newlist, SCM_EOL);
+}