\decorateSlur (was Re: A slur enclosed by parentheses or brackets)

[Aaron Hill]

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

decorate-slur.cropped.png
Description: PNG image