\version "2.19.27"

%\include "lilypond-book-preamble.ly"

\paper {
  indent = 0\cm
}

% Based on input/regression/scheme-text-spanner.ly

#(define-event-class 'box-span-event 'span-event)

#(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 (box-it grob)
   (let ((texts (ly:grob-object grob 'texts)))
     (if (ly:grob-array? texts)
         (let* ((lb (ly:spanner-bound grob LEFT))
                (rb (ly:spanner-bound grob RIGHT))
                (common-x (ly:grob-common-refpoint lb rb X))
                (common-y (ly:grob-common-refpoint lb rb Y))
                (l-ext (ly:grob-extent lb common-x X))
                (l-ext (interval-widen l-ext 1))
                (r-ext (ly:grob-extent rb common-x X))
                (r-ext (interval-widen r-ext 1))
                (height (ly:relative-group-extent texts common-y Y))
                (height (interval-widen height 1))
                (x-coord (ly:grob-relative-coordinate lb common-x X))
                (dh (interval-length height))
                (bottom (ly:line-interface::line grob (car l-ext) 0.0 (cdr r-ext) 0.0))
                (top (ly:line-interface::line grob (car l-ext) dh (cdr r-ext) dh))
                (left (ly:line-interface::line grob (car l-ext) 0.0 (car l-ext) dh))
                (right (ly:line-interface::line grob (cdr r-ext) 0.0 (cdr r-ext) dh))
                (stil (apply ly:stencil-add (list top bottom left right)))
                (stil (ly:make-stencil (ly:stencil-expr stil) '(0 . 0) '(0 . 0)))
                (sp (ly:grob-property grob 'staff-padding))
                (radius (ly:staff-symbol-staff-radius grob))
                (offset-y (- (car height) radius sp))
                (stil (ly:stencil-translate stil
                        (cons (- x-coord) offset-y))))
           stil)
         empty-stencil)))

#(add-grob-definition
  'BoxTextSpanner
  `(
     (dash-fraction . 0.2)
     (dash-period . 3.0)
     (direction . ,UP)
     (staff-padding . 0.8)
     (stencil . ,box-it)
     (style . dashed-line)
     (meta . ((class . Spanner)
              (interfaces . (line-interface
                             line-spanner-interface
                             side-position-interface))))))

#(define scheme-event-spanner-types
   '(
      (BoxSpanEvent
       . ((description . "Used to signal where scheme text boxes
start and stop.")
          (types . (general-music box-span-event span-event event))
          ))
      ))

#(set!
  scheme-event-spanner-types
  (map (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)))
    scheme-event-spanner-types))

#(set! music-descriptions
       (append scheme-event-spanner-types music-descriptions))

#(set! music-descriptions
       (sort music-descriptions alist<?))

#(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 (eq? 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 (eq? axis X)
             ly:side-position-interface::x-aligned-side
             side-position-interface::y-aligned-side)
         (axis-offset-symbol axis)))))

boxTextSpannerEngraver =
#(lambda (context)
   (let ((span '())
         (finished '())
         (event-start '())
         (event-stop '()))
     (make-engraver
      (listeners ((box-span-event engraver event)
                  (if (= START (ly:event-property event 'span-direction))
                      (set! event-start event)
                      (set! event-stop event))))
      (acknowledgers ((text-script-interface engraver grob source-engraver)
                      (if (ly:spanner? span)
                          (begin
                           (ly:pointer-group-interface::add-grob span 'texts grob)
                           (add-bound-item span grob)))
                      (if (ly:spanner? finished)
                          (begin
                           (ly:pointer-group-interface::add-grob finished 'texts grob)
                           (add-bound-item finished grob)))))
      ((process-music 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 'BoxTextSpanner event-start))
             (set-axis! span Y)
             (set! event-start '()))))
      ((stop-translation-timestep 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 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 '())))))))

boxSpanStart =
#(make-span-event 'BoxSpanEvent START)

boxSpanEnd =
#(make-span-event 'BoxSpanEvent STOP)

\layout {
  \context {
    \Global
    \grobdescriptions #all-grob-descriptions
  }
  \context {
    \Voice
    \consists \boxTextSpannerEngraver
  }
}

pieceTitle =
#(define-event-function (text) (markup?)
   #{
     -\tweak TextScript.self-alignment-X #LEFT
     -\tweak TextScript.self-alignment-Y #DOWN
     -\tweak TextScript.padding 3
     -\markup \rotate #90 #text
   #})




pieceTitle =
#(define-event-function (text) (markup?)
   #{
     -\tweak TextScript.self-alignment-X #LEFT
     -\tweak TextScript.self-alignment-Y #DOWN
     -\tweak TextScript.padding 3
     -\markup \rotate #90 #text
   #})

notes = \relative es' {
  \omit Staff.Stem
  \key as \major
  \time 3/4
  \boxSpanStart
  es ^ \pieceTitle "Pierrot"
  <g bes>
  es
  |
  <bes'\harmonic f'> ^\pieceTitle "Arlequin"
  \boxSpanEnd s2
  |
  bes4 ^\pieceTitle "Valse noble"
  g bes
  |
  \time 2/4
  \boxSpanStart es,4 ^\pieceTitle "Eusebius"
  s4
  |
  \time 5/4
  <<
    {
      <bes' \harmonic f'>4 ^\pieceTitle "Florestan"
    }
    \new Voice {
      <g \harmonic d'>
    }
  >>
  \boxSpanEnd s8
  bes4
  s8
  <g \harmonic d'>4
  s4
  \bar ";"
  |
  \time 3/4
  bes4 ^\pieceTitle "Coquette"
  s2
  \bar ";"
  |
  bes4 ^\pieceTitle "Réplique"
  s8
  g4 s8
  \bar "||"
}

functionsOne = \lyricmode {
  \set stanza = \markup \circle "B:"
  S2.
  D2.
  T2.
  S2
}

functionsTwo = \lyricmode {
  \set stanza = \markup  \circle  "g:"
  \skip2.*3
  tG2
  \markup { D \hspace #-.8 \super 7 }4*5
  (tP)2.
  t2
}

\score {
  <<
    \new Staff {
      \omit Score.TimeSignature
      \notes
    }
    \new Lyrics \functionsOne
    \new Lyrics \functionsTwo
  >>
}