Hi Simon,
On Mon, Sep 14, 2015 at 7:41 AM, Simon Albrecht <simon.albre...@mail.de>
wrote:
> David,
>
> This is tremendous! Thank you very much.
>
You're very welcome!
I was inspired to fix some of the issues with this last version.
Texts are better distributed among the pieces of broken spanners. (The
algorithm in place gives an OK estimation, but it has problems. Help
welcome--don't know if my math is up to the task!)
You can specify the number of texts for each line:
\override TextSpanner.text-spanner-line-count = #'(1 0 1 1)
Overlaps will result in a warning. Fixing them at this point means
changing line distribution, making space, breaking lines--work on the
user's part. We're just replacing default stencils here, not changing
spacing.
************************
Once again, you need 2.19.27. There''s a note in lines 351-353 (*eek*) for
earlier versions, but you can't get the line styles, etc., before the most
recent development release.
************************
Anyway, hope this helps!
David
\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?)
#(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. (The
;; case of fewer texts than lines available is dealt with
;; separately. TODO: ugly code which does not consider the
;; length of texts, only 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))
;; No line can have under one text.
(adjusted
(map (lambda (ex)
(if (< ex 1) (ceiling ex) ex))
exact-per-line)))
;; 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. Well, the mandatory one text per line can
;; put us too high... Need a promote-demote-until-flush.
(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-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
((or (null? siblings)
(< texts-len sib-len))
'())
(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, we have
;; fewer texts than lines, or the result from
;; get-text-distribution' failed, we have this failsafe.
;; 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))))))
;; 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 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)))))))
text-lines))))
%% 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))
%% STUB
#(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)))
;(display all-successive-collisions) (newline) (newline)
;; For now, just print a warning.
(let loop ((lines all-successive-collisions) (idx 0))
(if (pair? lines)
(begin
(if (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)))))
;; Return #t if any collision anywhere.
(any (lambda (x) (eq? x #t))
(map (lambda (y) (any (lambda (y) (eq? y #t)) y))
all-successive-collisions))))
%% STUB
#(define (fix-text-collisions text-distrib overlaps)
text-distrib)
#(define (make-distributed-line-stencil grob stil-stil-extent-list)
"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 'padding 0.0))
(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)))))))
;; 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) 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))
(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))))))
(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))
%% 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)
(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)))
(define (find-ok-arrangement text-distrib)
;; If unbroken, nothing can be done.
(if (null? siblings)
(get-stil-extent-list text-distrib)
(let* ((stil-ext-list
(get-stil-extent-list text-distrib))
(overlaps (check-for-overlaps stil-ext-list)))
(if (not overlaps)
stil-ext-list
(let (;; No changes for now. Note that
;; there will need to be some exit, or
;; we'll get an infinite loop if
;; overlaps can't be resolved...
(corrected-distrib
(fix-text-collisions
text-distrib overlaps)))
;(find-ok-arrangement corrected-distrib)
stil-ext-list)))))
(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))
(all-stils-and-extents
(find-ok-arrangement text-distribution))
;; convert stencil/extent list into finished stencil
(line-stils
(if (null? siblings)
(list (make-distributed-line-stencil grob
all-stils-and-extents))
(map (lambda (sib)
(make-distributed-line-stencil sib
(list-ref
all-stils-and-extents
(list-index
(lambda (x) (eq? x sib))
siblings))))
siblings))))
(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' {
\addTextSpannerText #'("ral" "len" "tan" "do")
c1\startTextSpan
\break
d'1\stopTextSpan
}
\markup \bold "Empty line"
\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.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'1 d\stopTextSpan
}
\relative c'' {
\override TextSpanner.padding = 0.7
\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
}
\layout {
indent = 0
ragged-right = ##f
}_______________________________________________
lilypond-user mailing list
lilypond-user@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-user
