From: Paul Morris <paulwmorris@gmail.com>
Date: Sun, 23 Aug 2015 02:32:42 +0000 (-0400)
Subject: Issue 4504: Let whiteout-box take a number argument
X-Git-Tag: release/2.19.27-1~22
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=a3fc862086a720201e4a4764c7beb952fab5f106;p=lilypond.git

Issue 4504: Let whiteout-box take a number argument

This allows the size of the box whiteout style
to be customized, for grobs and markups. Boolean
arguments are still possible as well.
---

diff --git a/lily/grob.cc b/lily/grob.cc
index f7bf31f286..2f1bd8aa9f 100644
--- a/lily/grob.cc
+++ b/lily/grob.cc
@@ -157,10 +157,14 @@ Grob::get_print_stencil () const
         }
 
       /* Calls the scheme procedure stencil-whiteout-box in scm/stencils.scm */
-      if (!transparent && to_boolean (get_property ("whiteout-box")))
+      if (!transparent && (scm_is_number (get_property("whiteout-box"))
+                           || to_boolean (get_property ("whiteout-box"))))
         {
+          Real thickness = robust_scm2double (get_property("whiteout-box"), 0.0)
+               * layout ()->get_dimension (ly_symbol2scm ("line-thickness"));
           retval = *unsmob<Stencil>
-            (Lily::stencil_whiteout_box (retval.smobbed_copy ()));
+            (Lily::stencil_whiteout_box (retval.smobbed_copy (),
+                                     scm_from_double (thickness)));
         }
 
       if (transparent)
diff --git a/scm/define-grob-properties.scm b/scm/define-grob-properties.scm
index 8649a67117..fc8c86c5a3 100644
--- a/scm/define-grob-properties.scm
+++ b/scm/define-grob-properties.scm
@@ -1146,9 +1146,11 @@ if the grob is visible.  A number sets the thickness of the outline as a
 multiple of the staff-line thickness.  For compatibility with former
 behavior (now available with @code{whiteout-box}) the value @code{#t} is
 treated as @code{3.0}.  Usually @code{#f} by default.")
-     (whiteout-box ,boolean? "If true, the grob is printed over a
-rounded rectangular white background to white-out underlying material,
-if the grob is visible.  Usually @code{#f} by default.")
+     (whiteout-box ,boolean-or-number? "If a number or true, the grob
+is printed over a rectangular white background to white-out underlying
+material, if the grob is visible.  A number indicates how far the
+outline extends beyond the bounding box of the grob as a multiple of
+the staff-line thickness.  Usually @code{#f} by default.")
      (width ,ly:dimension? "The width of a grob measured in staff
 space.")
      (word-space ,ly:dimension? "Space to insert between words in
diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm
index 0022d721fc..505ca246c7 100644
--- a/scm/define-markup-commands.scm
+++ b/scm/define-markup-commands.scm
@@ -743,19 +743,23 @@ Provide a white background for @var{arg}.
 (define-markup-command (whiteout-box layout props arg)
   (markup?)
   #:category other
+  #:properties ((thickness 0))
   "
-@cindex adding a rounded rectangular white background to text
+@cindex adding a rectangular white background to text
 
-Provide a rounded rectangular white background for @var{arg}.
+Provide a rectangular white background for @var{arg}.
 
 @lilypond[verbatim,quote]
 \\markup {
   \\combine
     \\filled-box #'(-1 . 10) #'(-3 . 4) #1
-    \\whiteout-box whiteout-box
+    \\override #'(thickness . 1.5) \\whiteout-box whiteout-box
 }
 @end lilypond"
-  (stencil-whiteout-box (interpret-markup layout props arg)))
+  (stencil-whiteout-box
+    (interpret-markup layout props arg)
+      (* thickness
+        (ly:output-def-lookup layout 'line-thickness))))
 
 (define-markup-command (pad-markup layout props amount arg)
   (number? markup?)
diff --git a/scm/stencil.scm b/scm/stencil.scm
index f73b081630..fb2809e9fd 100644
--- a/scm/stencil.scm
+++ b/scm/stencil.scm
@@ -737,15 +737,17 @@ we make between 0 and 2*pi."
               `(delay-stencil-evaluation ,(delay whiteout-expr)))
             stil)))))
 
-(define-public (stencil-whiteout-box stencil)
+(define*-public (stencil-whiteout-box stencil
+                 #:optional (thickness 0) (blot 0) (color white))
+  "@var{thickness} is how far in staff-spaces the white outline
+extends past the extents of @var{stencil}."
   (let*
-      ((x-ext (ly:stencil-extent stencil X))
-       (y-ext (ly:stencil-extent stencil Y)))
+   ((x-ext (interval-widen (ly:stencil-extent stencil X) thickness))
+    (y-ext (interval-widen (ly:stencil-extent stencil Y) thickness)))
 
-    (ly:stencil-add
-     (stencil-with-color (ly:round-filled-box x-ext y-ext 0.0)
-                         white)
-     stencil)))
+   (ly:stencil-add
+    (stencil-with-color (ly:round-filled-box x-ext y-ext blot) color)
+    stencil)))
 
 (define-public (arrow-stencil-maker start? end?)
   "Return a function drawing a line from current point to @code{destination},