IR: Fix index node hierarchy

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

diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index 928eaf71692a5cf06c4f58fd480e3f7c290fab22..7b2cc3404f6d27e5b90e1821b98381b24fa5db9e 100644 (file)
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -2,7 +2,7 @@
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 
-;;;; (c) 1998--2006 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; (c) 1998--2007 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;;                 Han-Wen Nienhuys <hanwen@xs4all.nl>
 
 ;; (use-modules (ice-9 optargs)) 
@@ -233,13 +233,11 @@ Returns `obj'.
     (set! (ly:music-property r 'repeat-count) (max times 1))
     (set! (ly:music-property r 'elements) talts)
     (if (equal? name "tremolo")
-       (let* ((dot? (zero? (modulo times 3)))
-              (dots (if dot? 1 0))
-              (mult (if dot?
-                        (quotient (* times 2) 3)
-                        times))
-              (shift (- (ly:intlog2 mult))))
-         
+       (let* ((dots (1- (logcount times)))
+              (mult (/ (* times (ash 1 dots)) (1- (ash 2 dots))))
+              (shift (- (ly:intlog2 (floor mult)))))
+         (if (not (integer?  mult))
+              (ly:warning (_ "invalid tremolo repeat count: ~a") times))
          (if (memq 'sequential-music (ly:music-property main 'types))
              ;; \repeat "tremolo" { c4 d4 }
              (let ((children (length (ly:music-property main 'elements))))
@@ -342,7 +340,18 @@ i.e.  this is not an override"
              'grob-property gprop))
 
 (define direction-polyphonic-grobs
-  '(Stem Tie Rest Slur PhrasingSlur Script TextScript Dots DotColumn Fingering))
+  '(DotColumn
+    Dots
+    Fingering
+    LaissezVibrerTie
+    PhrasingSlur
+    RepeatTie
+    Rest
+    Script
+    Slur
+    Stem
+    TextScript
+    Tie))
 
 (define-safe-public (make-voice-props-set n)
   (make-sequential-music
@@ -441,27 +450,20 @@ i.e.  this is not an override"
       "Either reset middleCPosition to the stored original, or remember
 old middleCPosition, add OCTAVATION to middleCPosition, and set
 OTTAVATION to `8va', or whatever appropriate."     
-      (if (number? (ly:context-property         context 'middleCPosition))
-         (begin
-           (if (number? (ly:context-property context 'originalMiddleCPosition))
-               (let ((where (ly:context-property-where-defined context 'middleCPosition)))
-                 
-                 (ly:context-set-property! context 'middleCPosition
-                                           (ly:context-property context 'originalMiddleCPosition))
-                 (ly:context-unset-property where 'originalMiddleCPosition)
-                 (ly:context-unset-property where 'ottavation)))
-ot         
-           (let* ((where (ly:context-property-where-defined context 'middleCPosition))
-                  (c0 (ly:context-property context 'middleCPosition))
-                  (new-c0 (+ c0 (* -7 octavation)))
-                  (string (cdr (assoc octavation '((2 . "15ma")
-                                                   (1 . "8va")
-                                                   (0 . #f)
-                                                   (-1 . "8vb")
-                                                   (-2 . "15mb"))))))
-             (ly:context-set-property! context 'middleCPosition new-c0)
-             (ly:context-set-property! context 'originalMiddleCPosition c0)
-             (ly:context-set-property! context 'ottavation string)))))
+      (if (number? (ly:context-property         context 'middleCOffset))
+         (let ((where (ly:context-property-where-defined context 'middleCOffset)))
+           (ly:context-unset-property where 'middleCOffset)
+           (ly:context-unset-property where 'ottavation)))
+
+      (let* ((offset (* -7 octavation))
+            (string (cdr (assoc octavation '((2 . "15ma")
+                                             (1 . "8va")
+                                             (0 . #f)
+                                             (-1 . "8vb")
+                                             (-2 . "15mb"))))))
+       (ly:context-set-property! context 'middleCOffset offset)
+       (ly:context-set-property! context 'ottavation string)
+       (ly:set-middle-C! context)))
     (set! (ly:music-property m 'procedure) ottava-modify)
     (context-spec-music m 'Staff)))
 
@@ -687,7 +689,6 @@ SkipEvent. Useful for extracting parts from crowded scores"
       ((< i 0))
     (f (vector-ref v i))))
 
-;; TODO:  make a remove-grace-property too.
 (define-public (add-grace-property context-name grob sym val)
   "Set SYM=VAL for GROB in CONTEXT-NAME. "
   (define (set-prop context)
@@ -698,6 +699,25 @@ SkipEvent. Useful for extracting parts from crowded scores"
       (ly:context-set-property! where 'graceSettings new-settings)))
   (ly:export (context-spec-music (make-apply-context set-prop) 'Voice)))
 
+(define-public (remove-grace-property context-name grob sym)
+  "Remove all SYM for GROB in CONTEXT-NAME. "
+  (define (sym-grob-context? property sym grob context-name)
+    (and (eq? (car property) context-name)
+         (eq? (cadr property) grob)
+         (eq? (caddr property) sym)))
+  (define (delete-prop context)
+    (let* ((where (ly:context-property-where-defined context 'graceSettings))
+          (current (ly:context-property where 'graceSettings))
+           (prop-settings (filter 
+                            (lambda(x) (sym-grob-context? x sym grob context-name))
+                            current)) 
+          (new-settings current))
+      (for-each (lambda(x) 
+                 (set! new-settings (delete x new-settings)))
+               prop-settings)
+      (ly:context-set-property! where 'graceSettings new-settings)))
+  (ly:export (context-spec-music (make-apply-context delete-prop) 'Voice)))
+
 
 
 (defmacro-public def-grace-function (start stop)
@@ -1000,3 +1020,34 @@ use GrandStaff as a context. "
        (ly:music-property (car evs) 'pitch)
        #f)))
        
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-public (extract-named-music music music-name)
+"Return a flat list of all music named @code{music-name}
+from @code{music}."
+   (let ((extracted-list
+          (if (ly:music? music)
+              (if (eq? (ly:music-property music 'name) music-name)
+                  (list music)
+                  (let ((elt (ly:music-property music 'element))
+                        (elts (ly:music-property music 'elements)))
+                    (if (ly:music? elt)
+                        (extract-named-music elt music-name)
+                        (if (null? elts)
+                            '()
+                            (map (lambda(x) 
+                                    (extract-named-music x music-name ))
+                             elts)))))
+              '())))
+     (flatten-list extracted-list)))
+
+(define-public (event-chord-notes event-chord)
+"Return a list of all notes from @{event-chord}."
+  (filter
+    (lambda (m) (eq? 'NoteEvent (ly:music-property m 'name)))
+    (ly:music-property event-chord 'elements)))
+
+(define-public (event-chord-pitches event-chord)
+"Return a list of all pitches from @{event-chord}."
+  (map (lambda (x) (ly:music-property x 'pitch))
+       (event-chord-notes event-chord)))