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 <t...@ziiuu.com> 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 + () + " +...@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)) + (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. +...@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 (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))) _______________________________________________ lilypond-devel mailing list lilypond-devel@gnu.org http://lists.gnu.org/mailman/listinfo/lilypond-devel