Hi again, Harm --
> One point left: I want each diminuendo of the broken siblings to be
> increased up to the barline.
>
Keep your fingers crossed, but I think I've located the problem...
You need to take into account the origin of the hairpin. So:
\version "2.14.2"
#(define (has-interface? grob interface)
(member interface
(assoc-get 'interfaces
(ly:grob-property grob 'meta))))
#(define (find-system grob)
(if (has-interface? grob 'system-interface)
grob
(find-system (ly:grob-parent grob X))))
#(define (first-musical-column grobl)
(if (not (eqv? #t (ly:grob-property (car grobl) 'non-musical)))
(car grobl)
(first-musical-column (cdr grobl))))
#(define (change-bound grob)
(let* ((system (find-system grob))
(cols (ly:grob-array->list (ly:grob-object system 'columns)))
(musical-column (first-musical-column (reverse cols))))
(ly:spanner-set-bound! grob RIGHT musical-column)))
%%%%% by David Nalesnik:
#(define (last-bar grob)
;; return the X-coordinate of the last barline on a line
(let* ((sys (ly:grob-system grob))
(array (ly:grob-object sys 'all-elements))
(grob-name (lambda (x) (assq-ref (ly:grob-property x 'meta)
'name)))
(lst (filter (lambda (x) (eq? 'BarLine (grob-name x)))
(ly:grob-array->list array)))
(bar-coords (sort (map (lambda (x) (ly:grob-relative-coordinate x
sys X)) lst) >)))
(car bar-coords)))
%%%%
#(define (internal-my-callback grob fn1 fn2)
(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)
'())))
(if (and (>= (length siblings) 2)
(not (eq? (car (reverse siblings)) grob)))
(fn1 grob)
(fn2 grob))))
#(define (change-ends grob)
(let* ((st (ly:hairpin::print grob))
(gd (ly:grob-property grob 'grow-direction))
(w (ly:stencil-extent st X))
(thick (* (ly:grob-property grob 'thickness)
(ly:staff-symbol-line-thickness grob)))
(h (ly:stencil-extent st Y))
(bar-pos (last-bar grob))
(hairpin-origin (ly:grob-relative-coordinate grob (ly:grob-system
grob) X))
(add (interval-length (cons (cdr w) bar-pos)))
(ylu (if (eqv? gd RIGHT)
(interval-center (cons (interval-center h)(cdr h)))
(cdr h)))
(yru (if (eqv? gd RIGHT)
(cdr h)
(interval-center (cons (interval-center h) (cdr h)))))
(yld (if (eqv? gd RIGHT)
(interval-center (cons (car h)(interval-center h)))
(car h)))
(yrd (if (eqv? gd RIGHT)
(car h)
(interval-center (cons (car h)(interval-center h))))))
(ly:stencil-add
;(make-line-stencil thick (car w) ylu (cdr w) yru)
;(make-line-stencil thick (car w) yld (cdr w) yrd)
(make-line-stencil thick (car w) ylu (- (+ add (cdr w)) hairpin-origin)
yru)
(make-line-stencil thick (car w) yld (- (+ add (cdr w)) hairpin-origin)
yrd)
)))
#(define (my-callback grob)
(internal-my-callback grob change-bound values)
(if (eqv? LEFT (ly:grob-property grob 'grow-direction))
(internal-my-callback grob change-ends ly:hairpin::print)
(ly:hairpin::print grob)))
{
% 1
a1\break
\override Hairpin #'stencil = #my-callback
\override Hairpin #'bound-padding = #my-callback
% 2
a\> \repeat unfold 2 { a } \break
% 5
\repeat unfold 8 { a } \break \key fis \major
% 13
\repeat unfold 2 { a } \break \key ees \major
% 15
\repeat unfold 17 {a} a\p \break \key ces\major
% 33 with new hairpin
a1\> a1 \break \key cis\major
% 35
a a2. a4\p
}
Hope this does the trick!
David
_______________________________________________
lilypond-user mailing list
lilypond-user@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-user
