Re: Cluster fill-style

On Fri, 27 May 2022 at 22:01, Jean Abou Samra <jean@abou-samra.fr> wrote:

Le 27/05/2022 à 22:20, Simon Bailey a écrit :
> Hi Jean,
>
> actually, there seems to be a bit of a problem:
>
> \new Voice {
> R1*3 | r2 r4.
> \makeClusters { <d f>8 | q1 | q8 <d d'> <d' f>2. | q1 | q1 | q2 r2 }
> \barNumberCheck #10
> \makeClusters {
> <d, f>1 | q4. <d d'>8 <d' f>2 | q1 | q2 <d, f>2 |
> \barNumberCheck #14 %1
> q2 <d d'>2 | q2 <d a'> | <d a' d>2 q8. <f d'>8. <d d'>8 | q1 | q1
> | q2. <d f>4 |
> }
> R1*47
> \makeClusters { <c g>1 | q1 | <d e>1 | <d d'>1 | <d' e>1 | q1 | q1 |
> q1 | }
> R1*11
> \barNumberCheck #86
> }
>
> gives the error message:
>
> Starting lilypond.exe 2.23.9 [Untitled]...
> Processing
> `C:/Users/sia/AppData/Local/Temp/frescobaldi-kad5rc1x/tmpi_go0x11/document.ly
> <http://document.ly>'
> Parsing...
> Interpreting music...[8][16][24][32][40][48][56][64][72][80]
> Preprocessing graphical objects...
> Finding the ideal number of pages...
> Fitting music on 1 page...
> Drawing systems...ice-9/eval.scm:155:9: In procedure car: Wrong type
> argument in position 1 (expecting pair): ()
> Exited with return code 1.
>
> If i comment out the 3rd \makeClusters, it works though.
>
> Any ideas?

Without my code, the same example outputs a programming error,
so it's an existing bug. I've just filed an issue in the bug
tracker:

https://gitlab.com/lilypond/lilypond/-/issues/6354

Meanwhile, here is some code that works around the bug:

\version "2.23.10"

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

#(define (cluster::dashed-fill grob)
    (let* ((columns (ly:grob-object grob 'columns))
           (column-list (ly:grob-array->list columns)))
      (if (not (pair? column-list)) ;; see issue #3654
          #f
          (let* ((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 coords (if neighbor
                                  (let* ((neighbor-cols (ly:grob-object
neighbor 'columns))
                                         (neighbor-col-list
(ly:grob-array->list neighbor-cols)))
                                    (if (not (null? neighbor-col-list))
;; issue #3654 as well
                                        (let* ((first-neighbor-col (car
neighbor-col-list))
                                               (neighbor-refp
(ly:grob-common-refpoint-of-array
                                                 neighbor
                                                 neighbor-cols
                                                 Y))
                                               (bound (ly:spanner-bound
grob RIGHT)))
                                          (values
                                           (append my-exts
                                                   (list (ly:grob-extent
first-neighbor-col neighbor-refp Y)))
                                           (append my-coords
                                                   (list
(ly:grob-relative-coordinate bound x-refp X)))))
                                        (values my-exts my-coords)))
                                  (values my-exts 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
}

\new Voice {
   R1*3 | r2 r4.
   \makeClusters { <d f>8 | q1 | q8 <d d'> <d' f>2. | q1 | q1 | q2 r2 }
   \barNumberCheck #10
   \makeClusters {
     <d, f>1 | q4. <d d'>8 <d' f>2 | q1 | q2 <d, f>2 |
     \barNumberCheck #14 %1
     q2 <d d'>2 | q2 <d a'> | <d a' d>2 q8. <f d'>8. <d d'>8 | q1 | q1 |
q2. <d f>4 |
   }
   R1*47
   \makeClusters { <c g>1 | q1 | <d e>1 | <d d'>1 | <d' e>1 | q1 | q1 |
q1 | }
   R1*11
   \barNumberCheck #86
}

Regards,
Jean

From:	Simon Bailey
Subject:	Re: Cluster fill-style
Date:	Fri, 27 May 2022 22:45:42 +0100