Issue 4039: Improvements to magnifyMusic and magnifyStaff

Remove redundant scaling when mag factor = 1.
Scale tablature half-note double-stems.
Scale baseline-skip and word-space props.
Add regtests.

diff --git a/input/regression/magnifyMusic-tablature-double-stems.ly b/input/regression/magnifyMusic-tablature-double-stems.ly
new file mode 100644 (file)
index 0000000..35cef69
--- /dev/null
+++ b/input/regression/magnifyMusic-tablature-double-stems.ly
@@ -0,0 +1,20 @@
+\version "2.19.11"
+
+\header {
+  texidoc = "Tablature half-note double-stems should be scaled along
+with notation size when using the @code{\magnifyMusic} command."
+}
+
+<<
+  \new TabVoice = "tabvoice" {
+    \tabFullNotation
+    \magnifyMusic 0.5 { c4 c2 c4 }
+    c4 c2 c4
+    \magnifyMusic 2.0 { c4 c2 c4 }
+  }
+  \new Lyrics \lyricsto "tabvoice" {
+    "50%" _ _
+    "100%" _ _
+    "200%" _ _
+  }
+>>

diff --git a/input/regression/magnifyMusic-text-interface.ly b/input/regression/magnifyMusic-text-interface.ly
new file mode 100644 (file)
index 0000000..3ab2b70
--- /dev/null
+++ b/input/regression/magnifyMusic-text-interface.ly
@@ -0,0 +1,22 @@
+\version "2.19.11"
+
+\header {
+  texidoc = "All text-interface grobs should have
+@w{@code{baseline-skip}} and @w{@code{word-space}} values scaled
+along with notation size when using the @code{\magnifyMusic}
+command."
+}
+
+music = {
+  b'1^\markup {
+    \center-column { a c }
+    \center-column { b d }
+  }
+}
+
+{
+  \override TextScript.baseline-skip = #2
+  \magnifyMusic 0.5 \music
+  \music
+  \magnifyMusic 2.0 \music
+}

diff --git a/input/regression/magnifyStaff-tablature-double-stems.ly b/input/regression/magnifyStaff-tablature-double-stems.ly
new file mode 100644 (file)
index 0000000..651054f
--- /dev/null
+++ b/input/regression/magnifyStaff-tablature-double-stems.ly
@@ -0,0 +1,20 @@
+\version "2.19.11"
+
+\header {
+  texidoc = "Tablature half-note double-stems should be scaled along
+with notation size when using the @code{\magnifyStaff} command."
+}
+
+<<
+  \new TabVoice = "tabvoice" {
+    \tabFullNotation
+    \magnifyStaff 0.5 c4 c2 c4
+    \magnifyStaff 1.0 c4 c2 c4
+    \magnifyStaff 2.0 c4 c2 c4
+  }
+  \new Lyrics \lyricsto "tabvoice" {
+    "50%" _ _
+    "100%" _ _
+    "200%" _ _
+  }
+>>

diff --git a/input/regression/magnifyStaff-text-interface.ly b/input/regression/magnifyStaff-text-interface.ly
new file mode 100644 (file)
index 0000000..e1fd75d
--- /dev/null
+++ b/input/regression/magnifyStaff-text-interface.ly
@@ -0,0 +1,37 @@
+\version "2.19.11"
+
+\header {
+  texidoc = "All text-interface grobs that are within the Staff
+context should have @w{@code{baseline-skip}} and
+@w{@code{word-space}} values scaled along with notation size when
+using the @code{\magnifyStaff} command."
+}
+
+\paper {
+  line-width = 60
+  ragged-right = ##f
+  score-system-spacing = #'((padding . 3))
+}
+
+\layout {
+  \context {
+    \Staff
+    \override TextScript.baseline-skip = 2
+    \override InstrumentName.baseline-skip = 2
+    \override InstrumentName.self-alignment-X = 0.75
+  }
+}
+
+abcd = \markup {
+  \center-column { a c }
+  \center-column { b d }
+}
+
+music = {
+  \set Staff.instrumentName = \markup \abcd
+  b'1^\markup \abcd
+}
+
+\new Staff { \magnifyStaff 0.5 \music }
+\new Staff { \magnifyStaff 1.0 \music }
+\new Staff { \magnifyStaff 2.0 \music }

