On Sat, Oct 3, 2015 at 12:02 PM, David Nalesnik <[email protected]>
wrote:
>
>
> So here is a revised version of the TextSpanner code.
>
>
Oh *drat* Attached the wrong file. Apologies...
DN
\version "2.19"
%% Based on the rewrite of Text_spanner_engraver in
%% input/regression/scheme-text-spanner.ly
#(define (add-bound-item spanner item)
(if (null? (ly:spanner-bound spanner LEFT))
(ly:spanner-set-bound! spanner LEFT item)
(ly:spanner-set-bound! spanner RIGHT item)))
#(define (axis-offset-symbol axis)
(if (eq? axis X) 'X-offset 'Y-offset))
#(define (set-axis! grob axis)
(if (not (number? (ly:grob-property grob 'side-axis)))
(begin
(set! (ly:grob-property grob 'side-axis) axis)
(ly:grob-chain-callback
grob
(if (eq? axis X)
ly:side-position-interface::x-aligned-side
side-position-interface::y-aligned-side)
(axis-offset-symbol axis)))))
schemeTextSpannerEngraver =
#(lambda (context)
(let ((span '()) ; list of started spanners
(finished '()) ; list of spanners in completion stage
(event-start '()) ; list of START events
(event-stop '())) ; list of STOP events
(make-engraver
;; \startTextSpan, \stopTextSpan, and the like create events
;; which we collect here.
(listeners
((text-span-event engraver event)
(if (= START (ly:event-property event 'span-direction))
(set! event-start (cons event event-start))
(set! event-stop (cons event event-stop)))))
;; Populate 'note-columns property of spanners. Bounds are
;; set to note columns, and each spanner keeps a record of
;; the note columns it traverses.
(acknowledgers
((note-column-interface engraver grob source-engraver)
(for-each (lambda (s)
(ly:pointer-group-interface::add-grob
s 'note-columns grob)
(add-bound-item s grob))
span)
(for-each (lambda (f)
(ly:pointer-group-interface::add-grob
f 'note-columns grob)
(add-bound-item f grob))
finished)))
((process-music trans)
;; Move begun spanners from 'span' to 'finished'. We do this
;; on the basis of 'spanner-id. If we find a match--either
;; the strings are the same, or both are unset--a transfer
;; can be made. Return a warning if we find no match: spanner
;; hasn't been properly begun.
(for-each
(lambda (es)
(let ((es-id (ly:event-property es 'spanner-id)))
(let loop ((sp span))
(let ((sp-id (ly:event-property
(event-cause (car sp)) 'spanner-id)))
(cond
((null? sp) (ly:warning "No spanner to end!!"))
((and
(string? sp-id)
(string? es-id)
(string=? sp-id es-id))
(set! finished (cons (car sp) finished))
(set! span (remove (lambda (s) (eq? s (car sp))) span)))
((and
(null? sp-id)
(null? es-id))
(set! finished (cons (car sp) finished))
(set! span (remove (lambda (s) (eq? s (car sp))) span)))
(else (loop (cdr sp))))))))
event-stop)
;; The end of our spanners can be acknowledged by other engravers.
(for-each
(lambda (f)
(ly:engraver-announce-end-grob trans f (event-cause f)))
finished)
;; Make spanners called for by START events. To each new spanner,
;; add any existing spanners to the 'side-support-elements array.
;; This ensures correct ordering over line breaks when 'outside-
;; staff-priority is set to #f. Ordinarily, for TextSpanner this
;; is 350.
(for-each
(lambda (es)
(let ((new (ly:engraver-make-grob trans 'TextSpanner es)))
(for-each
(lambda (sp)
(ly:pointer-group-interface::add-grob new
'side-support-elements sp))
span)
(set! span (cons new span))
(set-axis! (car span) Y)))
event-start)
;; Events have served their purpose for this timestep. Clear
;; the way for new events in later timesteps.
(set! event-start '())
(set! event-stop '()))
((stop-translation-timestep trans)
;; Set bounds of spanners to PaperColumns if they haven't been set.
;; This allows spanners to be drawn between spacers. Other uses?
;; Doesn't appear to affect whether spanners can de drawn between
;; rests.
(for-each
(lambda (s)
(if (null? (ly:spanner-bound s LEFT))
(ly:spanner-set-bound! s LEFT
(ly:context-property context 'currentMusicalColumn))))
span)
(for-each
(lambda (f)
(if (null? (ly:spanner-bound f RIGHT))
(ly:spanner-set-bound! f RIGHT
(ly:context-property context 'currentMusicalColumn))))
finished)
(set! finished '()))
((finalize trans)
;; If spanner ends on spacer at end of context?
(for-each
(lambda (f)
(if (null? (ly:spanner-bound f RIGHT))
(ly:spanner-set-bound! f RIGHT
(ly:context-property context 'currentMusicalColumn))))
finished)
(set! finished '())
;; User didn't end spanner.
(for-each
(lambda (sp)
(ly:warning "incomplete spanner removed!")
(ly:grob-suicide! sp))
span)
(set! span '())))))
startTextSpanOne =
#(make-music 'TextSpanEvent 'span-direction START 'spanner-id "1")
stopTextSpanOne =
#(make-music 'TextSpanEvent 'span-direction STOP 'spanner-id "1")
startTextSpanTwo =
#(make-music 'TextSpanEvent 'span-direction START 'spanner-id "2")
stopTextSpanTwo =
#(make-music 'TextSpanEvent 'span-direction STOP 'spanner-id "2")
startTextSpanThree =
#(make-music 'TextSpanEvent 'span-direction START 'spanner-id "3")
stopTextSpanThree =
#(make-music 'TextSpanEvent 'span-direction STOP 'spanner-id "3")
%%%%%%%%%%%%%%%%%%%%%%%%%%%%% EXAMPLE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\layout {
\context {
\Voice
\remove #"Text_spanner_engraver"
\consists \schemeTextSpannerEngraver
}
}
\relative c' {
%\override TextSpanner.outside-staff-priority = ##f
%% This line alone will produce correct order!!
%% 0.46 is the value of default_outside_staff_padding_, set in
%% cc/axis-group-interface,cc for objects that don't have a
%% setting for this property. TextSpanner doesn't. By
%% setting 'padding slightly higher, we signal a collision
%% which (perhaps) forces a rearrangement in
%% Axis_group_interface::avoid_outside_staff_collisions.
\override TextSpanner.padding = 0.460000000000001
a4
-\tweak style ##f
-\tweak color #red
-\tweak thickness 10
\startTextSpan
-\tweak style ##f
-\tweak color #green
-\tweak thickness 10
\startTextSpanOne
b
c
-\tweak style ##f
-\tweak thickness 10
\startTextSpanThree
d %1
-\tweak style ##f
-\tweak color #blue
-\tweak thickness 10
\startTextSpanTwo
a4 b c d %2
a4 b c d %3
\break
a4 b c d %4
a4 b c d %5
a4 b c d
\stopTextSpan\stopTextSpanOne\stopTextSpanTwo\stopTextSpanThree %6
}
_______________________________________________
lilypond-devel mailing list
[email protected]
https://lists.gnu.org/mailman/listinfo/lilypond-devel
