\version "2.19.27"
%% Adapted from 'justify-line-helper' in scm/define-markup-commands.scm.
#(define (distribute-text-spanner-stencils grob args extent padding)
"Return a stencil which spreads @var{args} along an extent
@var{extent}, with spaces filled by a line."
(let* ((orig-stencils
(map (lambda (a) (grob-interpret-markup grob a)) args))
(stencils
(map (lambda (stc)
(if (ly:stencil-empty? stc X)
(ly:make-stencil (ly:stencil-expr stc)
'(0 . 0) (ly:stencil-extent stc Y))
stc))
orig-stencils))
(line-contents
(if (= (length stencils) 1)
(list point-stencil (car stencils) point-stencil)
stencils))
(text-extents
(map (lambda (stc) (ly:stencil-extent stc X))
line-contents))
(te1 text-extents)
;; How much shift is necessary to align left edge of first
;; stencil with extent? Apply this shift to all stencils.
(text-extents
(map (lambda (stc)
(coord-translate
stc
(- (car extent) (caar text-extents))))
text-extents))
;; how much does the last stencil need to be translated for
;; its right edge to touch the end of the spanner?
(last-shift (- (cdr extent) (cdr (last text-extents))))
(word-count (length line-contents))
;; Make a list of stencils and their extents, scaling the
;; extents across extent. The right edge of the last stencil
;; is now aligned with the right edge of the spanner. The
;; first stencil will be moved 0.0, the last stencil the
;; amount given by last-shift.
(stencils-shifted-extents-list
(let loop ((contents line-contents) (exts text-extents)
(idx 0) (result '()))
(if (null? contents)
result
(loop
(cdr contents) (cdr exts) (1+ idx)
(append result
(list
(cons (car contents)
(coord-translate
(car exts)
(* idx
(/ last-shift (1- word-count)))))))))))
; Remove non-marker spacers from list of extents. This is done
; so that a single line is drawn to cover the total gap rather
; than several. (A single line is needed since successive dashed
; lines will not connect properly.) TODO: seems broken!
(stencils-extents-list-no-spacers
(let loop ((orig stencils-shifted-extents-list) (idx 0) (result
'()))
(cond
((= idx (length stencils-shifted-extents-list)) result)
; Ignore first and last stencils, which--if point stencil--
; will be markers.
((or (= idx 0)
(= idx (1- (length stencils-shifted-extents-list))))
(loop (cdr orig) (1+ idx)
(append result (list (car orig)))))
; Remove spacers. Better way to identify them than comparing
; left and right extents?
((= (cadar orig) (cddar orig))
(loop (cdr orig) (1+ idx) result))
; Keep any visible stencil.
(else (loop (cdr orig) (1+ idx)
(append result (list (car orig))))))))
(padding (ly:grob-property grob 'padding 0.0))
(padded-stencils-extents-list
(let loop ((orig stencils-extents-list-no-spacers) (idx 0) (result
'()))
(cond
((= idx (length stencils-extents-list-no-spacers)) result)
;; don't widen line markers
((= (cadar orig) (cddar orig))
(loop (cdr orig) (1+ idx)
(append result (list (car orig)))))
;; right padding only if object starts line
((= idx 0)
(loop (cdr orig) (1+ idx)
(append
result
(list (cons (caar orig)
(coord-translate (cdar orig) (cons 0 padding)))))))
;; left padding only if object ends a line
((= idx (1- (length stencils-extents-list-no-spacers)))
(loop (cdr orig) (1+ idx)
(append
result
(list (cons (caar orig)
(coord-translate (cdar orig) (cons (- padding)
0.0)))))))
;; otherwise right- and left-padding
(else
(loop (cdr orig) (1+ idx)
(append
result
(list (cons (caar orig)
(interval-widen (cdar orig) padding)))))))))
;; Spaces between the text stencils will be filled with lines.
(spaces
(if (> (length padded-stencils-extents-list) 1)
(let loop ((orig padded-stencils-extents-list)
(result '()))
(if (null? (cdr orig))
result
(loop
(cdr orig)
(append
result
(list (cons (cdr (cdr (first orig)))
(car (cdr (second orig)))))))))
'()))
(spaces (remove interval-empty? spaces)))
; Create a stencil using the modified list of extents.
(if (null? (remove ly:stencil-empty? orig-stencils))
empty-stencil
(begin
(set! line-contents
(let loop ((contents stencils-extents-list-no-spacers)
(stil empty-stencil))
(if (null? contents)
stil
(loop
(cdr contents)
(ly:stencil-add stil
(ly:stencil-translate-axis
(caar contents)
(- (car (cdr (car contents)))
(car (ly:stencil-extent (car (car contents)) X)))
X))))))))
; add lines to stencil
(set! line-contents
(let loop ((exts spaces) (result line-contents))
(if (null? exts)
result
(loop
(cdr exts)
(ly:stencil-add
result
;(make-line-stencil 0.1
;; For versions < 2.19.27, replace line below with
;; commented line. No dashed lines!
(ly:line-interface::line grob
(caar exts) 0.0
(cdar exts) 0.0))))))
line-contents))
#(define (normalize-text-list lines text-lst)
;; Make sure every sibling has text.
(let ((text-count (length text-lst)))
(if (< text-count lines)
(let* ((delta (- lines text-count))
(blanks (make-list delta #{ \markup \null #}))
(head (list-head text-lst (- lines 2)))
(tail (append blanks (list (last text-lst)))))
(append head tail))
text-lst)))
#(define (get-line-arrangement grob siblings text-lst)
;; We need to work stencil extents into this. If a spanner
;; ends at the beginning of a measure after a line break (or
;; starts at the end of a line), multiple texts will clump.
(let ((sib-len (length siblings)))
(if (= sib-len 0)
;; only one line...
text-lst
(let* (;; Ensure that all lines have text. If there isn't
;; enough text, blanks are inserted for lines
;; immediately before last such that the last line
;; has text.)
(text-lst (normalize-text-list sib-len text-lst))
(text-lines (make-vector sib-len 0))
;; fill vector with number of texts per line
;; 3 lines, 7 texts: 3, 2, 2
;; Later, we will redistribute texts from
;; first and last lines (as a start) for
;; a better arrangement.
(text-counts
(let loop ((txts text-lst) (idx 0) (lines text-lines))
(cond
((null? txts) lines)
(else
(vector-set! lines idx
(1+ (vector-ref lines idx)))
(loop (cdr txts)
(if (= idx (1- sib-len)) 0 (1+ idx))
lines)))))
;; read texts into vector
(texts-by-line
(let loop ((idx 0) (texts text-lst) (tcs text-counts))
(if (= idx sib-len)
tcs
(let ((num (vector-ref tcs idx)))
(vector-set! tcs idx
(list-head texts num))
(loop (1+ idx)
(list-tail texts num)
tcs)))))
;; Add null-markup at the beginning of lines 2...n.
;; Add null-markup at the end of lines 1...(n-1). Purpose
;; is as anchors for lines which begin and end systems in
;; broken spanners.
(lines-with-markers
(let loop ((idx 0))
(if (= idx (vector-length texts-by-line))
texts-by-line
(begin
(if (> idx 0)
(vector-set! texts-by-line idx
(cons #{ \markup \null #}
(vector-ref texts-by-line idx))))
(if (< idx (1- (vector-length texts-by-line)))
(vector-set! texts-by-line idx
(append (vector-ref texts-by-line idx)
(list #{ \markup \null #}))))
(loop (1+ idx)))))))
;; which text does our sibling take?
(vector-ref
text-lines
(list-index (lambda (x) (eq? x grob)) siblings))))))
%% Based on addTextSpannerText, by Thomas Morley. See
%%http://www.mail-archive.com/lilypond-user%40gnu.org/msg81685.html
addTextSpannerText =
#(define-music-function (text-lst) (list?)
(if (< (length text-lst) 2)
(begin
(ly:warning "At least two texts required for `addTextSpannerText'.")
(make-music 'Music))
#{
% The following overrides of 'bound-details are needed to give the
% correct length to the default spanner we replace.
\once \override TextSpanner.bound-details.left.text = #(car text-lst)
\once \override TextSpanner.bound-details.left-broken.text = ##f
\once \override TextSpanner.bound-details.right.text = #(last
text-lst)
\once \override TextSpanner.bound-details.right-broken.text = ##f
\once \override TextSpanner.stencil =
#(lambda (grob)
(let* ((stil (ly:line-spanner::print grob))
;; have we been split?
(orig (ly:grob-original grob))
;; if yes, get the split pieces (our siblings)
(siblings (if (ly:grob? orig)
(ly:spanner-broken-into orig)
'()))
(stil-ext-X (ly:stencil-extent stil X))
(line-width (interval-length stil-ext-X))
(padding (ly:grob-property grob 'padding 0.0))
(text-line (get-line-arrangement grob siblings text-lst)))
(distribute-text-spanner-stencils
grob text-line stil-ext-X padding)))
#}))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\markup \bold "Default (no inner text possible)"
\relative c'' {
\override TextSpanner.bound-details.left.text = #"ral"
\override TextSpanner.bound-details.left-broken.text = ##f
\override TextSpanner.bound-details.right.text = #"do"
\override TextSpanner.bound-details.right-broken.text = ##f
c,1\startTextSpan
d'1\stopTextSpan
}
\markup \bold "All on one line"
\relative c' {
\addTextSpannerText #(list "ral" "len" "tan" "do")
c1\startTextSpan
d'1\stopTextSpan
}
\markup \bold "Broken"
% Spacer needed so terminal texts don't clump. Texts are
% allocated line1, line2, line1, line2, line1... So
% we have three texts on first line, two on the last--including
% the spacer.
\relative c' {
\override TextSpanner.padding = 1
\addTextSpannerText #(list "ral" "len" "tan" "" "do")
c1\startTextSpan
\break
d'1\stopTextSpan
}
\markup \bold "More lines than text"
\relative c' {
\addTextSpannerText #(list "one" "two" "three")
c1~\startTextSpan
\break
c1~
\break
c1~
\break
c1\stopTextSpan
}
\markup \bold "Markups. Changes of alignment, padding, line-style."
\relative c'' {
\addTextSpannerText #(list
#{ \markup \right-align "ral" #}
"len"
#{ \markup \translate #'(-10 . 0) "tan" #}
#{ \markup \center-align "do" #} )
c,1\startTextSpan
\break
d'2 d\stopTextSpan
}
\relative c'' {
\override TextSpanner.style = #'zigzag
\override TextSpanner.padding = 0.5
\addTextSpannerText #(list
#{ \markup \draw-circle #1 #0.2 ##f #}
#{ \markup \with-color #grey \draw-circle #1 #0.2 ##t
#}
#{ \markup \draw-circle #1 #0.2 ##t #}
#{ \markup \with-color #grey \draw-circle #1 #0.2 ##t
#}
#{ \markup \draw-circle #1 #0.2 ##f #} )
c1\startTextSpan
%\break
d'2 d\stopTextSpan
}
\layout {
ragged-right = ##f
indent = 0
}
