Re: Colorer l'armure

[address@hidden]

On Nov 5, 2011, at 5:23 AM, Schermann Colette wrote:

Bonjour Mike, bonjour à tous!

J'ai profité des vacances de la Toussaint pour me plonger dans scheme et apprendre à faire quelques fonctions de bases.

(j'ai trouvé un cours assez abordable et bien fait là: http://ehess.modelisationsavoirs.fr/marc/ens/deug/cours.html avec des exercices d'application intéressants et amusants)

Puis j'ai essayé de comprendre la fonction que tu m'as écrites et qui marche pour 1 ou 2 altération à la clef, mais pas pour les autres armures. Je n'ai pas tout compris, notamment je ne sais pas ce que " assoc-get " fait? Mais j'ai réussi à la faire marcher en inversant la liste des altérations avec une petite fonction inverse (peut-être que cette fonction existe déjà prédéfinie?) et en gravant les altérations vers la droite plutôt que vers la gauche. Du coup, on peut même entrer les couleurs dans l'ordre d'apparition lors de l'appel de la fonction.

Cordialement, 

Colette

#(define (colorator clist)

  (lambda (grob)

    (define (helper stencil colors alts cpos is-cancel padding-pairs gna fm inter padding lastpos lgname)

      (if (null? alts)

          stencil

          (let* ((pos (key-signature-interface::alteration-position (caar alts) (cdar alts) cpos))

                 (gname (assoc-get (if is-cancel 0 (cdar alts)) gna))

                 (handle (assoc-get (cons gname lgname) padding-pairs #f)))

            (helper (ly:stencil-combine-at-edge

                      stencil

                      X

                      RIGHT

                      (stencil-with-color

                        (ly:stencil-translate-axis (ly:font-get-glyph fm gname) (* inter pos) Y)

                        (car colors))

                      (cond

                        (handle

                          (cdr handle))

                        ((and (equal? gname "accidentals.natural") (< lastpos (+ pos 2)) (> lastpos (- pos 6)))

                          (+ padding 0.3))

                        (else padding)))

                 (cdr colors) (cdr alts) cpos is-cancel padding-pairs gna fm inter padding pos gname))))

    (let* ((cpos (ly:grob-property grob 'c0-position))

           (is-cancel (grob::has-interface grob 'key-cancellation-interface))

           (padding-pairs (ly:grob-property grob 'padding-pairs))

           (gna (ly:grob-property grob 'glyph-name-alist))

           (alts (inverse (ly:grob-property grob 'alteration-alist)))

           (fm (ly:grob-default-font grob))

           (inter (* 0.5 (ly:staff-symbol-staff-space grob)))

           (padding (ly:grob-property grob 'padding 0)))

      (helper empty-stencil clist alts cpos is-cancel padding-pairs gna fm inter padding -1000 ""))))

      

#(define (inverse l)

  (define (g l k)

    (cond ((null? l) k)

          (else (g (cdr l) (cons (car l) k)))

          )

    )

  (g l '())

  )

\relative c' {

  \once \override Staff . KeySignature #'stencil = #(colorator (list 

  (x11-color 'MediumTurquoise) red darkgreen (x11-color 'DarkOrchid) (x11-color 'gold) blue (x11-color 'coral)))

  \key cis \major dis1

}

\relative c' {

\key g \major g'1

  \override Staff . KeySignature #'stencil = #(colorator (list 

  (x11-color 'MediumTurquoise) red darkgreen (x11-color 'DarkOrchid) (x11-color 'gold) blue (x11-color 'coral)))

  \key cis \major dis'1 \break

  \key a \major a

}

\relative c' {

  \override Staff . KeySignature #'stencil = #(colorator (list 

  (x11-color 'MediumTurquoise) red darkgreen (x11-color 'DarkOrchid) (x11-color 'gold) blue (x11-color 'coral)))

   \key ces \major des1 \break

   \key ges \major f

}

Bonjour Colette,

Félicitations d'avoir appris Scheme !  C'est pas du tout évident...

assoc-get est propre à LilyPond et du coup tu ne le trouveras pas dans la doc Scheme.  On fait (assoc-get key alist default), où `default' est optionnel.

(define foo '((a . 1) (b . 2)))

(assoc-get 'b foo)

te donnerait la valeur `2'.

Quant aux problèmes avec la fonction, il faudrait que je la repense pour la rendre plus fiable.  Je n'aurai pas de temps avant la mi-décembre, mais j'essayerai de travailler là-dessus dès que je peux !

Cordialement,

~Mike