On 2020-09-12 7:58 am, Luca Rossetto Casel wrote:
I'd like to express a huge *thanks!* to all you you for the marvellous
work! As Kieren, I'd also find very useful being able to choose
between rotated and unrotated parentheses (which I personally prefer
too) and, if I can suggest, also between square brackets and
semibrackets.
Expanding upon my earlier snippet, I was inspired to author this one:
%%%%
\version "2.20.0"
decorateSlur =
#(define-scheme-function
(options)
(ly:context-mod?)
(define (option side prop def)
(let* ((sym (string->symbol (format #f "~s-~s" side prop)))
(mod (find (lambda (x) (and (eq? 'assign (first x))
(eq? sym (second x))))
(ly:get-context-mods options))))
(if (list? mod) (third mod) def)))
(define (bezier-core cp t)
(define (lerp a b t)
(cons (+ (* (- 1 t) (car a)) (* t (car b)))
(+ (* (- 1 t) (cdr a)) (* t (cdr b)))))
(let loop ((pre '()) (post '()) (cp cp) (t t))
(set! pre (append pre (list (first cp))))
(set! post (append post (list (last cp))))
(if (< 1 (length cp))
(loop pre post
(map (lambda (a b) (lerp a b t))
(drop-right cp 1) (drop cp 1)) t)
(list (first cp) pre (reverse post)))))
(define (bezier cp t) (first (bezier-core cp t)))
(define (bezier-pre cp t) (second (bezier-core cp t)))
(define (bezier-post cp t) (third (bezier-core cp t)))
(define (bezier-slope cp t)
(define (slope a b)
(cons (- (car b) (car a))
(- (cdr b) (cdr a))))
(bezier (map slope (drop-right cp 1) (drop cp 1)) t))
(define (slope-angle slope)
(ly:angle (car slope) (cdr slope)))
(define (stencil-aligned sten x y)
(ly:stencil-aligned-to (ly:stencil-aligned-to sten X x) Y y))
(define (build-stencil grob cp side)
(let* ((text (option side 'text (markup #:null)))
(sten (grob-interpret-markup grob text))
(t (case side ((left) 0) ((center) 0.5) ((right) 1)))
(rot? (option side 'rotate #f)))
(set! sten
(stencil-aligned sten
(option side 'X-align CENTER)
(option side 'Y-align CENTER)))
(and rot? (set! sten
(ly:stencil-rotate-absolute sten
(slope-angle (bezier-slope cp t)) 0 0)))
(ly:stencil-translate sten (bezier cp t))))
(define (stencil-proc grob)
(let* ((cp (ly:grob-property grob 'control-points))
(left (build-stencil grob cp 'left))
(center (build-stencil grob cp 'center))
(right (build-stencil grob cp 'right))
(lshort (option 'left 'shorten #f))
(rshort (option 'right 'shorten #f)))
(and (number? lshort) (number? rshort)
(set! rshort (/ rshort (- 1 lshort))))
(if (number? lshort) (set! cp (bezier-post cp lshort)))
(if (number? rshort) (set! cp (bezier-pre cp (- 1 rshort))))
(ly:grob-set-property! grob 'control-points cp)
(apply ly:stencil-add
(list (ly:slur::print grob) left center right))))
#{ -\tweak stencil #stencil-proc \etc #})
parenthesizeSlur =
\decorateSlur \with {
left-text = \markup \teeny "("
left-Y-align = #-0.25
left-shorten = #0.1
right-text = \markup \teeny ")"
right-Y-align = #-0.25
right-shorten = #0.1
}
arrowSlur =
\decorateSlur \with {
left-text = \markup \draw-circle #0.3 #0.1 ##f
right-text = \markup \arrow-head #X #RIGHT ##t
right-X-align = #LEFT
right-rotate = ##t
}
bracketSlur =
\decorateSlur \with {
left-text = \markup \fontsize #-5 \bold "["
left-X-align = #RIGHT
left-rotate = ##t
center-text = \markup \fontsize #-5 \bold "|"
center-Y-align = #DOWN
center-rotate = ##t
right-text = \markup \fontsize #-5 \bold "]"
right-X-align = #LEFT
right-rotate = ##t
}
{ g'4 \parenthesizeSlur (
\bracketSlur _\( b' c''2 ) |
b'4 \arrowSlur ( a' c''2 ) \) }
%%%%
While this might need some refactoring and could be harboring bugs, it
is a bigger step towards a more generalized system; and I wanted to get
this posted sooner than later.
-- Aaron Hill
