David Nalesnik-2 wrote:
>
> You're very welcome!
>
>
Hi,
tweaking the decrescendi like the diminuendi and doing some minor changes, I
come up with:
\version "2.14.2"
\pointAndClickOff
\paper {
ragged-right = ##f
%right-margin = 30
%indent = 0
}
% Thanks to Mike Solomon and David Nalesnik
%
http://old.nabble.com/shorten-a-broken-hairpin-at-a-linebreak--td32343028.html
#(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 (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)))
#(define (change-broken-hairpins grob)
(let* ((st (ly:hairpin::print grob))
(orig (ly:grob-original grob))
(siblings (if (ly:grob? orig)
(ly:spanner-broken-into orig)
'()))
(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)) 1.5))
(xr (- (+ add (cdr w)) hairpin-origin))
(ylu (if (eqv? gd LEFT)
(cdr h)
(if (and (equal? gd RIGHT)(>= (length siblings) 2) (eq? (car
siblings) grob))
(interval-center h)
(interval-center (cons (interval-center h)(cdr h)))
)))
(yru (if (eqv? gd RIGHT)
(cdr h)
(interval-center (cons (interval-center h) (cdr h)))
))
(yld (if (eqv? gd LEFT)
(car h)
(if (and (equal? gd RIGHT)(>= (length siblings) 2) (eq? (car
siblings) grob))
(interval-center h)
(interval-center (cons (car h)(interval-center h)))
)))
(yrd (if (eqv? gd RIGHT)
(car h)
(interval-center (cons (car h)(interval-center h)))
))
(new-stencil (ly:stencil-add
(make-line-stencil thick (car w) ylu xr yru)
(make-line-stencil thick (car w) yld xr yrd)))
)
new-stencil
))
#(define (internal-my-callback grob fn1 fn2)
(let* ((orig (ly:grob-original grob))
(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 (my-broken-hairpin-callback grob)
(internal-my-callback grob change-bound values)
(internal-my-callback grob change-broken-hairpins ly:hairpin::print))
% ------------------------------- Test
-----------------------------------------
one = {
% 1
a1\break
\override Hairpin #'stencil = #my-broken-hairpin-callback
\override Hairpin #'color = #red
% 2
a\> \repeat unfold 2 { a } \break \key des \major \bar ":|:"
% 5
\repeat unfold 8 { a } \break \key fis \major \bar ":|:"
% 13
\repeat unfold 2 { a } \break \key ees \major \bar ":|:"
% 15
\repeat unfold 17 { a } a\p \break \key ces\major \bar ":|:"
% 33 with new hairpin
a1\> a1 \break \key cis\major \bar ":|:"
% 35
a a2. a4\p
}
two = {
\override Hairpin #'stencil = #my-broken-hairpin-callback
\override Hairpin #'color = #blue
c'1\< \repeat unfold 34 { c'1 } c'2. c'4\f
}
\score {
\new StaffGroup <<
\new Staff \one
\new Staff \two
>>
}
Seems to work.
Cheers,
Harm
--
View this message in context:
http://old.nabble.com/shorten-a-broken-hairpin-at-a-linebreak--tp32343028p32419640.html
Sent from the Gnu - Lilypond - User mailing list archive at Nabble.com.
_______________________________________________
lilypond-user mailing list
lilypond-user@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-user
