Re: \decorateSlur

[Aaron Hill]

> > Expanding upon my earlier snippet, I was inspired to author this one:
> >
> > [...]
> >
> > 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.

Some usage improvements and new features:

- Replaced fixed left/center/right decorations with a customizable list.
  (An "anchor" associates a name with a position along the curve.)
- Replaced (left|right)-shorten with curve-(start|stop) that lets you 
adjust
  the extents of the original Slur.
- Renamed -rotate to -orient and -(X|Y)-align to -align-(X|Y).
- Added use-direction to have the direction property affect -align-Y.  
This
  makes #UP/#DOWN effectively "inside"/"outside" relative to the Slur.
- Added common-* to specify values applying to all anchors.  A specific
  value takes precedence, and there is still an internal fallback value.
- Changed to event-function to permit inline usage within music while 
also
  supporting \tweaks when defining wrapper functions.

Known issues and future plans:

- Anchor positions and curve-(start|stop) are specified in relative 
units.
  It would be nice to be able to specify absolute distances.
- Broken Slurs share the same decorations.  Ideally, anchor positions 
and
  attributes would be customizable per each segment of a broken Slur.
  Perhaps there would be a way to work with \alterBroken.
- Anchors are always being realigned.  It might make sense to provide an
  option (use #f?) to keep the stencil's original alignment.  This helps
  preserve baseline alignment within \markup.
- Enable an anchor to be associated with a list of positions:
    \with { anchors = #'((a . 0) (a . 0.5) (a . 1)) }
       ...becomes...
    \with { anchors = #'((a . (0 0.5 1))) }
- Support Ties as well as potentially any Spanners.
- Add debug annotations to assist in positioning and aligning anchors.
- Coordinate changes to control-points via bezier-adjust with the dash-
  definition set for the Slur.


%%%%
\version "2.20.0"

decorateSlur =
#(define-event-function
  (options slur)
  (ly:context-mod? ly:music?)
  (define (option name default)
    (if (symbol-list? name)
        (set! name (string->symbol
          (string-join (map symbol->string name) "-"))))
    (let ((mod (find (lambda (mod) (and (eq? 'assign (first mod))
                                        (eq? name (second mod))))
                     (ly:get-context-mods options))))
      (if (list? mod) (third mod) default)))

  (define (bezier-core cpts param)
    (define (lerp a b t)
      (cons (+ (* (- 1 t) (car a)) (* t (car b)))
            (+ (* (- 1 t) (cdr a)) (* t (cdr b)))))
    (let loop ((pre '()) (post '()) (cpts cpts))
      (set! pre (append pre (list (first cpts))))
      (set! post (append (list (last cpts)) post))
      (if (< 1 (length cpts))
          (loop pre post (map (lambda (a b) (lerp a b param))
                              (drop-right cpts 1)
                              (drop cpts 1)))
          (list (first cpts) pre post))))
  (define (bezier cpts param) (first (bezier-core cpts param)))
  (define (bezier-pre cpts param) (second (bezier-core cpts param)))
  (define (bezier-post cpts param) (third (bezier-core cpts param)))
  (define (bezier-slope cpts param)
    (define (slope a b) (cons (- (car b) (car a)) (- (cdr b) (cdr a))))
    (bezier (map slope (drop-right cpts 1) (drop cpts 1)) param))
  (define (bezier-adjust cpts start stop)
    (if (> start stop)
      (bezier-adjust (reverse cpts) (- 1 start) (- 1 stop))
      (if (< (- 1 start) stop)
        (bezier-post (bezier-pre cpts stop) (/ start stop))
        (bezier-pre (bezier-post cpts start)
                    (- 1 (/ (- 1 stop) (- 1 start)))))))

  (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 (handle-anchor anchor grob cpts)
    (let* ((name (car anchor))
           (param (cdr anchor))
           (text (option (list name 'text)
                         (option 'common-text (markup #:null))))
           (sten (grob-interpret-markup grob text))
           (use-dir? (option 'use-direction #f))
           (dir (ly:grob-property grob 'direction))
           (orient? (option (list name 'orient)
                            (option 'common-orient #f)))
           (align-X (option (list name 'align-X)
                            (option 'common-align-X CENTER)))
           (align-Y (option (list name 'align-Y)
                            (option 'common-align-Y CENTER))))
      (if use-dir? (set! align-Y (* align-Y dir)))
      (set! sten (stencil-aligned sten align-X align-Y))
      (and orient? (set! sten (ly:stencil-rotate-absolute sten
                                (slope-angle (bezier-slope cpts param))
                                0 0)))
      (ly:stencil-translate sten (bezier cpts param))))

  (define (stencil-proc grob)
    (let ((cpts (ly:grob-property grob 'control-points)))
      (ly:grob-set-property! grob 'control-points
        (bezier-adjust cpts
          (option 'curve-start 0)
          (option 'curve-stop 1)))
      (apply ly:stencil-add
        (ly:slur::print grob)
        (map (lambda (anchor) (handle-anchor anchor grob cpts))
             (option 'anchors '())))))
  #{ \tweak stencil #stencil-proc #slur #})

parenthesizeSlur =
\decorateSlur \with {
  curve-start = #0.05
  curve-stop = #0.95
  use-direction = ##t
  anchors = #'((left . 0) (right . 1))
  common-align-Y = #-0.3
  left-text = \markup \fontsize #-4 "("
  right-text = \markup \fontsize #-4 ")"
} \etc

bracketizeSlur =
-\alterBroken color #(list blue red)
-\tweak font-size #-4
\decorateSlur \with {
  anchors = #'((left . 0.1) (rule . 0.3) (rule . 0.5)
               (rule . 0.7) (right . 0.9))
  common-orient = ##t
  left-text = "["
  rule-text = "|"
  right-text = "]"
} \etc

arrowizeSlur =
\decorateSlur \with {
  anchors = #'((tail . 0) (label . 0.5) (head . 1))
  use-direction = ##t
  tail-text = \markup \draw-circle #0.3 #0.1 ##f
  label-text = \markup
    \override #'(style . outline) \whiteout
    \fontsize #-5 \italic "?!"
  label-align-Y = #DOWN
  head-text = \markup \arrow-head #X #RIGHT ##t
  head-orient = ##t
} \etc

\paper { line-width = 6\cm indent = 1\cm ragged-right = ##f }
\layout { \context { \Score \omit BarNumber } }
{ g'4 \bracketizeSlur _\(
      \parenthesizeSlur ^( b' c''2 ) |
  b'4 \arrowizeSlur ^( a' c''2 ) \) |
  g'2 \bracketizeSlur ^\(
      \arrowizeSlur _( b'4 a' ) |
  g'2 \parenthesizeSlur _( a'4 c'' ) \) |
  g'2 \bracketizeSlur ^\(
      \parenthesizeSlur _( b'4 a' ) |
  g'2 \arrowizeSlur _( a'4 c'' ) \) |
  g'4 \bracketizeSlur _\(
      \arrowizeSlur ^( b' c''2 ) |
  b'4 \parenthesizeSlur ^( a' c''2 ) \) |
  \bar "|." }
%%%%


-- Aaron Hill

decorate-slur.cropped.png
Description: PNG image