* VERSION (MY_PATCH_LEVEL): make 1.7.0

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

diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index 81d56d38819a983a9039c6c72fb553971e601617..72f3635608a29caaf610fcc018aa144b930d4e80 100644 (file)
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -7,7 +7,46 @@
                 ":"
                 (number->string (ly-get-mus-property mus 'denominator))
                 ))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(define (shift-duration-log music shift dot)
+  "Recurse through music, adding SHIFT to duration-log and optionally 
+  a dot to any note encountered. This scales the music up by a factor 
+  2^shift * (2 - (1/2)^dot)"
+  (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 dot)))
+        )
+    (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))
+                                 (+ dot (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 
@@ -15,27 +54,31 @@ written by Rune Zedeler. "
   (let* ((es (ly-get-mus-property music 'elements))
          (e (ly-get-mus-property music 'element))
          (n  (ly-music-name music)))
-
+ 
     (if (equal? n "Repeated_music")
         (begin
-          (ly-set-mus-property
+         (if (equal?
+              (ly-get-mus-property music 'iterator-ctor)
+              Chord_tremolo_iterator::constructor)
+             (shift-duration-log music  (intlog2 (ly-get-mus-property music 'repeat-count)) 0)
+             )
+          (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 +102,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 +129,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 +142,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 +175,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 +250,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 +266,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,11 +300,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))
@@ -276,8 +313,7 @@ Called  from parser.
         ((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")
@@ -286,6 +322,20 @@ Please insert an explicit \\context before chord")
          (else (if (music? e) (check-start-chords e )))
        
        ))
-
      music
      )
+
+
+;; switch it on here, so parsing and init isn't checked (too slow!)
+
+(define (switch-on-debugging m)
+  (set-debug-cell-accesses! 15000)
+  m
+  )
+
+(define toplevel-music-functions
+  (list check-start-chords
+       voicify-music
+
+; switch-on-debugging
+       ))