On Mon, Sep 21, 2015 at 8:41 AM, David Kastrup <d...@gnu.org> wrote: > David Nalesnik <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.) DN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\version "2.19.27" %%%%%%%%%%%%%%%%%%%%%%%%%%%% FUNCTIONS TO INCLUDE %%%%%%%%%%%%%%%%%%%%%%%% %% 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?))))))))) %% Based on addTextSpannerText, by Thomas Morley. See %% http://www.mail-archive.com/lilypond-user%40gnu.org/msg81685.html addTextSpannerText = #(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 `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 (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))))) #}))) %%%%%%%%%%%%%%%%%%%%%%%%%%% END FUNCTIONS TO INCLUDE %%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 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' { \addTextSpannerText \lyricmode { 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 \lyricmode { 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 \lyricmode { one -- two -- three } c1~\startTextSpan \break c1~ \break c1~ \break c1\stopTextSpan } \markup \bold "Changes of ends" \relative c' { \addTextSpannerText \lyricmode { one -- two -- three } c1\startTextSpan c1\stopTextSpan \once \override TextSpanner.bound-details.left.padding = #-2 \once \override TextSpanner.bound-details.right.padding = #-5 \addTextSpannerText \lyricmode { one -- two -- three } c1\startTextSpan c1\stopTextSpan } \markup \bold "Markups" \relative c' { \addTextSpannerText \lyricmode { \markup "one" -- \markup "two" -- \markup "three" } c1\startTextSpan c1\stopTextSpan \addTextSpannerText \lyricmode { \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 \lyricmode { \markup \right-align "one" -- "two" -- \markup \center-align "three" -- } c1\startTextSpan c1\stopTextSpan } \relative c'' { \override TextSpanner.style = #'zigzag \override TextSpanner.line-X-offset = #'(0.5 . 0.5) \addTextSpannerText \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 -- } c1\startTextSpan %\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 \addTextSpannerText \lyricmode { "poco" "a" "poco" "dim." -- \markup \dynamic "mf" } c1\startTextSpan 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 \addTextSpannerText \lyricmode { ral -- len -- tan -- do } c1\startTextSpan 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) \addTextSpannerText \lyricmode { \markup \fontsize #1 \upright \smallCaps Abe: "Say" "this" "over" "measures" "one" "and" "two" "and" "this" "over" "measure" "three" } a'4\startTextSpan 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
