Fix ugly output from make-parenthesis-stencil for increased thickness

[lilypond.git] / scm / stencil.scm

diff --git a/scm/stencil.scm b/scm/stencil.scm
index abd9795f7ebf6873fd211b29dd446888d6e78e69..f73b08163052b0567d0f2628887bbd8bd552dd19 100644 (file)
--- a/scm/stencil.scm
+++ b/scm/stencil.scm
@@ -159,7 +159,7 @@ the more angular the shape of the parenthesis."
       upper-end-point
       ;; Step 1: move to lower end point.
       lower-end-point)
-     (* 2 half-thickness)
+     (min (* 2 half-thickness) line-width)
      (interval-widen x-extent (/ line-width 2))
      (interval-widen y-extent (/ line-width 2)))))
 
@@ -464,9 +464,9 @@ coordinates for the previous point in the path."
                   ((eq? head 'curveto) 6)
                   (else 0)))
           (coordinates-raw (take rest arity))
-          (absolute? (if (memq head-raw
+          (is-absolute (if (memq head-raw
                            '(rmoveto m rlineto l rcurveto c)) #f #t))
-          (coordinates (if absolute?
+          (coordinates (if is-absolute
                            coordinates-raw
                            ;; convert relative coordinates to absolute by
                            ;; adding them to previous point values
@@ -662,24 +662,90 @@ producing a new stencil."
     (set! stencil (ly:stencil-add outer inner))
     stencil))
 
+(define-public (flip-stencil axis stil)
+  "Flip stencil @var{stil} in the direction of @var{axis}.
+Value @code{X} (or @code{0}) for @var{axis} flips it horizontally.
+Value @code{Y} (or @code{1}) flips it vertically.  @var{stil} is
+flipped in place; its position, the coordinates of its bounding
+box, remains the same."
+  (let* (
+          ;; scale stencil using -1 to flip it and
+          ;; then restore it to its original position
+          (xy (if (= axis X) '(-1 . 1) '(1 . -1)))
+          (flipped-stil (ly:stencil-scale stil (car xy) (cdr xy)))
+          (flipped-ext (ly:stencil-extent flipped-stil axis))
+          (original-ext (ly:stencil-extent stil axis))
+          (offset (- (car original-ext) (car flipped-ext)))
+          (replaced-stil (ly:stencil-translate-axis flipped-stil offset axis)))
+    replaced-stil))
+
 (define-public (stencil-with-color stencil color)
   (ly:make-stencil
    (list 'color color (ly:stencil-expr stencil))
    (ly:stencil-extent stencil X)
    (ly:stencil-extent stencil Y)))
 
-(define-public (stencil-whiteout stencil)
+(define*-public (stencil-whiteout
+                 stil #:optional (thickness 0.3) (color white)
+                 (angle-increments 16) (radial-increments 1))
+  "This function works by creating a series of white or @var{color}
+stencils radially offset from the original stencil with angles from
+0 to 2*pi, at an increment of @code{angle-inc}, and with radii
+from @code{radial-inc} to @var{thickness}.  @var{thickness} is how big
+the white outline is in staff-spaces.  @var{radial-increments} is how
+many copies of the white stencil we make on our way out to thickness.
+@var{angle-increments} is how many copies of the white stencil
+we make between 0 and 2*pi."
+  (if (or (not (positive? angle-increments))
+          (not (positive? radial-increments)))
+      (begin
+       (ly:warning "Both angle-increments and radial-increments must be positive numbers.")
+       stil)
+      (let* ((2pi 6.283185307)
+             (angle-inc (/ 2pi angle-increments))
+             (radial-inc (/ thickness radial-increments)))
+
+        (define (circle-plot ang dec radius original-stil new-stil)
+          ;; ang (angle) and dec (decrement) are in radians, not degrees
+          (if (<= ang 0)
+              new-stil
+              (circle-plot (- ang dec) dec radius original-stil
+                (ly:stencil-add
+                 new-stil
+                 (ly:stencil-translate original-stil
+                   (cons
+                    (* radius (cos ang))
+                    (* radius (sin ang))))))))
+
+        (define (radial-plot radius original-stil new-stil)
+          (if (<= radius 0)
+              new-stil
+              (ly:stencil-add new-stil
+                (radial-plot
+                 (- radius radial-inc)
+                 original-stil
+                 (circle-plot 2pi angle-inc
+                   radius original-stil empty-stencil)))))
+
+        (let ((whiteout-expr
+                (ly:stencil-expr
+                 (stencil-with-color
+                  (radial-plot thickness stil empty-stencil)
+                  color))))
+          (ly:stencil-add
+            (ly:make-stencil
+              `(delay-stencil-evaluation ,(delay whiteout-expr)))
+            stil)))))
+
+(define-public (stencil-whiteout-box stencil)
   (let*
       ((x-ext (ly:stencil-extent stencil X))
-       (y-ext (ly:stencil-extent stencil Y))
-
-       )
+       (y-ext (ly:stencil-extent stencil Y)))
 
     (ly:stencil-add
      (stencil-with-color (ly:round-filled-box x-ext y-ext 0.0)
                          white)
-     stencil)
-    ))
+     stencil)))
 
 (define-public (arrow-stencil-maker start? end?)
   "Return a function drawing a line from current point to @code{destination},
@@ -770,10 +836,10 @@ with optional arrows of @code{max-size} on start and end controlled by
                           (make-simple-markup (simple-format #f "~a: NaN/inf" name))))
         (let ((text-stencil (interpret-markup
                              layout text-props
-                             (markup #:whiteout #:simple name)))
+                             (markup #:whiteout-box #:simple name)))
               (dim-stencil (interpret-markup
                             layout text-props
-                            (markup #:whiteout
+                            (markup #:whiteout-box
                                     #:simple (cond
                                               ((interval-empty? extent)
                                                "empty")