[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
- Cluster fill-style, Simon Bailey, 2022/05/27
- Re: Cluster fill-style, Jean Abou Samra, 2022/05/27
- Re: Cluster fill-style, Simon Bailey, 2022/05/27
- Re: Cluster fill-style,
Jean Abou Samra <=
- Re: Cluster fill-style, Simon Bailey, 2022/05/27
- Re: Cluster fill-style, Simon Bailey, 2022/05/27
- Re: Cluster fill-style, Jean Abou Samra, 2022/05/27
- Re: Cluster fill-style, Simon Bailey, 2022/05/27
- Re: Cluster fill-style, Jean Abou Samra, 2022/05/27
- Re: Cluster fill-style, Simon Bailey, 2022/05/28