On 21.09.2015 18:13, David Nalesnik wrote:
On Mon, Sep 21, 2015 at 8:41 AM, David Kastrup <d...@gnu.org
<mailto:d...@gnu.org>> wrote:
David Nalesnik <david.nales...@gmail.com
<mailto:david.nales...@gmail.com>> writes:
> Here's a preliminary experiment with using \lyricmode as an
input device
> for text spanner details. It could easily be incorporated into
the larger
> function, but I've pared this down to ask a question.
>
> Is it possible to avoid needing to type \lyricmode when calling
\test?
No. Music functions don't get to choose the syntactic mode of their
arguments. It would be rather tricky to figure out when to switch
back
and forth without causing tokens to be lexed in the wrong mode due to
lookahead.
I was initially worried that the presence of the word "lyric" would be
a potential source of confusion for a user--who is not entering
lyrics, after all. But if we're going to use lyricmode, the command
is a useful reminder. And, really, the improvement over the arcane
entry of my last posted version is huge, so who cares about those
extra characters.
I'm attaching a rewrite of the code which allows an easy mix of
markups/strings and interprets hyphens as connectors. Now there's no
need for a TextSpanner.connectors property.
Duration info is easily available, as are skips. I'm unsure at the
moment how to use this info, though: whether there is more to be
gleaned than simply using durations as a guide to relative spacing,
whether using this info to position texts relative to notes is
possible--or desirable.
This version also gives equal space between texts, promised earlier
but not delivered. (This justification looks immensely better when
long texts are mixed with short.)
Great!
I made an essay on a simpler input interface, which redefines
\startTextSpan as a music function. That would be much preferable at
least in my eyes. What do you think?
(I hope there wouldn’t be any merge conflicts here…)
However, I’m having a problem with this syntax: the attached file gives
lots of
"text-spanner-inner-text-lyric-mode.ly:615:5: error: wrong type for
argument 3. Expecting music, found #<Music function #<procedure #f (arg)>>
c1
\startTextSpan \lyricmode { ral -- len -- tan -- do }"
upon compiling. And I don’t know what my mistake would be…
Best regards, Simon
\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?)
% How much space between line and object to left and right?
% Default is '(0.0 . 0.0).
#(cn-define-grob-property 'line-X-offset number-pair?)
% Vertical shift of connector line, independenf of texts.
#(cn-define-grob-property 'line-Y-offset number?)
#(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 first and last 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-broken-connectors grob text-distribution connectors)
"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 variable 'connectors' holds a list of booleans representing whether
;; a line will be drawn between two successive texts. 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 ((text-distribution (vector->list text-distribution)))
(if (pair? connectors)
(let loop ((td text-distribution)
(joins connectors)
(result '()))
(if (null? td)
result
(let inner ((texts (car td))
(bools joins)
(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.")
#t)
;; 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)))))))))
connectors)))
#(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))
(line-contents
(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-width (interval-length extent))
(text-extents
(map (lambda (stc) (ly:stencil-extent stc X))
line-contents))
(text-lengths
(map (lambda (te) (interval-length te)) text-extents))
(total-text-length
(apply + (map (lambda (te) (interval-length te))
text-extents)))
(total-fill-space (- line-width total-text-length))
(word-count (length line-contents))
(padding (/ (- line-width total-text-length) (1- word-count)))
;; 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))
;; Make a list of stencils and their extents, such that they
;; are spread across the line with equal space ('padding') in
;; between.
(stencils-shifted-extents-list
(let loop ((contents line-contents) (exts text-extents)
(lengths text-lengths)
(shift 0.0) (result '()))
(if (null? contents)
result
(loop
(cdr contents) (cdr exts) (cdr lengths)
(+ shift (car lengths) padding)
(append result
(list
(cons (car contents)
(coord-translate
(car exts)
shift))))))))
;; 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)
"Take a list of stencils and arbitrary extents and return a combined
stencil conforming to the given extents. Lines separate the stencils."
(let* ((padding (ly:grob-property grob 'line-X-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)))))))))
'()))
(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 (or (null? connectors)
(eq? #t connectors)))
(offset-Y (ly:grob-property grob 'line-Y-offset 0.0))
(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
(and (pair? join) (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) offset-Y
(cdar exts) offset-Y))
result)
(if join-all
join
(if (pair? 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))
connectors)))
siblings)))
extractLyricEventInfo =
#(define-scheme-function (lst) (ly:music?)
"Given a music expression @var{lst}, return a list of pairs. The
@code{car} of each pair is the text of any @code{LyricEvent}, and the
@code{cdr} is a boolean representing presence or absence of a hyphen
associated with that @code{LyricEvent}."
;; TODO: include duration info, skips?
(let ((grist (extract-named-music lst '(LyricEvent))))
(let mill ((grist grist) (flour '()))
(if (null? grist)
flour
(let* ((text (ly:music-property (car grist) 'text))
(hyphen (extract-named-music (car grist) 'HyphenEvent))
(hyphen? (not (null? hyphen))))
(mill (cdr grist)
(append flour (list (cons text hyphen?)))))))))
#(define (spread-text-stencil 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 (map cdr texts-and-connectors))
(connectors
(get-broken-connectors grob text-distribution connectors))
(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)))))
%% Based on addTextSpannerText, by Thomas Morley. See
%% http://www.mail-archive.com/lilypond-user%40gnu.org/msg81685.html
startTextSpan =
#(define-music-function (arg) (ly:music?)
(let* ((texts-and-connectors (extractLyricEventInfo arg))
(texts (map car texts-and-connectors)))
(if (< (length texts) 2)
(begin
(ly:warning "At least two texts required for text spanner.")
(make-music 'Music))
;; The following tweaks of 'bound-details are needed to give the
;; correct length to the default spanner we replace.
(tweak '(bound-details left text) (car texts)
(tweak '(bound-details left-broken text) #f
(tweak '(bound-details right text) (last texts)
(tweak '(bound-details right-broken text) #f
(tweak 'stencil spread-text-stencil startTextSpan))))))))
%%%%%%%%%%%%% EXAMPLES %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\markup \bold "Default (no inner text possible)"
\relative c'' {
%\override TextSpanner.thickness = 5
\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' {
c1\startTextSpan \lyricmode { ral -- len -- tan -- do }
d'1\stopTextSpan
}
\markup \bold "Broken"
\relative c' {
%% to show collision detection
%\override TextSpanner.text-spanner-line-count = #'(2 2)
c1\startTextSpan \lyricmode { ral -- len -- tan -- do }
\break
d'1\stopTextSpan
}
\markup \bold "Empty line/manual distribution"
\relative c' {
\override TextSpanner.text-spanner-line-count = #'(1 0 1 1)
c1~\startTextSpan \lyricmode { one -- two -- three }
\break
c1~
\break
c1~
\break
c1\stopTextSpan
}
\markup \bold "Changes of ends"
\relative c' {
c1\startTextSpan \lyricmode { one -- two -- three }
c1\stopTextSpan
\once \override TextSpanner.bound-details.left.padding = #-2
\once \override TextSpanner.bound-details.right.padding = #-5
c1\startTextSpan \lyricmode { one -- two -- three }
c1\stopTextSpan
}
\markup \bold "Markups"
\relative c' {
c1\startTextSpan \lyricmode {
\markup "one" -- \markup "two" -- \markup "three"
}
c1\stopTextSpan
c1\startTextSpan \lyricmode {
\markup "one" --
\markup \with-color #red \translate #'(-3 . 0) "two" --
\markup "three"
}
c1\stopTextSpan
\override TextSpanner.style = #'dotted-line
\override TextSpanner.dash-period = #0.5
c1\startTextSpan \lyricmode {
\markup \right-align "one" --
"two" --
\markup \center-align "three" --
}
c1\stopTextSpan
}
\relative c'' {
\override TextSpanner.style = #'zigzag
\override TextSpanner.line-X-offset = #'(0.5 . 0.5)
c1\startTextSpan \lyricmode
{
\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 --
}
%\break
d'1 d\stopTextSpan
}
\markup \bold "Showing/hiding connectors"
\relative c' {
c1
\override TextSpanner.padding = 3
\override TextSpanner.text-spanner-line-count = #'(4 0 1)
\textSpannerDown
c1\startTextSpan \lyricmode {
poco a poco dim. -- \markup \dynamic "mf"
}
c1 c1
\break
c1 c1 c1 c1
\break
c1 c1 c1
c1\stopTextSpan
}
\markup \bold "Raising/lowering of connector line"
\relative c' {
\override TextSpanner.line-X-offset = #'(0.5 . 0.5)
\override TextSpanner.line-Y-offset = 0.5
c1\startTextSpan \lyricmode { ral -- len -- tan -- do }
d'1\stopTextSpan
}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% See http://www.lilypond.org/doc/v2.19/Documentation/notation/opera-and-stage-musicals#dialogue-over-music
music = \relative {
\override TextSpanner.text-spanner-line-count = #'(8 5)
a'4-\tweak font-shape #'upright \startTextSpan \lyricmode {
\markup \fontsize #1 \upright \smallCaps Abe:
Say this over measures one and two
and this over measure three
} a a a
a4 a a a
\break
a4 a a a\stopTextSpan
}
\new Staff {
\music
}
\layout {
indent = 0
ragged-right = ##f
}_______________________________________________
lilypond-user mailing list
lilypond-user@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-user
