Fix #765: Display method for \ottava.

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

diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index 9f173ff7641d6544e73852dddc47e232a9fa32e9..40c68c0c7d3942b002a0325604086f7aab665dcc 100644 (file)
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -48,6 +48,10 @@
   (make-procedure-with-setter ly:prob-property
                              ly:prob-set-property!))
 
+(define-public ly:context-property
+  (make-procedure-with-setter ly:context-property
+                             ly:context-set-property!))
+
 (define-public (music-map function music)
   "Apply @var{function} to @var{music} and all of the music it contains.
 
@@ -265,9 +269,14 @@ through MUSIC."
     (set! (ly:music-property r 'element) main)
     (set! (ly:music-property r 'repeat-count) (max times 1))
     (set! (ly:music-property r 'elements) talts)
-    (if (and (equal? name "tremolo") (> (length (ly:music-property main 'elements)) 0))
+    (if (and (equal? name "tremolo")
+            (pair? (ly:music-property main 'elements)))
        ;; This works for single-note and multi-note tremolos!
-       (let* ((children (length (ly:music-property main 'elements)))
+       (let* ((children (if (music-is-of-type? main 'sequential-music)
+                            ;; \repeat tremolo n { ... }
+                            (length (ly:music-property main 'elements))
+                            ;; \repeat tremolo n c4
+                            1))
               ;; # of dots is equal to the 1 in bitwise representation (minus 1)!
               (dots (1- (logcount (* times children))))
               ;; The remaining missing multiplicator to scale the notes by 
@@ -282,7 +291,6 @@ through MUSIC."
          (set! (ly:music-property r 'tremolo-type) tremolo-type)
          (if (not (integer?  mult))
               (ly:warning (_ "invalid tremolo repeat count: ~a") times))
-         ;; \repeat tremolo n c4
          ;; Adjust the time of the notes
          (ly:music-compress r (ly:make-moment 1 children))
          ;; Adjust the displayed note durations
@@ -483,32 +491,6 @@ i.e.  this is not an override"
   (make-music 'PropertyUnset
              'symbol sym))
 
-(define-public (make-ottava-set octavation)
-  (let ((m (make-music 'ApplyContext)))
-    (define (ottava-modify context)
-      "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 '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 (assoc-get 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)))
-
-(define-public (set-octavation ottavation)
-  (ly:export (make-ottava-set ottavation)))
-
 ;;; Need to keep this definition for \time calls from parser
 (define-public (make-time-signature-set num den)
   "Set properties for time signature NUM/DEN."
@@ -517,8 +499,8 @@ OTTAVATION to `8va', or whatever appropriate."
 ;;; Used for calls that include beat-grouping setting
 (define-public (set-time-signature num den . rest)
   "Set properties for time signature @var{num/den}.
-If @var{rest} is present, it is used to make a default
-@code{beamSetting} rule."
+If @var{rest} is present, it is used to set
+@code{beatStructure}."
  (ly:export (apply make-beam-rule-time-signature-set
                     (list num den rest))))
 
@@ -526,30 +508,32 @@ If @var{rest} is present, it is used to make a default
   "Implement settings for new time signature.  Can be
 called from either make-time-signature-set (used by \time
 in parser) or set-time-signature (called from scheme code
-included in .ly file."
-
-  (define (make-default-beaming-rule context)
-   (override-property-setting
-    context
-    'beamSettings
-    (list (cons num den) 'end)
-    (list (cons '* (car rest)))))
-
-  (let* ((set1 (make-property-set 'timeSignatureFraction (cons num den)))
-        (beat (ly:make-moment 1 den))
-        (len  (ly:make-moment num den))
-        (set2 (make-property-set 'beatLength beat))
-        (set3 (make-property-set 'measureLength len))
-         (beaming-rule
-          (if (null? rest)
-              '()
-              (list (make-apply-context make-default-beaming-rule))))
-         (output (cons* set1 set2 set3 beaming-rule)))
-    (descend-to-context
-     (context-spec-music
-      (make-sequential-music output)
-       'Timing)
-     'Score)))
+included in .ly file)."
+
+  (let ((m (make-music 'ApplyContext)))
+    (define (make-time-settings context)
+      (let* ((fraction (cons num den))
+             (time-signature-settings (ly:context-property context 'timeSignatureSettings))
+             (my-base-fraction (base-fraction fraction time-signature-settings))
+             (my-beat-structure (if (null? rest)
+                                    (beat-structure my-base-fraction
+                                                    fraction
+                                                    time-signature-settings)
+                                    (car rest)))
+             (beaming-exception
+               (beam-exceptions fraction time-signature-settings))
+            (new-measure-length (ly:make-moment num den)))
+         (ly:context-set-property! context 'timeSignatureFraction fraction)
+         (ly:context-set-property!
+           context 'baseMoment (fraction->moment my-base-fraction))
+         (ly:context-set-property! context 'beatStructure my-beat-structure)
+         (ly:context-set-property! context 'beamExceptions beaming-exception)
+         (ly:context-set-property! context 'measureLength new-measure-length)))
+     (set! (ly:music-property m 'procedure) make-time-settings)
+     (descend-to-context
+      (context-spec-music m 'Timing)
+      'Score)))
+
 
 (define-public (make-mark-set label)
   "Make the music for the \\mark command."