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
<<attachment: test.png>>
_______________________________________________ lilypond-user mailing list lilypond-user@gnu.org http://lists.gnu.org/mailman/listinfo/lilypond-user
