Re: Better slashed graces

[David Nalesnik]

Hi Gilberto,

On Mon, Dec 19, 2016 at 6:43 AM, Gilberto Agostinho
<address@hidden> wrote:
> Hi all,
>
> I just discovered a bug with my function above. It turns out the function
> works well when there are two of more notes inside the \slashedGrace{}, but
> when a single note is there the file does not compile. I believe I need a
> conditional somewhere to take care of this but I don't really know how to
> implement it, would anyone be able to give me a hand? Example of a
> problematic case:  slash-bug.ly
> <http://lilypond.1069038.n5.nabble.com/file/n198182/slash-bug.ly>

The problem is that there is no Beam grob, so an error is raised when
you query its properties.

Following is a simple way to use substitute values when there is no Beam object.

Notice that there is an additional complication.  The grob extent for
the stem in the absence of a beam is (+inf.0 . -inf.0).  I don't know
why.  I hacked a simple fix for this: use the stencil's extent when
grob-extent returns something unusable.  (I didn't give it much
thought -- there's certainly a prettier way.)

Anyway, hope this helps.

David

P. S.  You need { } around your music expression.

%%%%%

slash =
#(define-music-function (parser location ang stem-fraction protrusion)
   (number? number? number?)
   (remove-grace-property 'Voice 'Stem 'direction)
   #{
     \once \override Stem #'stencil =
     #(lambda (grob)
        (let* ((x-parent (ly:grob-parent grob X))
               (is-rest? (ly:grob? (ly:grob-object x-parent 'rest))))
          (if is-rest?
              empty-stencil
              (let* ((refp (ly:grob-system grob))
                     (stil (ly:stem::print grob))
                     (stem-y-ext (ly:grob-extent grob grob Y))
                     (stem-y-ext (if (interval-sane? stem-y-ext)
                                     stem-y-ext
                                     (ly:stencil-extent stil Y)))
                     (stem-length (- (cdr stem-y-ext) (car stem-y-ext)))
                     (beam (ly:grob-object grob 'beam))
                     (beam? (ly:grob? beam))
                     (beam-X-pos (if beam?
                                     (ly:grob-property beam 'X-positions)
                                     #f))
                     (beam-Y-pos (if beam?
                                     (ly:grob-property beam 'positions)
                                     #f))
                     (beam-slope (if beam?
                                     (/ (- (cdr beam-Y-pos) (car beam-Y-pos))
                                       (- (cdr beam-X-pos) (car beam-X-pos)))
                                     0.0))
                     (beam-angle (atan beam-slope))
                     (dir (ly:grob-property grob 'direction))
                     (line-dy (* stem-length stem-fraction))
                     (line-dy-with-protrusions (if (= dir 1)
                                                   (+ (* 4 protrusion)
beam-angle)
                                                   (- (* 4 protrusion)
beam-angle)))
                     (ang (if (> beam-slope 0)
                              (if (= dir 1)
                                  (+ (degrees->radians ang) (* beam-angle 0.7))
                                  (degrees->radians ang))
                              (if (= dir 1)
                                  (degrees->radians ang)
                                  (- (degrees->radians ang) (*
beam-angle 0.7)))))
                     (line-dx (/ line-dy-with-protrusions (tan ang)))
                     (protrusion-dx (/ protrusion (tan ang)))
                     (corr (if (= dir 1) (car stem-y-ext) (cdr stem-y-ext)))
                     (stil (ly:stem::print grob)))

                (ly:stencil-add
                 stil
                 (grob-interpret-markup grob
                   (markup
                    ;#:with-color red
                    #:translate
                    (cons (- protrusion-dx)
                      (+ corr
                        (* dir
                          (- stem-length (+ stem-fraction protrusion)))))
                    #:draw-line
                    (cons line-dx
                      (* dir line-dy-with-protrusions)))))))))
   #})