%% Example for creating multiple custom text spanners
%% Based on:
% http://lilypond.org/doc/v2.18/input/regression/collated-files.html
% look for:
% ‘scheme-text-spanner.ly’

\version "2.19.82"

#(define (add-grob-definition grob-name grob-entry)
   (let* ((meta-entry   (assoc-get 'meta grob-entry))
          (class        (assoc-get 'class meta-entry))
          (ifaces-entry (assoc-get 'interfaces meta-entry)))
     (set-object-property! grob-name 'translation-type? ly:grob-properties?)
     (set-object-property! grob-name 'is-grob? #t)
     (set! ifaces-entry (append (case class
                                  ((Item) '(item-interface))
                                  ((Spanner) '(spanner-interface))
                                  ((Paper_column) '((item-interface
                                                     paper-column-interface)))
                                  ((System) '((system-interface
                                               spanner-interface)))
                                  (else '(unknown-interface)))
                                ifaces-entry))
     (set! ifaces-entry (uniq-list (sort ifaces-entry symbol<?)))
     (set! ifaces-entry (cons 'grob-interface ifaces-entry))
     (set! meta-entry (assoc-set! meta-entry 'name grob-name))
     (set! meta-entry (assoc-set! meta-entry 'interfaces
                                  ifaces-entry))
     (set! grob-entry (assoc-set! grob-entry 'meta meta-entry))
     (set! all-grob-descriptions
           (cons (cons grob-name grob-entry)
                 all-grob-descriptions))))
                 
#(define (add-bound-item spanner item)
   (if (null? (ly:spanner-bound spanner LEFT))
       (ly:spanner-set-bound! spanner LEFT item)
       (ly:spanner-set-bound! spanner RIGHT item)))

#(define (axis-offset-symbol axis)
   (if (eqv? axis X) 'X-offset 'Y-offset))

#(define (set-axis! grob axis)
  (if (not (number? (ly:grob-property grob 'side-axis)))
      (begin
        (set! (ly:grob-property grob 'side-axis) axis)
        (ly:grob-chain-callback
         grob
         (if (eqv? axis X)
             ly:side-position-interface::x-aligned-side
             side-position-interface::y-aligned-side)
         (axis-offset-symbol axis)))))
    
#(define (scheme-event-spanner-types-proc class-lst type-lst)
  (map
    (lambda (x y)
      (cons
        x
        (list 
          '(description 
            . 
            "Used to signal where scheme text spanner brackets start and stop.")
           (cons 'types  
                 (list 'post-event 
                       y
                       'span-event 
                       'event)))))
    class-lst
    type-lst))
    
#(define scheme-event-spanner-type
  (lambda (x)
    (set-object-property! (car x)
                          'music-description
                          (cdr (assq 'description (cdr x))))
    (let ((lst (cdr x)))
      (set! lst (assoc-set! lst 'name (car x)))
      (set! lst (assq-remove! lst 'description))
      (hashq-set! music-name-to-property-table (car x) lst)
      (cons (car x) lst))))
    
#(define spanner-props
  `(
    (bound-details . ((left . ((Y . 0)
                               (padding . 0.25)
                               (attach-dir . ,LEFT)
                               ))
                      (left-broken . ((end-on-note . #t)))
                      (right . ((Y . 0)
                                (padding . 0.25)
                                ))
                      ))
    (dash-fraction . 0.2)
    (dash-period . 3.0)
    (direction . ,UP)
    (font-shape . italic)
    (left-bound-info . ,ly:line-spanner::calc-left-bound-info)
    (outside-staff-priority . 350)
    (right-bound-info . ,ly:line-spanner::calc-right-bound-info)
    (staff-padding . 0.8)
    (stencil . ,ly:line-spanner::print)
    (style . dashed-line)
  
    (meta . ((class . Spanner)
             (interfaces . (font-interface
                            line-interface
                            line-spanner-interface
                            outside-staff-interface
                            side-position-interface))))))

#(define define-engraver
  (lambda (engr-name g-name event-types)
    (module-define! (current-module) engr-name
      (lambda (context)
        (let ((span '())
              (finished '())
              (ev-direction '())
              (event-start '())
              (event-stop '()))
          `((listeners 
              (,event-types
                .
                ,(lambda (engraver event)
                  (if (= START (ly:event-property event 'span-direction))
                      (begin
                        (set! event-start event)
                        (set! ev-direction 
                              (ly:event-property event 'direction 1)))
                      (set! event-stop event)))))
            (acknowledgers 
              (note-column-interface 
              .
              ,(lambda (engraver grob source-engraver)
                (if (ly:spanner? span)
                    (begin
                      (ly:pointer-group-interface::add-grob 
                        span 'note-columns grob)
                      (add-bound-item span grob)))
                (if (ly:spanner? finished)
                    (begin
                      (ly:pointer-group-interface::add-grob 
                        finished 'note-columns grob)
                      (add-bound-item finished grob))))))
            (process-music 
              .
              ,(lambda (trans)
                 (if (ly:stream-event? event-stop)
                     (if (null? span)
                         (ly:warning "You're trying to end a scheme text spanner 
but you haven't started one.")
                         (begin 
                           (set! finished span)
                           (ly:engraver-announce-end-grob 
                             trans finished event-start)
                           (set! span '())
                           (set! event-stop '()))))
                 (if (ly:stream-event? event-start)
                     (begin 
                       (set! span 
                             (ly:engraver-make-grob trans g-name event-start))
                       (ly:grob-set-property! span 'direction ev-direction)
                       (set-axis! span Y)
                       (set! event-start '())))))
            (stop-translation-timestep 
              .
              ,(lambda (trans)
                 (if (and (ly:spanner? span)
                          (null? (ly:spanner-bound span LEFT)))
                     (ly:spanner-set-bound! span LEFT
                       (ly:context-property context 'currentMusicalColumn)))
                 (if (ly:spanner? finished)
                     (begin
                       (if (null? (ly:spanner-bound finished RIGHT))
                           (ly:spanner-set-bound! finished RIGHT
                             (ly:context-property 
                               context 
                               'currentMusicalColumn)))
                       (set! finished '())
                       (set! event-start '())
                       (set! event-stop '())))))
            (finalize 
              .
              ,(lambda (trans)
                 (if (ly:spanner? finished)
                     (begin
                       (if (null? (ly:spanner-bound finished RIGHT))
                           (ly:spanner-set-bound! finished RIGHT
                             (ly:context-property 
                               context 
                               'currentMusicalColumn)))
                       (set! finished '())))
                 (if (ly:spanner? span)
                     (begin
                       (ly:warning 
                         "I think there's a dangling scheme text spanner :-)")
                       (ly:grob-suicide! span)
      	         (set! span '())))))))))))

createSpannersAndEngravers =
#(define-void-function (name-list)(list?)
 (let* ((naming-lst
          (map
            (lambda (name)
              (list
                (string->symbol (format #f "~aTextSpanEvent" name))
                (ly:camel-case->lisp-identifier 
                  (string->symbol (format #f "~aTextSpanEvent" name)))
                (string->symbol (format #f "~aTextSpanner" name))
                (string->symbol (format #f "~aTextSpannerEngraver" name))
                (string->symbol (string-downcase (format #f "~a-start" name)))
                (string->symbol (string-downcase (format #f "~a-stop" name)))))
            name-list))
        (new-scheme-event-spanner-types 
           (scheme-event-spanner-types-proc 
             (map car naming-lst) 
             (map second naming-lst)))
        (scheme-event-spanner-types
          (map 
            scheme-event-spanner-type
            new-scheme-event-spanner-types)))

    (set! music-descriptions
          (append scheme-event-spanner-types music-descriptions))
    
    (set! music-descriptions
          (sort music-descriptions alist<?))

    (for-each
      (lambda (evt
               text-span-event-name 
               g-name
               engr-name
               cmd-start
               cmd-stop)
        (define-event-class text-span-event-name 'span-event)
        (add-grob-definition g-name spanner-props)
        (define-engraver engr-name g-name text-span-event-name)
        (module-define! (current-module) cmd-start
          (make-span-event evt START))
        (module-define! (current-module) cmd-stop
          (make-span-event evt STOP)))
      (map car naming-lst)
      (map second naming-lst)
      (map third naming-lst)
      (map fourth naming-lst)
      (map fifth naming-lst)
      (map sixth naming-lst))

    (newline)
    (pretty-print 
      (cons
        "The following events (class and type), grobs, engravers and 
start/stop-commands are created"
        naming-lst))))
      
%%%%%%%%%%%%%%%%%%%%%%%
%% Example
%%%%%%%%%%%%%%%%%%%%%%%
%{
        
%% rename path to your file, which holds the engraver code
% \include "multiple-spanner-grobs-engravers.ly"

\createSpannersAndEngravers  #'(Hallo Welt A)

\layout {
  \context {
    \Global
    \grobdescriptions #all-grob-descriptions
  }
  \context {
    \Voice
    \consists \HalloTextSpannerEngraver
    \consists \WeltTextSpannerEngraver
    \consists \ATextSpannerEngraver
  }
}

\relative {
  \override HalloTextSpanner.to-barline = ##f
  
  \override HalloTextSpanner.bound-details.left.text = #"hall"
  \override HalloTextSpanner.bound-details.right.text = #"lo"
  \override WeltTextSpanner.bound-details.left.text = #"we"
  \override WeltTextSpanner.bound-details.right.text = #"lt"
  \override ATextSpanner.bound-details.left.text = #"A"
  \override ATextSpanner.bound-details.right.text = #"A"
 
  a4 b\hallo-start c\welt-start d
  a4 b c d
  a4 \a-start b c\hallo-stop d \welt-stop \break
  
  a4\hallo-start \welt-start b d \a-stop c
  a4 b\hallo-stop c d  \welt-stop
  a1

}
%}