Re: ligaturebracket avec flèches

[Jean Abou Samra]

Le 25/10/2021 à 10:34, joel.gauvrit@free.fr a écrit :
> Bonjour à tous,
>
> Sauriez-vous paramétrer les crochets de ligature pour :
>
> - qu'ils tombent centrés sur la tête des notes de départ et d'arrivée
> - que les lignes verticales se terminent par une flèche 
> (arrowheads.open.1M1 me convient).
>
>
> Merci pour votre aide !
> Cordialement
> Joël


Bonjour,

Ce n'est pas tout aussi facile que je l'aurais
espéré, mais faisable. Voici une proposition :

\version "2.22.1"

#(use-modules (srfi srfi-11))

#(define ((comparator-from-key key cmp) a b)
  (cmp (key a)
       (key b)))

#(define (stem::note-in-main-column grob)
   (let ((note-heads (ly:grob-object grob 'note-heads)))
     (if (null? note-heads)
         '()
         (let ((refp (ly:grob-common-refpoint-of-array grob note-heads X)))
           (find
            (lambda (head)
              (zero? (ly:grob-relative-coordinate head refp X)))
            (ly:grob-array->list note-heads))))))

#(define add-arrows
   (lambda (grob)
     (let* ((left (ly:spanner-bound grob LEFT))
            (left-broken (eq? #t (ly:grob-property left 'non-musical)))
            (right (ly:spanner-bound grob RIGHT))
            (right-broken (eq? #t (ly:grob-property right 'non-musical)))
            (refp (ly:grob-common-refpoint left right X))
            (coord (ly:grob-relative-coordinate grob refp X))
            (direction (ly:grob-property grob 'direction)))
       (define (relevant-position bound broken d)
         (if broken
             (let ((extent (ly:grob-extent bound refp X)))
               (interval-index extent d))
             (let* ((stem (ly:grob-object bound 'stem))
                    (note-head (stem::note-in-main-column stem))
                    (extent (ly:grob-extent (if (null? note-head)
                                                (ly:grob-object 
(ly:grob-parent stem X)
'rest)
                                                note-head)
                                            refp X)))
               (interval-center extent))))
       (let* ((X-left (- (relevant-position left left-broken LEFT)
                         coord))
              (X-right (- (relevant-position right right-broken RIGHT)
                          coord)))
         (let*-values
           (((flare-left flare-right)
             (car+cdr (ly:grob-property grob 'bracket-flare)))
            ((left-height right-height)
             (car+cdr (ly:grob-property grob 'edge-height '(1.0 . 1.0)))))
           (let* ((left-flare-off (cons X-left
                                        (* -1 direction left-height)))
                  (right-flare-off (cons X-right
                                         (* -1 direction right-height)))
                  (left-straight-off (cons (+ X-left flare-left)
                                           0))
                  (right-straight-off (cons (- X-right flare-right)
                                            0))
                  (left-dz (offset-add left-flare-off (offset-scale 
left-straight-off -1)))
                  (right-dz (offset-add right-flare-off (offset-scale 
right-straight-off -1)))
                  (left-angle (+ 90 (ly:angle left-dz)))
                  (right-angle (+ 90 (ly:angle right-dz)))
                  (font (ly:grob-default-font grob))
                  (glyph (ly:font-get-glyph font "arrowheads.open.1M1"))
                  (left-glyph (ly:stencil-rotate glyph left-angle 0 -0.8))
                  (right-glyph (ly:stencil-rotate glyph right-angle 0 
-0.8)))
             (let-values (((lxs lys)
                           (car+cdr left-straight-off))
                          ((lxe lye)
                           (car+cdr left-flare-off))
                          ((rxs rys)
                           (car+cdr right-straight-off))
                          ((rxe rye)
                           (car+cdr right-flare-off)))
               (ly:stencil-add
                (ly:line-interface::line grob lxs lys rxs rys)
                 (if left-broken
                     empty-stencil
                     (ly:stencil-add
                       (ly:line-interface::line grob lxs lys lxe lye)
                       (ly:stencil-translate left-glyph left-flare-off)))
                 (if right-broken
                     empty-stencil
                     (ly:stencil-add
                       (ly:line-interface::line grob rxs rys rxe rye)
                       (ly:stencil-translate right-glyph 
right-flare-off)))))))))))


\new Voice \with {
  \consists Horizontal_bracket_engraver
  \override HorizontalBracket.stencil = #add-arrows
  \override HorizontalBracket.outside-staff-priority = 500
  \override HorizontalBracket.font-size = -6
}
{
  c'2~\startGroup 8 d'8 e' g'\stopGroup
  <g' c'' d''>1\startGroup \break r\stopGroup
}


Cordialement,
Jean