]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/music-functions.scm
Add regtest for Fix for #435.
[lilypond.git] / scm / music-functions.scm
index c4bfa93d18afb11f0c915049a8628745dde136f3..c700f190dbc5f287b2999a6047be3c436e733d0a 100644 (file)
@@ -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
@@ -351,6 +360,17 @@ i.e.  this is not an override"
                                             (if (odd? n) -1 1)))
         direction-polyphonic-grobs)
     (list
+     (make-property-set 'graceSettings
+                       ;; TODO: take this from voicedGraceSettings or similar.
+                       '((Voice Stem font-size -3)
+                         (Voice NoteHead font-size -3)
+                         (Voice Dots font-size -3)
+                         (Voice Stem length-fraction 0.8)
+                         (Voice Stem no-stem-extend #t)
+                         (Voice Beam thickness 0.384)
+                         (Voice Beam length-fraction 0.8)
+                         (Voice Accidental font-size -4)))
+    
      (make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2))
      (make-grob-property-set 'MultiMeasureRest 'staff-position (if (odd? n) -4 4)))))) 
 
@@ -359,8 +379,9 @@ i.e.  this is not an override"
    (append
     (map (lambda (x) (make-grob-property-revert x 'direction))
         direction-polyphonic-grobs)
-    (list (make-grob-property-revert 'NoteColumn 'horizontal-shift))
-    (list (make-grob-property-revert 'MultiMeasureRest 'staff-position)))))
+    (list (make-property-unset 'graceSettings)
+         (make-grob-property-revert 'NoteColumn 'horizontal-shift)
+         (make-grob-property-revert 'MultiMeasureRest 'staff-position)))))
 
 
 (define-safe-public (context-spec-music m context #:optional id)
@@ -429,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)))
 
@@ -573,9 +587,8 @@ of beat groupings "
 
 (define-public (empty-music)
   (ly:export (make-music 'Music)))
-;;;
 
-                                       ; Make a function that checks score element for being of a specific type. 
+;; Make a function that checks score element for being of a specific type. 
 (define-public (make-type-checker symbol)
   (lambda (elt)
     ;;(display symbol)
@@ -625,6 +638,21 @@ SkipEvent. Useful for extracting parts from crowded scores"
    mus))
 
 
+(define-public (music-has-type music type)
+  (memq type (ly:music-property music 'types)))
+
+(define-public (music-clone music)
+  (define (alist->args alist acc)
+    (if (null? alist)
+       acc
+       (alist->args (cdr alist)
+                    (cons (caar alist) (cons (cdar alist) acc)))))
+
+  (apply
+   make-music
+   (ly:music-property music 'name)
+   (alist->args (ly:music-mutable-properties music) '())))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; warn for bare chords at start.
 
@@ -920,11 +948,14 @@ use GrandStaff as a context. "
                                   '(Staff (any-octave . 0) (same-octave . 1)
                                           GrandStaff (any-octave . 0) (same-octave . 1))
                                   pcontext))
+      
       ;; do not set localKeySignature when a note alterated differently from
       ;; localKeySignature is found.
       ;; Causes accidentals to be printed at every note instead of
       ;; remembered for the duration of a measure.
-      ;; accidentals not being remembered, causing accidentals always to be typeset relative to the time signature
+      ;; accidentals not being remembered, causing accidentals always to
+      ;; be typeset relative to the time signature
+      
       ((equal? style 'forget)
        (set-accidentals-properties '()
                                   '(Staff (same-octave . -1))