Re: Solution for multiple simultaneous Text Spanners in a single voice?

[Aaron Hill]

On 2020-03-20 12:08 pm, dtsmarin wrote:
> Does anyone know any elegant ways to add two or more Text Spanner 
> without
> using a separate voice?

Here's a quickly thrown together update to Text_spanner_engraver:

%%%%
\version "2.20.0"

Multiple_text_spanner_engraver =
#(lambda (context)
  (let ((starting-events '())
        (stopping-events '())
        (current-events '())
        (current-spans '())
        (finished-spans '()))

    (define (event-warn event str . args)
      (ly:input-warning (ly:event-property event 'origin)
        (apply format str args)))

    (define (assign-event-once dir id event)
      (let* ((alist (if (> 0 dir) starting-events stopping-events))
             (existing (assoc id alist)))
        (if (and existing (not (equal? (cdr existing) event)))
          (begin
            (event-warn event
              "Two simultaneous text-span events, junking this one")
            (event-warn (cdr existing)
              "Previous text-span event here"))
          (if (> 0 dir)
            (set! starting-events (assoc-set! alist id event))
            (set! stopping-events (assoc-set! alist id event))))))
    (define (handle-starting-event engraver id event)
      (let ((active (assoc id current-events)))
        (if active
          (event-warn event
            "already have a text spanner~@[ (id = ~a)~]"
            id)
          (begin
            (set! current-events (assoc-set! current-events id event))
            (let ((span (ly:engraver-make-grob
                          engraver 'TextSpanner event))
                  (dir (ly:event-property event 'direction #f)))
              (set! current-spans (assoc-set! current-spans id span))
              (if dir
                (ly:grob-set-property! span 'direction dir)))
            (set! starting-events (assoc-remove! starting-events 
id))))))
    (define (handle-stopping-event engraver id event)
      (let ((span (assoc id current-spans)))
        (if span
          (begin
            (set! finished-spans (cons (cdr span) finished-spans))
            (ly:engraver-announce-end-grob engraver (cdr span) '())
            (set! current-spans (assoc-remove! current-spans id))
            (set! current-events (assoc-remove! current-events id)))
          (event-warn event
            "cannot find start of text spanner~@[ (id = ~a)~]"
            id))))
    (define (conditional-set-bound! span dir)
      (or (ly:grob? (ly:spanner-bound span dir))
        (ly:spanner-set-bound! span dir
          (ly:content-property context 'currentMusicalColumn))))
    (define (add-note-column span dir grob)
      (ly:pointer-group-interface::add-grob
        span 'note-columns grob)
      (or (ly:grob? (ly:spanner-bound span dir))
        (ly:spanner-set-bound! span dir grob)))

    (make-engraver
      ((finalize engraver)
        (for-each
          (lambda (span)
            (conditional-set-bound! span LEFT))
          finished-spans)
        (set! finished-spans '())
        (for-each
          (lambda (span)
            (event-warn (cdr (assoc (car span) current-events))
              "unterminated text spanner~@[ (id = ~a)~]"
            (car span))
            (ly:grob-suicide! span))
          current-spans)
        (set! current-spans '()))
      ((stop-translation-timestep engraver)
        (for-each
          (lambda (span)
            (conditional-set-bound! (cdr span) LEFT))
          current-spans)
        (for-each
          (lambda (span)
            (conditional-set-bound! span LEFT))
          finished-spans)
        (set! finished-spans '())
        (set! starting-events '())
        (set! stopping-events '()))
      ((process-music engraver)
        (for-each
          (lambda (event) (handle-stopping-event
            engraver (car event) (cdr event)))
          stopping-events)
        (for-each
          (lambda (event) (handle-starting-event
            engraver (car event) (cdr event)))
          starting-events))
      (listeners
        ((text-span-event engraver event)
          (let ((dir (ly:event-property event 'span-direction))
                (id (ly:event-property event 'spanner-id #f)))
            (assign-event-once dir id event))))
      (acknowledgers
        ((note-column-interface engraver grob source-engraver)
          (for-each
            (lambda (span)
              (add-note-column (cdr span) LEFT grob))
            current-spans)
          (for-each
            (lambda (span)
              (add-note-column span RIGHT grob))
            finished-spans))))))

\new Voice \with {
  \remove "Text_spanner_engraver"
  \consists \Multiple_text_spanner_engraver
}
{
  g'2 \tweak bound-details.left.text "g" _\startTextSpan
  <b' d''>2
    \tweak bound-details.left.text "b" \=2 \startTextSpan
    \tweak bound-details.left.text "d" \=sym ^\startTextSpan
  b'2 \=2 \stopTextSpan
  <g' d''>2 \=sym \stopTextSpan \stopTextSpan
}
%%%%


-- Aaron Hill