* lily/music.cc (LY_DEFINE): change ly-set-mus-property to

[lilypond.git] / scm / music-functions.scm

diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index 8eca9bea4585d24d279fff2065f09fcf856cfd41..d4534a7b413205ae3af7d2ca9a897d5f36b63e82 100644 (file)
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -7,7 +7,45 @@
                 ":"
                 (number->string (ly-get-mus-property mus 'denominator))
                 ))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(define (shift-duration-log music shift )
+  "Recurse through music, adding SHIFT to duration-log to any note
+encountered. This scales the music up by a factor 2^k."
+  (let* ((es (ly-get-mus-property music 'elements))
+         (e (ly-get-mus-property music 'element))
+         (n  (ly-music-name music))
+        (f  (lambda (x)  (shift-duration-log x shift)))
+        )
+    (if (or (equal? n "Note_req")
+           (equal? n "Rest_req"))
+       (let* (
+             (d (ly-get-mus-property music 'duration))
+             (cp (duration-factor d))
+             (nd (make-duration (+ shift (duration-log d))
+                                (duration-dot-count d)
+                                (car cp)
+                                (cdr cp)))
+         
+             )
+         (ly-set-mus-property! music 'duration nd)
+       ))
+
+    (if (pair? es)
+        (ly-set-mus-property!
+         music 'elements
+         (map f es)))
+
+    (if (music? e)
+        (ly-set-mus-property!
+         music 'element
+         (f e)))
 
+    music))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (unfold-repeats music)
 "
 This function replaces all repeats  with unfold repeats. It was 
@@ -18,24 +56,26 @@ written by Rune Zedeler. "
 
     (if (equal? n "Repeated_music")
         (begin
-          (ly-set-mus-property
+         (if (equal? (ly-get-mus-property 'type music) 'tremolo)
+             (shift-duration-log music (- (intlog2 (ly-get-mus-property 'repeat-count music))))
+             )
+          (ly-set-mus-property!
            music 'length Repeated_music::unfolded_music_length)
-         (ly-set-mus-property
+         (ly-set-mus-property!
           music 'start-moment-function Repeated_music::first_start)
-          (ly-set-mus-property
+          (ly-set-mus-property!
            music 'iterator-ctor Unfolded_repeat_iterator::constructor)))
 
     (if (pair? es)
-        (ly-set-mus-property
+        (ly-set-mus-property!
          music 'elements
          (map unfold-repeats es)))
 
     (if (music? e)
-        (ly-set-mus-property
+        (ly-set-mus-property!
          music 'element
          (unfold-repeats e)))
 
-
     music))
 
 
@@ -59,16 +99,16 @@ Fingering_engraver."
         )
 
     (if pitch
-       (map (lambda (x) (ly-set-mus-property x 'pitch pitch)) (find-scripts es))
+       (map (lambda (x) (ly-set-mus-property! x 'pitch pitch)) (find-scripts es))
        )
        
     (if (pair? es)
-        (ly-set-mus-property
+        (ly-set-mus-property!
          music 'elements
          (map pitchify-scripts es)))
 
     (if (music? e)
-        (ly-set-mus-property
+        (ly-set-mus-property!
          music 'element
          (pitchify-scripts e)))
 
@@ -86,11 +126,11 @@ this is not an override
 "
   
    (let* ((m (ly-make-music  "Music")))
-     (ly-set-mus-property m 'iterator-ctor Push_property_iterator::constructor)
-     (ly-set-mus-property m 'symbol grob)
-     (ly-set-mus-property m 'grob-property gprop)
-     (ly-set-mus-property m 'grob-value val)
-     (ly-set-mus-property m 'pop-first #t)
+     (ly-set-mus-property! m 'iterator-ctor Push_property_iterator::constructor)
+     (ly-set-mus-property! m 'symbol grob)
+     (ly-set-mus-property! m 'grob-property gprop)
+     (ly-set-mus-property! m 'grob-value val)
+     (ly-set-mus-property! m 'pop-first #t)
                
      m
    
@@ -99,9 +139,9 @@ this is not an override
 (define (make-grob-property-revert grob gprop)
   "Revert the grob property GPROP for GROB."
    (let* ((m (ly-make-music  "Music")))
-     (ly-set-mus-property m 'iterator-ctor Pop_property_iterator::constructor)
-     (ly-set-mus-property m 'symbol grob)
-     (ly-set-mus-property m 'grob-property gprop)
+     (ly-set-mus-property! m 'iterator-ctor Pop_property_iterator::constructor)
+     (ly-set-mus-property! m 'symbol grob)
+     (ly-set-mus-property! m 'grob-property gprop)
                
      m
    
@@ -132,22 +172,22 @@ this is not an override
   "Add \context CONTEXT = foo to M. "
   
   (let* ((cm (ly-make-music "Context_specced_music")))
-    (ly-set-mus-property cm 'element m)
-    (ly-set-mus-property cm 'context-type context)
+    (ly-set-mus-property! cm 'element m)
+    (ly-set-mus-property! cm 'context-type context)
     (if (and  (pair? rest) (string? (car rest)))
-       (ly-set-mus-property cm 'context-id (car rest))
+       (ly-set-mus-property! cm 'context-id (car rest))
     )
     cm
   ))
 
 (define (make-sequential-music elts)
   (let*  ((m (ly-make-music "Sequential_music")))
-    (ly-set-mus-property m 'elements elts)
+    (ly-set-mus-property! m 'elements elts)
     m
   ))
 (define (make-simultaneous-music elts)
   (let*  ((m (ly-make-music "Simultaneous_music")))
-    (ly-set-mus-property m 'elements elts)
+    (ly-set-mus-property! m 'elements elts)
     m
     ))
 (define (music-separator? m)
@@ -207,7 +247,7 @@ this is not an override
    (let* ((es (ly-get-mus-property ch 'elements)))
 
 
-     (ly-set-mus-property  ch 'elements
+     (ly-set-mus-property!  ch 'elements
        (voicify-list (split-list es music-separator?) 0))
      ch
    ))
@@ -223,20 +263,17 @@ this is not an override
        ((es (ly-get-mus-property m 'elements))
        (e (ly-get-mus-property m 'element))
        )
-       
+     (if (pair? es)
+        (ly-set-mus-property! m 'elements (map voicify-music es)))
+     (if (music? e)
+        (ly-set-mus-property! m 'element  (voicify-music e)))
      (if
       (and (equal? (ly-music-name m) "Simultaneous_music")
           (reduce (lambda (x y ) (or x y))     (map music-separator? es)))
       (voicify-chord m)
-      (begin
-       (if (pair? es)
-           (ly-set-mus-property m 'elements (map voicify-music es)))
-       (if (music? e)
-           (ly-set-mus-property m 'element  (voicify-music e)))
-           
-       m)
-      
       )
+
+     m
      ))
 
 ;;;
@@ -260,8 +297,8 @@ this is not an override
   ))
   
 (define (check-start-chords music)
-  "Check music expression for a Simultaneous_music containing notes
-(ie. Request_chords), without context specification. Called  from parser."
+  "Check music expression for a Simultaneous_music containing notes\n(ie. Request_chords), without context specification. Called  from parser."
+  
      (let*
        ((es (ly-get-mus-property music 'elements))
        (e (ly-get-mus-property music 'element))
@@ -273,8 +310,7 @@ this is not an override
         ((equal? name "Simultaneous_music")
 
          (if (has-request-chord es)
-             (ly-music-message music "Starting score with a chord.
-Please insert an explicit \\context before chord")
+             (ly-music-message music "Starting score with a chord.\nPlease insert an explicit \\context before chord")
              (map check-start-chords es)))
         
         ((equal? name "Sequential_music")
@@ -283,6 +319,8 @@ Please insert an explicit \\context before chord")
          (else (if (music? e) (check-start-chords e )))
        
        ))
-
      music
      )
+
+
+(define toplevel-music-functions (list check-start-chords voicify-music))