[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: shorten a broken hairpin at a linebreak?

From: David Nalesnik
Subject: Re: shorten a broken hairpin at a linebreak?
Date: Thu, 1 Sep 2011 14:22:00 -0500

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)
       (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))))))
     ;(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
       \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!


reply via email to

[Prev in Thread] Current Thread [Next in Thread]