Re: Again : notes for toms and floortoms

[tao_lilyponduser]

It's been some time but now I finally managed to make a working function.
The suggestion from Kieren was a good starting point but had to be modified 
much more than I had expected at first.

Well, here is a short example. I haven't done much testing yet so if something 
doesn't work as it should, just tell me and I'll see what I can do.
The interesting part begins with #(define stencil-mapping
before are just a few custom notehead stencils used as a an example.

Regards,

Tao


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define (circSlash grob)
  (let* ((line-thickness (ly:staff-symbol-line-thickness grob))
         (width (+ line-thickness 1))
         (stem-thickness (* line-thickness 1.3))
         (radius (/ (- width stem-thickness) 2)))
      (ly:make-stencil (list 'embedded-ps
        (string-append "
          /line-thickness " (number->string line-thickness) " def
          /stem-thickness " (number->string stem-thickness) " def
          /radius " (number->string radius) " def
          /width " (number->string width) " def
          /half-width width 2 div def
          /x0 half-width def
          /y0 0 def
          /x1 width stem-thickness 2 div sub def
          /y1 half-width stem-thickness 2 div sub def
          /x2 stem-thickness 2 div def
          /y2 half-width neg stem-thickness 2 div add def

          gsave
          currentpoint translate
          stem-thickness setlinewidth
          newpath
          x0 y0 radius 0 360 arc
          stroke

          newpath
          1 setlinecap
          x1 y1 moveto
          x2 y2 lineto
          stroke
          grestore"))
    (cons 0 width)
    (cons 0 0))))
    
#(define heel
   (ly:make-stencil (list 'embedded-ps
      "gsave
       currentpoint translate
       newpath
       0 -0.375 moveto
       0.25 0.375 lineto
       1 0.375 lineto
       0.75 -0.375 lineto
       closepath
       0.15 setlinewidth
       stroke
       newpath
       0 -0.375 moveto
       0.25 0.375 lineto
       1 0.375 lineto
       0.75 -0.375 lineto
       closepath
       fill
       grestore" )
      (cons -0.075 1.075)
      (cons 0 0.5)))
      
#(define tip
   (ly:make-stencil (list 'embedded-ps
      "gsave
       currentpoint translate
       newpath
       0.25 -0.375 moveto
       0 0.375 lineto
       0.75 0.375 lineto
       1 -0.375 lineto
       closepath
       0.15 setlinewidth
       stroke
       newpath
       0.25 -0.375 moveto
       0 0.375 lineto
       0.75 0.375 lineto
       1 -0.375 lineto
       closepath
       fill
       grestore" )
      (cons 0.175 0.825)
      (cons 0 0.5)))
     
#(define stencil-mapping
  (list
    (cons 'bassdrum heel)
    (cons 'hightom tip)
    (cons 'snare circSlash)
    ))

#(define (mod-notehead music)
   (if (eq? (ly:music-property music 'name) 'EventChord)
     (let ((n (length (ly:music-property music 'elements))))
       (do ((i 0 (1+ i))) ((= i n))
         (let* ((ne (list-ref (ly:music-property music 'elements) i))
                (dt (ly:music-property ne 'drum-type))
                (st (assoc dt stencil-mapping)))
           (if st
             (ly:music-set-property! ne 'tweaks (list (cons 'stencil (cdr 
st)))))))))
    music)

customHeads =
#(define-music-function (parser location music) (ly:music?)
   (music-map (lambda (x) (mod-notehead x)) music))
     
\new DrumStaff \new DrumVoice \drummode
{
        \customHeads { <sn hh bd>4 tomh toml <toml sn> }
}
-- 
GRATIS für alle GMX-Mitglieder: Die maxdome Movie-FLAT!
Jetzt freischalten unter http://portal.gmx.net/de/go/maxdome01

test.png
Description: PNG image