Hello Pondmates! I’ve created some code for creating well behaved annotation brackets for some SE question, which I want to share with you all in case someone of you can use it.
Cheers, Valentin
%% Creates a (optionally rounded) bracket with a gap in the middle.
%% lx = left x position, ly = left y position, rx, ry similar for right
%% p = the length of the protruders
%% th = line thickness
%% gap-w = horizontal width of the gap
%% rounded? = whether to create a round bracket
#(define (make-bracket-gap lx ly rx ry p th gap-w rounded?)
(if rounded?
(let* ((width (- rx lx))
(height (- ry ly))
(sep-width (/ (- width gap-w) 2))
(sep-height (* height (/ sep-width width)))
(line-left (make-path-stencil
`(moveto ,lx ,(+ ly p)
curveto
,(+ lx (* sep-width 1/5)) ,(+ ly (* sep-height 1/5))
,(+ lx (* sep-width 2/3)) ,(+ ly (* sep-height 2/3))
,(+ lx sep-width) ,(+ ly sep-height)) th 1 1 #f))
(line-right (make-path-stencil
`(moveto ,rx ,(+ ry p)
curveto
,(- rx (* sep-width 1/5)) ,(- ry (* sep-height 1/5))
,(- rx (* sep-width 2/3)) ,(- ry (* sep-height 2/3))
,(- rx sep-width) ,(- ry sep-height)) th 1 1 #f)))
(ly:stencil-add line-left line-right))
(let* ((width (- rx lx))
(height (- ry ly))
(sep-width (/ (- width gap-w) 2))
(sep-height (* height (/ sep-width width)))
(line-left (make-line-stencil th lx ly
(+ lx sep-width) (+ ly sep-height)))
(line-right (make-line-stencil th rx ry
(- rx sep-width) (- ry sep-height)))
(prot-left (make-line-stencil th lx (+ ly p) lx ly))
(prot-right (make-line-stencil th rx (+ ry p) rx ry)))
(ly:stencil-add line-left line-right prot-left prot-right))))
%% create bracket with text in gap. Take text, direction, rounded from grob
#(define (center-text-gap L R p th grob)
(let* ((text (ly:grob-property grob 'text ""))
(direction (ly:grob-property grob 'direction UP))
(lx (+ (car L) (* 2 th)))
(rx (- (car R) (* 2 th)))
(p (* p direction))
(dir (if (< p 0) -1 1))
(ly (- (cdr L) p))
(ry (- (cdr R) p))
(outside-staff-p (ly:grob-property grob 'outside-staff-priority))
(is-outside-staff (number? outside-staff-p))
(ly (if is-outside-staff (* dir (min (* dir ly) -4)) ly))
(ry (if is-outside-staff (* dir (min (* dir ry) -4)) ry))
(det (ly:grob-property grob 'details))
(rounded? (assoc-get 'rounded det #t))
(texs (grob-interpret-markup grob text))
(ctex (ly:stencil-aligned-to (ly:stencil-aligned-to texs X CENTER) Y CENTER))
(texex (ly:stencil-extent ctex X))
(tex-width (interval-length texex))
(brack (make-bracket-gap lx ly rx ry p th (+ tex-width 0.7) rounded?))
(tex-tr (ly:stencil-translate ctex (cons (/ (+ lx rx) 2)
(/ (+ ly ry) 2)))))
(ly:stencil-add brack tex-tr)))
%% print a slur as bracket with text
#(define (slur->bracket grob)
(let* ((cpts (ly:grob-property grob 'control-points))
(L (first cpts))
(R (last cpts)))
(center-text-gap L R -1 0.15 grob)))
#(define* ((from-details symb #:optional default) grob)
(let ((det (ly:grob-property grob 'details)))
(ly:assoc-get symb det default)))
hbracketStart = \tweak direction #(from-details 'direction DOWN)
\tweak stencil #slur->bracket
\tweak outside-staff-priority #(from-details 'outside-staff-priority)
\="hb"(
hbracketStop = \="hb")
hb =
#(define-music-function (text rounded music) (markup? boolean? ly:music?)
#{
{
<>\tweak text #text \tweak details.rounded #rounded \hbracketStart
#music
<>\hbracketStop
}
#})
hbT = \hb "T" ##f \etc
hbS = \hb "S" ##t \etc
%%% EXAMPLE
\paper {
indent = 0
}
\score {
\relative {
\omit Score.TimeSignature
\omit Score.BarLine
\hbT c'1
\hbT d
\hbS e
\hbT f
\hbT g
\hbT a
\hbS b
\hbT c
\hbT d
\hbS e
\hbT f
\hbT g
\hbT a
\hbS b
c
\break
\override Slur.details.direction = #UP
\hbT c,,1
\hbT d
\hbS e
\hbT f
\hbT g
\hbT a
\hbS b
\hbT c
\hbT d
\hbS e
\hbT f
\hbT g
\hbT a
\hbS b
c
\break
\override Slur.details.outside-staff-priority = #500
\hbT c,,1
\hbT d
\hbS e
\hbT f
\hbT g
\hbT a
\hbS b
\hbT c
\hbT d
\hbS e
\hbT f
\hbT g
\hbT a
\hbS b
c
\break
\revert Slur.details.direction
\hbT c,,1
\hbT d
\hbS e
\hbT f
\hbT g
\hbT a
\hbS b
\hbT c
\hbT d
\hbS e
\hbT f
\hbT g
\hbT a
\hbS b
c\break
\override Slur.font-series = #'bold
\override Slur.font-shape = #'italic
\hbT c,,1
\hbT d
\hbS e
\hbT f
\hbT g
\hbT a
\hbS b
\hbT c
\hbT d
\hbS e
\hbT f
\hbT g
\hbT a
\hbS b
c
}
\layout {
}
}
signature.asc
Description: This is a digitally signed message part.
