On Sun, Sep 6, 2015 at 12:17 PM, David Nalesnik <[email protected]>
wrote:
>
>
> Hopefully another step forward!
>
>
Attached is an improvement.
2.19.27 has been released, and you need this version to get the full
functionality here. (There is provision for earlier versions--see note far
down in the first function--but you'll only get solid lines, unless you're
up for some heavy enhancement.)
The alignment of texts at the beginning and end is fixed, so you can
left-align, right-align, translate, whatever, with predictable results.
You can spread texts over more than two lines. Here, the algorithm is
pretty simple, and is more of a placeholder. Unfortunately, text can clump
when a spanner starts close to the line end or ends close to the start.
You can tweak the line distribution by adding spacers (""), as explained in
one of the examples. What's needed is an algorithm that looks for overlaps
and shifts texts from first line forward, last line back as needed. I've
been pondering this. Probably it will require creating a new property
which specifies text count per line, so there isn't massive redundant
calculation. On the TODO list. At the moment, if I have to write another
loop, I will scream :)
Anyway, enjoy!
David
\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
}_______________________________________________
lilypond-user mailing list
[email protected]
https://lists.gnu.org/mailman/listinfo/lilypond-user
