Thanks again Harm. This is very useful function. Hopefully I'm not the only one
who appreciates it.
>
> Hi Karol,
>
> below the revised function.
> 'moreWhiteout' takes one optional and two normal arguments:
> Specifying whether the stencil should be boxed (boolean), which grob
> (string) and the values to extent the stencil. These values can be
> given as simple pair, affecting only X-axis-extension or as list of
> pairs, affecting X- and Y-axis-extent.
> The boolean may be of some use for debugging, though it will affect
> spacing! Perhaps I should delete it ...
>
> Otherwise I did some clean up and made the function more robust.
> Please test.
>
> \version "2.19.3"
>
> moreWhiteout =
> #(define-music-function (parser location better-viewing? grob-name adds)
> ((boolean? #f) string? pair?)
>
> (define (interval-add iv-1 iv-2)
> (cons (+ (car iv-1)(car iv-2))
> (+ (cdr iv-1)(cdr iv-2))))
>
> (define more-stencil-whiteout
> (lambda (grob)
> (let* ((function (assoc-get 'stencil
> (reverse (ly:grob-basic-properties grob))))
> (stil ;; Ugh, is there no better way to test that a grob has no
> ;; 'stencil and that no other previous procedure assigned
> ;; a stencil-value to said grob?
> (if (and (procedure? function)
> (not (eq? (procedure-name function)
> 'more-stencil-whiteout)))
> (function grob)
> (begin
> (ly:warning "~a has no stencil. Ignoring" grob)
> #f))))
> (if stil
> (let*((x-ext (ly:stencil-extent stil X))
> (y-ext (ly:stencil-extent stil Y))
> (add-to-x-ext (if (pair? (car adds)) (car adds) adds))
> (add-to-y-ext (if (pair? (cdr adds)) (cadr adds) '(0 . 0)))
> (new-stil (ly:make-stencil
> (ly:stencil-expr stil)
> (interval-add x-ext add-to-x-ext)
> (interval-add y-ext add-to-y-ext))))
>
>
> ;; please note: setting better-viewing #t, will add a little
> ;; padding around the new stil and it will affect spacing in
> most
> ;; other cases, too.
> ;; We let it in, perhaps it may be of some help in certain
> cases.
> (if better-viewing?
> (box-stencil new-stil 0.1 0.01)
> new-stil))
> #f))))
>
> #{
> %% Seems no longer needed:
> %\once \override $grob-name . vertical-skylines = #'()
> %% Better to add next two lines:
> \once \override $grob-name . layer = #10
> \once \override $grob-name . whiteout = ##t
> \once \override $grob-name . stencil = #more-stencil-whiteout
> #})
>
> %%%%%%%%%%%%%%%%%%%%%%%
> %% EXAMPLE
> %%%%%%%%%%%%%%%%%%%%%%%
>
> musicI = { \time 2/4 \repeat unfold 16 b8 }
>
> musicII = {
> r2
> %% apply to X- and Y-axis
> \moreWhiteout TextScript #'((-2 . 0.5)(0 . 2))
> b4^"XXXXXX" b
> r2
> %% apply to X-axis only
> \moreWhiteout ##t TextScript #'(-2 . 0.5)
> b4^"XXXXXX" b
> }
>
>
> \new StaffGroup <<
> \new Staff \relative c'' \musicI
> \new Staff \relative c'' \musicII
> >>
>
> Ofcourse the extension happens as a rectangle.
> No idea to do it different.
>
> > BTW, In documentation for 2.19 it's written that default value for
> DynamicText.extra-spacing-width is '(+inf.0 . -inf.0), which is not true
> anymore.
>
> I think you're wrong.
> The following returns '(+inf.0 . -inf.0) !
>
> {
> \override DynamicText.after-line-breaking =
> #(lambda (grob) (write (ly:grob-property grob 'extra-spacing-width)))
> c1\f
> }
>
> HTH,
> Harm
_______________________________________________
lilypond-user mailing list
lilypond-user@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-user
