New markup command `parenthesize'

[Thomas Morgan]

Here is a patch which defines `parenthesize', a new markup command
which works like `bracket'.  It's mainly useful for parenthesizing
columns containing several lines of text.

Please let me know about anything you see that could be done better!

commit c46fa73ed53ccc6f550e549fdec20df7003c3582
Author: Thomas Morgan <address@hidden>
Date:   Mon Jul 6 16:08:06 2009 +0200

    New markup command `parenthesize' in `scm/define-markup-commands.scm'.
    This works like the `bracket' markup command but makes parentheses
    instead of brackets.
    
    New procedures `parenthesize-stencil' and `make-parenthesis-stencil'
    in `scm/stencil.scm'.
    
    In `scm/define-grob-properties.scm', define property `angularity'
    that controls the shape of parentheses.  Add this property
    to TextScript grob definition in `scm/define-grobs.scm' and
    to text script interface in `lily/script-interface.cc'.
    
    Thanks to Carl Sorensen for great advice and criticism.

diff --git a/lily/script-interface.cc b/lily/script-interface.cc
index 59737b5..6bdd069 100644
--- a/lily/script-interface.cc
+++ b/lily/script-interface.cc
@@ -112,6 +112,7 @@ ADD_INTERFACE (Text_script,
 
               /* properties */
               "add-stem-support "
+              "angularity "
               "avoid-slur "
               "script-priority "
               "slur "
diff --git a/scm/define-grob-properties.scm b/scm/define-grob-properties.scm
index 0c65d45..7155b2c 100644
--- a/scm/define-grob-properties.scm
+++ b/scm/define-grob-properties.scm
@@ -38,6 +38,8 @@ be created below this bar line.")
      (alteration ,number? "Alteration numbers for accidental.")
      (alteration-alist ,list? "List of @code{(@var{pitch}
 . @var{accidental})} pairs for key signature.")
+     (angularity ,number? "Angularity of grob shape.
+Typical values range from 0 (not angular) to 1 (angular).")
      (annotation ,string? "Annotate a grob for debug purposes.")
      (arpeggio-direction ,ly:dir? "If set, put an arrow on the
 arpeggio squiggly line.")
diff --git a/scm/define-grobs.scm b/scm/define-grobs.scm
index e511f24..f829a33 100644
--- a/scm/define-grobs.scm
+++ b/scm/define-grobs.scm
@@ -1889,6 +1889,7 @@
        (slur-padding . 0.5)
        (script-priority . 200)
        (cross-staff . ,ly:script-interface::calc-cross-staff)
+       (angularity . 0)
        ;; todo: add X self alignment?
        (meta . ((class . Item)
                 (interfaces . (text-script-interface
diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm
index e953774..17a24a6 100644
--- a/scm/define-markup-commands.scm
+++ b/scm/define-markup-commands.scm
@@ -3021,6 +3021,38 @@ 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
+  ()
+  "
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))
+        (size (chain-assoc-get 'size props 1))
+        (width (* size (chain-assoc-get 'width props 0.25)))
+        (thickness (* (chain-assoc-get 'line-thickness props 0.1)
+                      (chain-assoc-get 'thickness props 1)))
+        (half-thickness (min (* size 0.5 thickness)
+                             (* (/ 4 3.0) width)))
+        (angularity (chain-assoc-get 'angularity props 0))
+        (padding (chain-assoc-get 'padding props half-thickness)))
+    (parenthesize-stencil
+     markup half-thickness width angularity padding)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Delayed markup evaluation
diff --git a/scm/stencil.scm b/scm/stencil.scm
index fcf5434..5b83631 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 (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 1 stencil padding))
+    (set! stencil (ly:stencil-combine-at-edge stencil X 1 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)))