Hi,
Alright! This should do it...
You can:
--Adapt this for versions < 2.19.27 with a loss of overriding power (style,
dash-fraction, etc.)--see comments beginning in line 435
--Use/mix markups and strings.
--Specify any number of texts >= 2 for your spanner.
--Break it across an arbitrary number of lines, with an acceptable
distribution.
--Use spacers ("") to force texts closer/farther apart. You can also move
them like this:
\markup \translate [...]
\markup \right-align [...]
etc.
--Override the number of texts per line if you don't like the automatic
distribution. There's a warning if the numbers don't tally.
--Specify which texts will be joined by a line and which won't using
TextSpanner.connectors. I noticed this request in another related thread:
http://www.mail-archive.com/lilypond-user%40gnu.org/msg103939.html
The default is to join everything, and we revert to that with a warning if
you specify too few connections. (Full disclosure: you can't hide one half
of a line crossing a break and show the other half, but unless there's some
pressing need, I'm going to forget I noticed this....)
--Change the distance from text to line with TextSpanner.line-offset, which
defaults to #'(0.0 . 0.0).
Additionally, there are warnings for overlaps. There's no attempt at
fixing these. I wouldn't know how to influence spacing.
By the way, is there a way to get spacing to accommodate really long
left/right texts with ordinary TextSpanners without resorting to
\newSpacingArea, manual breaks, and the like? I don't find a mechanism:
\textLengthOn doesn't seem to work...
Enjoy--
David
P.S. One area of further improvement would be the input syntax. Any
suggestions for making this more user-friendly? I can't figure out how to
get markups to process properly without that off-putting
#(list #{ \markup "foo" #} )
construction.
%%%%%%%
\version "2.19.27"
%% CUSTOM GROB PROPERTIES
% Taken from http://www.mail-archive.com/lilypond-user%40gnu.org/msg97663.html
% (Paul Morris)
% function from "scm/define-grob-properties.scm" (modified)
#(define (cn-define-grob-property symbol type?)
(set-object-property! symbol 'backend-type? type?)
(set-object-property! symbol 'backend-doc "custom grob property")
symbol)
% For internal use.
#(cn-define-grob-property 'text-spanner-stencils list?)
% user interface
#(cn-define-grob-property 'text-spanner-line-count number-list?)
% List of booleans describing connections between text items regardless
% of line breaks.
#(cn-define-grob-property 'connectors list?)
% How much space between line and object to left and right?
% Default is '(0.0 . 0.0).
#(cn-define-grob-property 'line-offset number-pair?)
#(define (get-text-distribution text-list line-extents)
;; Given a list of texts and a list of line extents, attempt to
;; find a decent line distribution. The goal is to put more texts
;; on longer lines, while ensuring that all lines are texted.
;; TODO: ideally, we should consider extents of text, rather than
;; simply their number.
(let* ((line-count (length line-extents))
(text-count (length text-list))
(line-lengths
(map (lambda (line) (interval-length line))
line-extents))
(total-line-len (apply + line-lengths))
(exact-per-line
(map (lambda (line-len)
(* text-count (/ line-len total-line-len)))
line-lengths))
;; First and last lines can't be untexted.
(adjusted
(let loop ((epl exact-per-line) (idx 0) (result '()))
(if (null? epl)
result
(if (and (or (= idx 0)
(= idx (1- line-count)))
(< (car epl) 1))
(loop (cdr epl) (1+ idx)
(append result (list 1.0)))
(loop (cdr epl) (1+ idx)
(append result (list (car epl)))))))))
;; The idea is to raise the "most roundable" line's count, then the
;; "next most roundable," and so forth, until we account for all texts.
;; Everything else is rounded down (except those lines which need to be
;; bumped up to get the minimum of one text), so we shouldn't exceed our
;; total number of texts.
;; TODO: Need a promote-demote-until-flush to be safe, unless this is
;; mathematically sound!
(define (promote-until-flush result)
(let* ((floored (map floor result))
(total (apply + floored)))
(if (>= total text-count)
(begin
;(format #t "guess: ~a~%~%~%" result)
floored)
(let* ((decimal-amount
(map (lambda (x) (- x (floor x))) result))
(maximum (apply max decimal-amount))
(max-location
(list-index
(lambda (x) (= x maximum))
decimal-amount))
(item-to-bump (list-ref result max-location)))
;(format #t "guess: ~a~%" result)
(list-set! result max-location (1+ (floor item-to-bump)))
(promote-until-flush result)))))
(let ((result (map inexact->exact
(promote-until-flush adjusted))))
(if (not (= (apply + result) text-count))
;; If this doesn't work, discard, triggering crude
;; distribution elsewhere.
'()
result))))
#(define (get-connectors grob text-distribution)
"Modify @var{text-distribution} to reflect line breaks. Return a list
of lists of booleans representing whether to draw a connecting line
between successive texts."
;; The property TextSpanner.connectors holds a list of booleans representing
;; whether a line will be drawn between two texts. (Thus, there will be
;; one fewer boolean than texts.) This does NOT include spacers: "".
;; This function transforms the list of booleans into a list of lists
;; of booleans which reflects line breaks and the additional lines
;; which must be drawn.
;;
;; Given an input of '(#t #t #f)
;;
;; '((#t #t #f))
;; one_ _ _ _two_ _ _ _ _three four (one line)
;;
;; '((#t #t)
;; one_ _ _ _two_ _ _ _ _ (two lines)
;; (#t #f))
;; _ _ _ _three four
;;
;; '((#t)
;; one_ _ _ _ (four lines/blank)
;; (#t #t)
;; _ _ _two_ _ _
;; (#t)
;; _ _ _ _ _ _ _
;; (#t #f))
;; _ _three four
(let* ((connectors? (ly:grob-property grob 'connectors))
(text-distribution (vector->list text-distribution)))
(if (pair? connectors?)
(let loop ((td text-distribution)
(c? connectors?)
(result '()))
(if (null? td)
result
(let inner ((texts (car td))
(bools c?)
(inner-result '()))
(cond
((null? (cdr texts))
(loop (cdr td) bools
(append result (list inner-result))))
((null? bools)
(ly:warning
"too few connections specified. Reverting to default.")
'())
;; Ignore spacers since they don't represent a new line.
((equal? "" (cadr texts))
(inner (cdr texts) bools inner-result))
((equal? (cadr texts) #{ \markup \null #})
(inner (cdr texts) bools
(append inner-result (list (car bools)))))
(else
(inner (cdr texts) (cdr bools)
(append inner-result (list (car bools)))))))))
'())))
#(define (get-line-arrangement siblings extents texts)
"Given a list of spanner extents and texts, return a vector of lists
of the texts to be used for each line. Using @code{'()} for @var{siblings}
returns a vector for an unbroken spanner."
(let ((sib-len (length siblings)))
(if (= sib-len 0)
;; only one line...
(make-vector 1 texts)
(let* ((texts-len (length texts))
(text-counts
(ly:grob-property
(car siblings) 'text-spanner-line-count))
(text-counts
(cond
((pair? text-counts) text-counts) ; manual override
((null? siblings) '())
(else (get-text-distribution texts extents))))
(text-counts
(if (and (pair? text-counts)
(not (= (apply + text-counts) texts-len)))
(begin
(ly:warning "Count doesn't match number of texts.")
'())
text-counts))
(text-lines (make-vector sib-len 0))
;; If user hasn't specified a count elsewhere, or the result
;; from 'get-text-distribution' failed, we have this method.
;; Populate vector in a simple way: with two lines,
;; give one text to the first line, one to the second,
;; a second for the first, and second for the second--
;; and so forth, until all texts have been exhausted. So
;; for 3 lines and 7 texts we would get this arrangement:
;; 3, 2, 2.
(text-counts
(cond
((null? text-counts)
(let loop ((txts texts) (idx 0))
(cond
((null? txts) text-lines)
;; We need to ensure that the last line has text.
;; This may require skipping lines.
((and (null? (cdr txts))
(< idx (1- sib-len))
(= 0 (vector-ref text-lines (1- sib-len))))
(vector-set! text-lines (1- sib-len) 1)
text-lines)
(else
(vector-set! text-lines idx
(1+ (vector-ref text-lines idx)))
(loop (cdr txts)
(if (= idx (1- sib-len)) 0 (1+ idx)))))))
(else (set! text-lines (list->vector text-counts)))))
;; read texts into vector
(texts-by-line
(let loop ((idx 0) (texts texts))
(if (= idx sib-len)
text-lines
(let ((num (vector-ref text-lines idx)))
(vector-set! text-lines idx
(list-head texts num))
(loop (1+ idx)
(list-tail texts num)))))))
text-lines))))
#(define (add-markers text-lines)
;; Markers are added to the broken edges of spanners to serve as anchors
;; for connector lines beginning and ending systems.
;; Add null-markup at the beginning of lines 2...n.
;; Add null-markup at the end of lines 1...(n-1).
;; Note: this modifies the vector 'text-lines'.
(let loop ((idx 0))
(if (= idx (vector-length text-lines))
text-lines
(begin
(if (> idx 0)
(vector-set! text-lines idx
(cons #{ \markup \null #}
(vector-ref text-lines idx))))
(if (< idx (1- (vector-length text-lines)))
(vector-set! text-lines idx
(append (vector-ref text-lines idx)
(list #{ \markup \null #}))))
(loop (1+ idx))))))
%% Adapted from 'justify-line-helper' in scm/define-markup-commands.scm.
#(define (markup-list->stencils-and-extents-for-line grob texts extent padding)
"Given a list of markups @var{texts}, return a list of stencils and extents
spread along an extent @var{extent}, such that the intervening spaces are
equal."
(let* ((orig-stencils
(map (lambda (a) (grob-interpret-markup grob a)) texts))
(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.)
(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)))))))))
stencils-extents-list-no-spacers))
#(define (check-for-overlaps stil-extent-list)
(let* ((collision
(lambda (line)
(let loop ((exts line) (result '()))
(if (null? (cdr exts))
result
(loop (cdr exts)
(append result
(list
(not (interval-empty?
(interval-intersection
(cdar exts) (cdadr exts)))))))))))
;; List of lists of booleans comparing first element to second,
;; second to third, etc., for each line. #f = no collision
(all-successive-collisions
(map (lambda (line) (collision line))
stil-extent-list)))
;; For now, just print a warning and return #t if any collision anywhere.
(let loop ((lines all-successive-collisions) (idx 0) (collisions? #f))
(cond
((null? lines) collisions?)
((any (lambda (p) (eq? p #t)) (car lines))
(ly:warning
"overlap(s) found on line ~a; redistribute manually"
(1+ idx))
(loop (cdr lines) (1+ idx) #t))
(else
(loop (cdr lines) (1+ idx) collisions?))))))
#(define (make-distributed-line-stencil grob stil-stil-extent-list connectors)
;; Should take connectors? argument.
"Take a list of stencils and arbitrary extents and return a combined
stencil conforming to the given extents. Lines separate the stencils.
TODO: lines should be suppressed if not enough space."
(let* ((padding (ly:grob-property grob 'line-offset (cons 0.0 0.0)))
(padding-L (car padding))
(padding-R (cdr padding))
(padded-stencils-extents-list
(let loop ((orig stil-stil-extent-list) (idx 0) (result '()))
(cond
((= idx (length stil-stil-extent-list)) 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-R)))))))
;; left padding only if object ends a line
((= idx (1- (length stil-stil-extent-list)))
(loop (cdr orig) (1+ idx)
(append
result
(list (cons (caar orig)
(coord-translate
(cdar orig) (cons (- padding-L) 0.0)))))))
;; otherwise right- and left-padding
(else
(loop (cdr orig) (1+ idx)
(append
result
(list (cons (caar orig)
(coord-translate
(cdar orig)
(cons (- padding-L)
padding-R))))))))))
;; 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)))))))))
'()))
;; TODO: Do this when making lines. Otherwise will disrupt
;; show/hide connectors.
(spaces (remove interval-empty? spaces))
(line-contents
(let loop ((contents stil-stil-extent-list)
(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))))))
;; By default, lines are drawn between all texts
(join-all (null? connectors))
(line-contents
(let loop ((exts spaces)
(result line-contents)
(join connectors))
(if (null? exts)
result
(loop
(cdr exts)
(if (and
;; space too short for line
(not (interval-empty? (car exts)))
(or join-all
(car join)))
(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))
result)
(if join-all join (cdr join)))))))
line-contents))
#(define (make-stencils grob siblings stil-extent-list connectors)
;; entry point for stencil construction
(if (null? siblings)
(list (make-distributed-line-stencil grob
(car stil-extent-list)
(if (pair? connectors)
(car connectors)
connectors)))
(map (lambda (sib)
(make-distributed-line-stencil sib
(list-ref
stil-extent-list
(list-index
(lambda (x) (eq? x sib))
siblings))
(if (pair? connectors)
(list-ref
connectors
(list-index
(lambda (x) (eq? x sib))
siblings))
'())))
siblings)))
%% Based on addTextSpannerText, by Thomas Morley. See
%% http://www.mail-archive.com/lilypond-user%40gnu.org/msg81685.html
addTextSpannerText =
#(define-music-function (texts) (list?)
(if (< (length texts) 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 texts)
\once \override TextSpanner.bound-details.left-broken.text = ##f
\once \override TextSpanner.bound-details.right.text = #(last texts)
\once \override TextSpanner.bound-details.right-broken.text = ##f
\once \override TextSpanner.stencil =
#(lambda (grob)
(let* (;; 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)
'()))
(stils (ly:grob-property grob 'text-spanner-stencils)))
;; If stencils haven't been calculated, calculate them. Once
;; we have results prompted by one sibling, no need to go
;; through elaborate calculation (stencils, collisions, ideal
;; line contents...) for remaining pieces.
(if (null? stils)
(let* (;; pieces and their default stencils
(grobs-and-stils
(if (null? siblings) ; unbroken
(list (cons grob (ly:line-spanner::print grob)))
(map
(lambda (sib)
(cons sib (ly:line-spanner::print sib)))
siblings)))
(line-stils
(map (lambda (gs) (cdr gs)) grobs-and-stils))
(line-extents
(map (lambda (s) (ly:stencil-extent s X))
line-stils))
(our-stil
(cdr (find (lambda (x) (eq? (car x) grob))
grobs-and-stils)))
(padding (ly:grob-property grob 'padding 0.0)))
(define (get-stil-extent-list text-distrib)
(if (null? siblings)
(list
(markup-list->stencils-and-extents-for-line
grob
(vector-ref text-distrib 0)
(ly:stencil-extent our-stil X)
padding))
(map
(lambda (sib)
(markup-list->stencils-and-extents-for-line
sib
(vector-ref text-distrib
(list-index
(lambda (y) (eq? y sib)) siblings))
(ly:stencil-extent
(cdr (find
(lambda (z) (eq? (car z) sib))
grobs-and-stils))
X)
padding))
siblings)))
(let*
(;; vector which gives the text for unbroken spanner
;; or for siblings. This is a preliminary
;; arrangement, to be tweaked below.
(text-distribution
(get-line-arrangement siblings line-extents texts))
(text-distribution (add-markers text-distribution))
(connectors (get-connectors grob text-distribution))
(all-stils-and-extents
(get-stil-extent-list text-distribution))
;; warning printed
(overlaps (check-for-overlaps all-stils-and-extents))
;; convert stencil/extent list into finished stencil
(line-stils
(make-stencils
grob siblings all-stils-and-extents connectors)))
(if (null? siblings)
(set! (ly:grob-property grob 'text-spanner-stencils)
line-stils)
(for-each
(lambda (sib)
(set!
(ly:grob-property sib 'text-spanner-stencils)
line-stils))
siblings))
(set! stils line-stils))))
;; Return our stencil
(if (null? siblings)
(car stils)
(list-ref stils
(list-index (lambda (x) (eq? x grob)) siblings)))))
#}))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% EXAMPLES %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\markup \bold "Default (no inner text possible)"
\relative c'' {
\textLengthOff
\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 #'("ral" "len" "tan" "do")
c1\startTextSpan
d'1\stopTextSpan
}
\markup \bold "Broken"
\relative c' {
%% to show collision detection
%\override TextSpanner.text-spanner-line-count = #'(2 2)
\addTextSpannerText #'("ral" "len" "tan" "do")
c1\startTextSpan
\break
d'1\stopTextSpan
}
\markup \bold "Empty line/manual distribution"
\relative c' {
\override TextSpanner.text-spanner-line-count = #'(1 0 1 1)
\addTextSpannerText #(list "one" "two" "three")
c1~\startTextSpan
\break
c1~
\break
c1~
\break
c1\stopTextSpan
}
\markup \bold "Changes of ends"
\relative c' {
\addTextSpannerText #'("one" "two" "three")
c1\startTextSpan
c1\stopTextSpan
\once \override TextSpanner.bound-details.left.padding = #-2
\once \override TextSpanner.bound-details.right.padding = #-5
\addTextSpannerText #'("one" "two" "three")
c1\startTextSpan
c1\stopTextSpan
}
\markup \bold "Markups"
\relative c' {
\addTextSpannerText #(list
#{ \markup "one" #}
#{ \markup "two" #}
#{ \markup "three" #})
c1\startTextSpan
c1\stopTextSpan
\addTextSpannerText
#(list
#{ \markup "one" #}
#{ \markup \with-color #red \translate #'(-3 . 0) "two" #}
#{ \markup "three" #})
c1\startTextSpan
c1\stopTextSpan
\override TextSpanner.style = #'dotted-line
\override TextSpanner.dash-period = #0.5
\addTextSpannerText #(list
#{ \markup \right-align "one" #}
"two"
#{ \markup \center-align "three" #})
c1\startTextSpan
c1\stopTextSpan
}
\relative c'' {
\override TextSpanner.style = #'zigzag
\override TextSpanner.line-offset = #'(0.5 . 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'1 d\stopTextSpan
}
\relative c'' {
\override TextSpanner.line-offset = #'(0.7 . 0.4)
\override TextSpanner.style = #'trill
r2 r4 r8 r16
\addTextSpannerText
#(append
(make-list 29
#{ \markup \general-align #Y #CENTER \musicglyph #"scripts.trill" #})
(list #{ \markup \musicglyph #"scripts.caesura.straight" #} ))
d'16~\startTextSpan
\break
\repeat unfold 3 {
d1~
\break
}
d8~ d\stopTextSpan r4 r2
}
\markup \bold "Showing/hiding connectors"
\relative c' {
c1
\override TextSpanner.padding = 3
\override TextSpanner.direction = #DOWN
\override TextSpanner.connectors = #'(#f #f #f #t)
\override TextSpanner.text-spanner-line-count = #'(4 0 1)
\addTextSpannerText
#(list "poco" "a" "poco" "dim." #{ \markup \dynamic "mf" #})
c1\startTextSpan
c1 c1
\break
c1 c1 c1 c1
\break
c1 c1 c1
c1\stopTextSpan
}
\layout {
indent = 0
ragged-right = ##f
}
_______________________________________________
lilypond-user mailing list
lilypond-user@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-user