The whole approach blows up as soon as someone rewrites
ly:key-signature-interface::print in lily/key-signature-interface.cc
(which of course might not happen for quite some time). But if Carren
confirms that the snippet works in a production score, I agree that I
should turn this into a snippet. But I definitely should address the
TODO in the source first: Having to write
#(define (cadaddr lst) (car (cdaddr lst)))
#(define (cdadaddr lst) (cdr (cadaddr lst)))
definitely won't get me a prize for great Scheme conding style ...
... turns out I forgot that I didn't use them anymore in the end.
But anyway, here is a more concise version using match and match-let*:
\version "2.25.23"
keysig-colors =
#(list
(cons #{ as #} blue)
(cons #{ es #} green)
(cons #{ ges #} red)
)
%{
keysig stencils have the form:
(translate-stencil (horizontal...)
(combine-stencil
[all the individual accidentals]
))
the individual accidentals have the form
(translate-stencil [...]
(translate-stencil [...]
(...)
where the innermost translation (it's two layers or one layer) is the Y
translation
responsible for the pitch.
%}
#(define (translation? stencil-expr)
(and (pair? stencil-expr)
(eq? (car stencil-expr) 'translate-stencil)))
#(define (innermost-translation stencil-expr)
(match stencil-expr
(('translate-stencil coord inner-stencil-expr)
(if (translation? inner-stencil-expr)
(innermost-translation inner-stencil-expr)
coord))))
colouredKeySignature =
#(define-music-function (pitch-color-alist) (alist?)
#{
\override Staff.KeySignature.stencil =
#(grob-transformer
'stencil
(lambda (grob keysig)
(define notename-color-alist
(map (lambda (pitch-color-pair)
(cons (ly:pitch-notename (car pitch-color-pair))
(cdr pitch-color-pair)))
pitch-color-alist))
(define (colourise-single-accidental stencil-expr Y-position)
(let*
((c0-position
(ly:grob-property grob 'c0-position))
(Y-notename
(modulo (inexact->exact (- (* Y-position 2)
c0-position))
7))
(color
(assq-ref notename-color-alist Y-notename)))
(if (color? color)
`(color ,(normalize-color color) ,stencil-expr)
stencil-expr)))
(match-let*
((keysig-xext
(ly:stencil-extent keysig X))
(keysig-yext
(ly:stencil-extent keysig Y))
(('translate-stencil translation ('combine-stencil .
accidentals))
(ly:stencil-expr keysig))
(accidental-translations
(map innermost-translation accidentals))
(accidentals-Y
(map cdr accidental-translations))
(coloured-accidentals
(map colourise-single-accidental
accidentals
accidentals-Y)))
(ly:make-stencil
(list 'translate-stencil
translation
(cons 'combine-stencil coloured-accidentals))
keysig-xext
keysig-yext))))
#})
{
\colouredKeySignature \keysig-colors
\key des \major
c'1
\clef bass \break
c1
}
Lukas
