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))
+ "
+...@cindex placing parentheses around text
+
+Draw parentheses around @var{arg}. This is useful for parenthesizing
+a column containing several lines of text.
+
+...@lilypond[verbatim,quote]
+\\markup {
+ \\parenthesize {
+ \\column {
+ foo
+ bar
+ }
+ }
+}
+...@end 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.
+...@var{y-extent} is the Y extent of the markup inside the parenthesis.
+...@var{half-thickness} is the half thickness of the parenthesis.
+...@var{width} 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
_______________________________________________
lilypond-devel mailing list
lilypond-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/lilypond-devel
