[PATCH] New markup command `parenthesize' in `scm/define-markup-commands.scm'.

[Thomas Morgan]

 This works like the `bracket' markup command but makes parentheses
 instead of brackets.

New public procedure `parenthesize-stencil' and subroutine
`make-parenthesis-stencil' in `scm/stencil.scm'.

Thanks to Carl Sorensen and Neil Puttock for their great advice and
criticism.
---
 scm/define-markup-commands.scm |   37 +++++++++++++++++++
 scm/stencil.scm                |   78 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 115 insertions(+), 0 deletions(-)

diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm
index e953774..d017123 100644
--- a/scm/define-markup-commands.scm
+++ b/scm/define-markup-commands.scm
@@ -3021,6 +3021,43 @@ Draw vertical brackets around @var{arg}.
   (let ((th 0.1) ;; todo: take from GROB.
         (m (interpret-markup layout props arg)))
     (bracketify-stencil m Y th (* 2.5 th) th)))
+
+(define-builtin-markup-command (parenthesize layout props arg)
+  (markup?)
+  graphic
+  ((angularity 0)
+   (padding)
+   (size 1)
+   (thickness 1)
+   (width 0.25))
+  "
address@hidden placing parentheses around text
+  
+Draw parentheses around @var{arg}.  This is useful for parenthesizing
+a column containing several lines of text.
+
address@hidden,quote]
+\\markup {
+  \\parenthesize {
+    \\column {
+      foo
+      bar
+    }
+  }
+}
address@hidden lilypond"
+  (let* ((markup (interpret-markup layout props arg))
+        (scaled-width (* size width))
+        (scaled-thickness
+         (* (chain-assoc-get 'line-thickness props 0.1)
+            thickness))
+        (half-thickness
+         (min (* size 0.5 scaled-thickness)
+              (* (/ 4 3.0) scaled-width)))
+        (padding (chain-assoc-get 'padding props half-thickness)))
+    (parenthesize-stencil
+     markup half-thickness scaled-width angularity padding)))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Delayed markup evaluation
diff --git a/scm/stencil.scm b/scm/stencil.scm
index fcf5434..c35d45e 100644
--- a/scm/stencil.scm
+++ b/scm/stencil.scm
@@ -70,6 +70,84 @@
          (ly:stencil-combine-at-edge lb (other-axis axis) 1 stil padding))
     stil))
 
+(define (make-parenthesis-stencil
+        y-extent half-thickness width angularity)
+  "Create a parenthesis stencil.
address@hidden is the Y extent of the markup inside the parenthesis.
address@hidden is the half thickness of the parenthesis.
address@hidden is the width of a parenthesis.
+The higher the value of number @var{angularity},
+the more angular the shape of the parenthesis."
+  (let* ((line-width 0.1)
+        ;; Horizontal position of baseline that end points run through.
+        (base-x
+         (if (< width 0)
+             (- width)
+             0))
+        ;; Farthest X value (in relation to baseline)
+        ;; on the outside of the curve.
+        (outer-x (+ base-x width))
+        (x-extent (ordered-cons base-x outer-x))
+        (bottom-y (interval-start y-extent))
+        (top-y (interval-end y-extent))
+
+        (lower-end-point (cons base-x bottom-y))
+        (upper-end-point (cons base-x top-y))
+
+        (outer-control-x (+ base-x (* 4/3 width)))
+        (inner-control-x (+ outer-control-x
+                            (if (< width 0)
+                                half-thickness
+                                (- half-thickness))))
+
+        ;; Vertical distance between a control point
+        ;; and the end point it connects to.
+        (offset-index (- (* 0.6 angularity) 0.8))
+        (lower-control-y (interval-index y-extent offset-index))
+        (upper-control-y (interval-index y-extent (- offset-index)))
+
+        (lower-outer-control-point
+         (cons outer-control-x lower-control-y))
+        (upper-outer-control-point
+         (cons outer-control-x upper-control-y))
+        (upper-inner-control-point
+         (cons inner-control-x upper-control-y))
+        (lower-inner-control-point
+         (cons inner-control-x lower-control-y)))
+
+    (ly:make-stencil
+     (list 'bezier-sandwich
+          `(quote ,(list
+                    ;; Step 4: curve through inner control points
+                    ;; to lower end point.
+                    upper-inner-control-point
+                    lower-inner-control-point
+                    lower-end-point
+                    ;; Step 3: move to upper end point.
+                    upper-end-point
+                    ;; Step 2: curve through outer control points
+                    ;; to upper end point.
+                    lower-outer-control-point
+                    upper-outer-control-point
+                    upper-end-point
+                    ;; Step 1: move to lower end point.
+                    lower-end-point))
+          line-width)
+     x-extent
+     y-extent)))
+
+(define-public (parenthesize-stencil
+               stencil half-thickness width angularity padding)
+  "Add parentheses around @var{stencil}, returning a new stencil."
+  (let* ((y-extent (ly:stencil-extent stencil Y))
+        (lp (make-parenthesis-stencil
+             y-extent half-thickness (- width) angularity))
+        (rp (make-parenthesis-stencil
+             y-extent half-thickness width angularity)))
+    (set! stencil (ly:stencil-combine-at-edge lp X RIGHT stencil padding))
+    (set! stencil (ly:stencil-combine-at-edge stencil X RIGHT rp padding))
+    stencil))
+
 (define-public (make-line-stencil width startx starty endx endy)
   "Make a line stencil of given linewidth and set its extents accordingly"
   (let ((xext (cons (min startx endx) (max startx endx)))
-- 
1.6.0.4