diff --git a/ly/music-functions-init.ly b/ly/music-functions-init.ly
index 65b4a6db7aff6330e5c55d4d37469c5cafdfb8d8..fea1c9b8884bee6d59a5eb9808b303b3e6d26fb4 100644 (file)
--- a/ly/music-functions-init.ly
+++ b/ly/music-functions-init.ly
@@ -661,22 +661,30 @@ slurs, ties, and horizontal spacing are adjusted automatically.")
 
    ;; these props ARE allowed to shrink below default size
    (define shrinkable-props
-     '(
-       ;; TODO: uncomment spacing-increment here once Issue 3987 is fixed
-       ;; override at the 'Score level
-       ;(SpacingSpanner spacing-increment)
-
-       ;; lengths and heights
-       (Beam length-fraction)
-       (Stem length-fraction)
-       (Stem beamlet-default-length)
-       (Slur height-limit)
-       (Slur minimum-length)
-       (PhrasingSlur height-limit)
-       (PhrasingSlur minimum-length)
-
-       ;; Beam.beam-thickness is dealt with separately below
-       ))
+     (let ((baseline-skip-props
+             (find-named-props 'baseline-skip all-grob-descriptions))
+           (word-space-props
+             (find-named-props 'word-space all-grob-descriptions)))
+       (append
+         baseline-skip-props
+         word-space-props
+         '(
+           ;; TODO: uncomment spacing-increment here once Issue 3987 is fixed
+           ;; override at the 'Score level
+           ;(SpacingSpanner spacing-increment)
+
+           ;; lengths and heights
+           (Beam length-fraction)
+           (Stem length-fraction)
+           (Stem beamlet-default-length)
+           (Stem double-stem-separation)
+           (Slur height-limit)
+           (Slur minimum-length)
+           (PhrasingSlur height-limit)
+           (PhrasingSlur minimum-length)
+
+           ;; Beam.beam-thickness is dealt with separately below
+           ))))
    #{
      \context Bottom {
        %% TODO: uncomment \newSpacingSection once Issue 3990 is fixed
@@ -709,9 +717,15 @@ horizontal spacing automatically, using @var{mag} as a size factor.")
 
    ;; these props ARE allowed to shrink below default size
    (define shrinkable-props
-     (let ((space-alist-props
-            (find-all-space-alist-props all-grob-descriptions)))
+     (let* ((baseline-skip-props
+              (find-named-props 'baseline-skip all-grob-descriptions))
+            (word-space-props
+              (find-named-props 'word-space all-grob-descriptions))
+            (space-alist-props
+              (find-named-props 'space-alist all-grob-descriptions)))
        (append
+         baseline-skip-props
+         word-space-props
          space-alist-props
          '(
            ;; override at the 'Score level
@@ -723,6 +737,7 @@ horizontal spacing automatically, using @var{mag} as a size factor.")
            (BarLine hair-thickness)
            (BarLine thick-thickness)
            (Stem beamlet-default-length)
+           (Stem double-stem-separation)
            ))))
 
    #{
@@ -736,7 +751,8 @@ horizontal spacing automatically, using @var{mag} as a size factor.")
                                                  shrinkable-props))
 
      %% scale settings
-     %% (but only if staff magnification is changing)
+     %% (but only if staff magnification is changing
+     %% and does not equal 1)
      #(scale-fontSize 'magnifyStaff mag)
      #(scale-props    'magnifyStaff mag #f unshrinkable-props)
      #(scale-props    'magnifyStaff mag #t shrinkable-props)

diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index 2638e9997952bb75899a7148f9bc752e30553d63..4a97c1c664f635417366382c51e42891ab209228 100644 (file)
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -2393,25 +2393,39 @@ Offsets are restricted to immutable properties and values of type @code{number},
 
 ;; defined as a function instead of a list because the
 ;; all-grob-descriptions alist is not available yet
-(define-public (find-all-space-alist-props grob-descriptions)
-  "Used by @code{\\magnifyStaff}.  When @var{grob-descriptions} is equal
-to the @code{all-grob-descriptions} alist (defined in
-@file{scm/define-grobs.scm}), this will find all grobs that have an
-initialized value for the @code{space-alist} property, and return them
+(define-public (find-named-props prop-name grob-descriptions)
+  "Used by @code{\\magnifyMusic} and @code{\\magnifyStaff}.  When
+@var{grob-descriptions} is equal to the @code{all-grob-descriptions}
+alist (defined in @file{scm/define-grobs.scm}), this will find all grobs
+that can have a value for the @var{prop-name} property, and return them
 as a list in the following format:
 @example
-'((Ambitus space-alist)
-  (BarLine space-alist)
+'((grob prop-name)
+  (grob prop-name)
   ...)
 @end example"
-  (define (has-space-alist? grob-desc)
-    (ly:assoc-get 'space-alist (cdr grob-desc)))
-  (let* ((grob-descriptions-with-space-alist
-           (filter has-space-alist? grob-descriptions))
-         (grob-names-with-space-alist
-           (map car grob-descriptions-with-space-alist)))
-    (map (lambda (grob-name) (list grob-name 'space-alist))
-         grob-names-with-space-alist)))
+  (define (find-grobs-with-interface interface grob-descriptions)
+    (define (has-this-interface? grob-desc)
+      (let* ((meta (ly:assoc-get 'meta (cdr grob-desc)))
+             (interfaces (ly:assoc-get 'interfaces meta '())))
+        (memq interface interfaces)))
+    (let* ((grob-descriptions-with-this-interface
+             (filter has-this-interface? grob-descriptions))
+           (grob-names-with-this-interface
+             (map car grob-descriptions-with-this-interface)))
+      grob-names-with-this-interface))
+  (let* ((interface
+           (case prop-name
+             ((baseline-skip word-space) 'text-interface)
+             ((space-alist)              'break-aligned-interface)
+             (else (ly:programming-error
+                     "find-named-props: no interface associated with ~s"
+                     prop-name))))
+         (grobs-with-this-prop
+           (find-grobs-with-interface interface grob-descriptions)))
+    (map (lambda (x) (list x prop-name))
+         grobs-with-this-prop)))
+
 
 (define (magnifyStaff-is-set? context mag)
   (let* ((Staff (ly:context-find context 'Staff))
@@ -2433,7 +2447,9 @@ magnification factor @var{mag}.  @var{func-name} is either
       (if (or (eq? func-name 'magnifyMusic)
               ;; for \magnifyStaff, only scale the fontSize
               ;; if staff magnification is changing
-              (staff-magnification-is-changing? context mag))
+              ;; and does not equal 1
+              (and (staff-magnification-is-changing? context mag)
+                   (not (= mag 1))))
         (let* ((where (case func-name
                         ((magnifyMusic) context)
                         ((magnifyStaff) (ly:context-find context 'Staff))))
@@ -2508,10 +2524,15 @@ formatted like:
                                           (cons (car x)
                                                 (cons (cadr x)
                                                       (* mag (cddr x))))))
-                   (scaled-tuples (map scale-spacing-tuple space-alist))
+                   (scaled-tuples (if space-alist
+                                      (map scale-spacing-tuple space-alist)
+                                      '()))
                    (new-alist (append scaled-tuples space-alist)))
               (ly:context-pushpop-property where grob prop new-alist))
-            (let* ((val (ly:assoc-get prop grob-def 1))
+            (let* ((val (ly:assoc-get prop grob-def (case prop
+                                                      ((baseline-skip) 3)
+                                                      ((word-space)    0.6)
+                                                      (else            1))))
                    (proc (lambda (x)
                            (if allowed-to-shrink?
                              (* x mag)
@@ -2524,7 +2545,9 @@ formatted like:
       (if (or (eq? func-name 'magnifyMusic)
               ;; for \magnifyStaff, only scale the properties
               ;; if staff magnification is changing
-              (staff-magnification-is-changing? context mag))
+              ;; and does not equal 1
+              (and (staff-magnification-is-changing? context mag)
+                   (not (= mag 1))))
         (for-each scale-prop props)))))
 
 (define-public (revert-props func-name mag props)