lilypond-user
[Top][All Lists]
Advanced

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

Re: Cluster fill-style


From: Jean Abou Samra
Subject: Re: Cluster fill-style
Date: Fri, 27 May 2022 21:31:47 +0200
User-agent: Mozilla/5.0 (X11; Linux x86_64; rv:91.0) Gecko/20100101 Thunderbird/91.9.1

Le 27/05/2022 à 20:57, Simon Bailey a écrit :
Jean,

That's absolutely amazing, thanks so much!

However, unlike the "regular" clusters, it doesn't extend to the barlines, leaving some empty holes. See attached screenshots. (I'm running 2.23.9 on Windows).

I can provide a MWE of my score if you'd like.



Aye. I was lazy and thought you wouldn't need that :-)

Next try:


\version "2.23.9"

#(use-modules (ice-9 match))

#(define (cluster::dashed-fill grob)
   (let* ((columns (ly:grob-object grob 'columns))
          (column-list (ly:grob-array->list columns))
          (x-refp (ly:grob-common-refpoint-of-array grob columns X))
          (y-refp (ly:grob-common-refpoint-of-array grob columns Y))
          (my-exts (map (lambda (c)
                         (ly:grob-extent c y-refp Y))
                       column-list))
          (my-coords (map (lambda (c)
                           (ly:grob-relative-coordinate c x-refp X))
                         column-list))
          (after-me (find-tail (lambda (s)
                                 (eq? s grob))
                               (ly:spanner-broken-into (ly:grob-original grob))))
          (neighbor (and after-me
                         (pair? (cdr after-me))
                         (cadr after-me)))
          (exts (if neighbor
                    (append my-exts
                            (let* ((neighbor-cols (ly:grob-object neighbor 'columns))                                    (first-neighbor-col (car (ly:grob-array->list neighbor-cols)))                                    (neighbor-refp (ly:grob-common-refpoint-of-array neighbor neighbor-cols Y)))                               (list (ly:grob-extent first-neighbor-col neighbor-refp Y))))
                    my-exts))
          (coords (if neighbor
                      (append my-coords
                              (let ((bound (ly:spanner-bound grob RIGHT)))
                                (list (ly:grob-relative-coordinate bound x-refp X))))
                      my-coords))
          (details (ly:grob-property grob 'details))
          (increment (assq-ref details 'increment))
          (contour-thickness (assq-ref details 'contour-thickness))
          (polygon-points-1 (map cons coords (map car exts)))
          (polygon-points-2 (map cons coords (map cdr exts)))
          (polygon-stencil
           (ly:round-polygon (append-reverse polygon-points-1 polygon-points-2)
                             contour-thickness
                             1
                             #f)))
     (let loop ((exts exts)
                (coords coords)
                (current (car coords))
                (stil empty-stencil))
       (if (null? (cdr coords))
           (ly:stencil-translate
            (ly:stencil-add stil polygon-stencil)
            (cons (- (ly:grob-relative-coordinate grob x-refp X))
                  (- (ly:grob-relative-coordinate grob y-refp Y))))
           (let* ((t (/ (- current (car coords))
                        (- (cadr coords)
                           (car coords))))
                  (1-t (- 1 t))
                  (ext1 (car exts))
                  (ext2 (cadr exts))
                  (lo (+ (* 1-t (car ext1))
                         (* t (car ext2))))
                  (hi (+ (* 1-t (cdr ext1))
                         (* t (cdr ext2))))
                  (part (ly:line-interface::line grob current lo current hi))
                  (new-stil (ly:stencil-add stil part))
                  (next (+ current increment))
                  (stay (<= next (cadr coords))))
             (loop (if stay exts (cdr exts))
                   (if stay coords (cdr coords))
                   next
                   new-stil))))))

\layout {
  \context {
    \Voice
    \override ClusterSpanner.stencil = #cluster::dashed-fill
    \override ClusterSpanner.style = #'dashed-line
    \override ClusterSpanner.thickness = 1.5
    \override ClusterSpanner.dash-period = 0.6
    \override ClusterSpanner.details.increment = 0.45
    \override ClusterSpanner.details.contour-thickness = 0.2
  }
}

%%%

\paper {
  ragged-right = ##t
}

\makeClusters {
  <c' c''>2 <d' a'> <g' f'''> <f g''>
  <c' c''>2 <d' a'> \break <g' f'''> <f g''>
}



Best,
Jean




reply via email to

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