Hi Klaus.
On Mon, Apr 6, 2015 at 4:55 PM, Klaus Blum <[email protected]> wrote:
> Hi David,
>
> here's my first attempt to apply my drawing function to your project.
> Thanks
> again for sharing this really cool tool!
>
You're very welcome. What you've done with it is really impressive, and I
hope that one day this will be trouble-free!
>
> I've played around with some settings, and I also experimented with the
> messed up dynamics problem when taking the engravers out of the score
> context.
> It works if you set outside-staff-priority to a value high enough:
> \override MusicBoxer.outside-staff-priority = #10000
> \override Box.outside-staff-priority = #10000
> However, this leads to a warning:
> "Ein Objekt außerhalb der Notenzeile sollte eine Richtung haben, Vorgabe
> ist
> »nach oben«"
> (Following the lilypond translation, this is the original warning message:
> #: axis-group-interface.cc:786
> msgid "an outside-staff object should have a direction, defaulting to up")
>
> It seems that there is something taken into account for spacing
> calculations, but LilyPond doesn't know if this mysterious something is
> located above or below the score.
>
Well, the "mysterious somethings" are quite simply the boxes. When you set
outside-staff-priority, the object becomes an outside-staff object, and
thus needs a direction to know how it should be moved when arranging
outside-staff objects.
In the attached file, I put the relevant information into the grob
description. I lowered the outside-staff-priority from 10000 to 251 to
show that (here at least) it only has to be larger than the dynamic which
has a priority of 250. How did you arrive at 10000?
>
> By the way, if I put a box around an eighth note that is attached to a
> beam,
> the beam completely disappears. With MusicBoxer this is not the case.
>
The warning is the key -- well, a first clue:
programming error: minimise_least_squares (): Nothing to minimise
This means that vertical spacing is triggered
before line breaking
Something somewhere has calculated vertical spacing too early, and this
messes up the positioning of the Beam grob.
The problem is in the stencil callback for Box, which in your version is
set to the same function as MusicBoxer. When you request information about
Y-extent, the function ly:relative-group-extent triggers vertical spacing
routines before LilyPond is ready. She must determine line breaks before
the final stamp is put on the vertical aspect.
I believe what is needed is a "pure" callback for Y-extent, so that
LilyPond can make a safe estimate (i.e., without side effects) to use for
purposes of line-breaking. Unfortunately, I'm having no luck with this.
You can read about purity here:
http://lilypond.org/doc/v2.19/Documentation/contributor/understanding-pure-properties
In the attached, I duplicated most of the code of music-boxer-stencil for
box-stil with a small change. This is not a solution, just a demonstration
of what causes the programming error and the disappeared beam. Note that I
just hardcoded Y-extent so that no calculation happens -- obviously a
non-solution ...
Possibly you can continue to use the same stencil callback for both
objects. In any case I'm pretty sure you will have to move the
determination of height to a separate group of functions.
>
> Unfortunately I cannot be much of help for any explanation because the way
> LilyPond acts behind the scenes is still a mystery to me...
>
I'd like to be able to say that it all becomes clear at some point, but
alas...
Hope this helps somewhat!
David
\version "2.19.15"
\header {
tagline = ##f
}
#(define-event-class 'music-boxer-event 'span-event)
#(define-event-class 'box-event 'music-event)
#(define (add-grob-definition grob-name grob-entry)
(let* ((meta-entry (assoc-get 'meta grob-entry))
(class (assoc-get 'class meta-entry))
(ifaces-entry (assoc-get 'interfaces meta-entry)))
;; change ly:grob-properties? to list? to work from 2.19.12 back to at least 2.18.2
(set-object-property! grob-name 'translation-type? ly:grob-properties?)
(set-object-property! grob-name 'is-grob? #t)
(set! ifaces-entry (append (case class
((Item) '(item-interface))
((Spanner) '(spanner-interface))
((Paper_column) '((item-interface
paper-column-interface)))
((System) '((system-interface
spanner-interface)))
(else '(unknown-interface)))
ifaces-entry))
(set! ifaces-entry (uniq-list (sort ifaces-entry symbol<?)))
(set! ifaces-entry (cons 'grob-interface ifaces-entry))
(set! meta-entry (assoc-set! meta-entry 'name grob-name))
(set! meta-entry (assoc-set! meta-entry 'interfaces
ifaces-entry))
(set! grob-entry (assoc-set! grob-entry 'meta meta-entry))
(set! all-grob-descriptions
(cons (cons grob-name grob-entry)
all-grob-descriptions))))
#(define (define-grob-property symbol type? description)
(if (not (equal? (object-property symbol 'backend-doc) #f))
(ly:error (_ "symbol ~S redefined") symbol))
(set-object-property! symbol 'backend-type? type?)
(set-object-property! symbol 'backend-doc description)
symbol)
#(map
(lambda (x)
(apply define-grob-property x))
`(
(fill-color ,color? "Background color for filling the rectangle")
(acknowledge-finger-interface ,boolean? "Include fingerings in box?")
(acknowledge-script-interface ,boolean? "Include scripts in box?")
(zigzag-left ,number? "Zigzag size for left edge")
(zigzag-right ,number? "Zigzag size for right edge")
; add more properties here
))
#(define (makeDeltaSpan
y-l-lower y-l-upper ; number: Y-dimensions (left edge)
y-r-lower y-r-upper ; number: Y-dimensions (left edge)
frame-color fill-color ; (color of ##f): colors for outer and inner polygon (won't be drawn if set to ##f)
stepLeft stepRight ; number: size of zigzag elements for left and right edge (vertical edge / no zigzag if set to zero)
open-on-bottom open-on-top ; boolean: no visible frame on bottom/top edge (no distance between inner and outer polygon's edges)
thick ; number: frame thickness - distance between inner and outer polygon's edges
pad ; number: broken-bound-padding - amount to shorten spanners where separated by a line break
X-ext-param ; pair: the spanner's X-dimensions
open-on-left open-on-right ; boolean: no visible frame on left/right edge (no distance between inner and outer polygon's edges)
; We'll assume that this indicates a line break!
radius ; number: radius for "round-filled-polygon" procedure
)
(let* (
(h-thick (* thick (sqrt 2))) ; X-distance between left and right edges of inner and outer polygon. Must be "thick" * sqrt 2 (Pythagoras)
(l-width (* stepLeft 0.5)) ; X-distance of zigzag corners
(r-width (* stepRight 0.5))
(Y-ext (cons 0 0)) ; dummy, needed for ly:stencil-expr (is there a way without it?)
(X-ext (cons
(if (> stepLeft 0) ; left edge has zigzag shape
(- (+ (car X-ext-param) (/ l-width 2)) h-thick) ; Half of the zigzag space will be taken from inside, other half from the outside. Frame space taken from outside.
(if open-on-left (- (car X-ext-param) h-thick) (- (car X-ext-param) thick))
)
(if (> stepRight 0) ; right edge has zigzag shape
(+ (- (cdr X-ext-param) (/ r-width 2)) h-thick)
(if open-on-right (+ (cdr X-ext-param) h-thick) (+ (cdr X-ext-param) thick))
)))
(X-ext (cons
(if open-on-left (- (+ (car X-ext) pad) (/ l-width 2)) (car X-ext)) ; shorten/lengthen by broken-bound-padding if spanner is broken
(if open-on-right (+ (- (cdr X-ext) pad) (/ r-width 2)) (cdr X-ext))))
(points (list)) ; will contain coordinates for outer polygon
(points-i (list)) ; will contain coordinates for inner polygon
(slope-upper (/ (- y-r-upper y-l-upper) (- (cdr X-ext) (car X-ext)))) ; slope of the polygon's upper edge
(slope-lower (/ (- y-r-lower y-l-lower) (- (cdr X-ext) (car X-ext)))) ; slope of the polygon's lower edge
(d-upper (if open-on-top 0 (* thick (sqrt (+ (expt slope-upper 2) 1))))) ; (Pythagoras)
; Y-distance between upper edges of inner and outer polygon. Equal to "thick" if upper edge is horizontal.
; Increases as the upper edge's slope increases.
(d-lower (if open-on-bottom 0 (* thick (sqrt (+ (expt slope-lower 2) 1))))) ; same for lower edge
; stuff for later calculations:
(xtemp 0)
(yLowerLimit 0)
(yUpperLimit 0)
(xp 0)
(yp 0)
(jumps 0)
)
; calculate outer polygon's borders:
; lower-left corner:
(set! points (list (cons (car X-ext) y-l-lower)))
; calculate coordinates for left (outer) zigzag border:
(if (and (> stepLeft 0) (not open-on-left))
(let loop ((cnt y-l-lower))
(if (< cnt y-l-upper)
(begin
(if (and (< cnt y-l-upper) (> cnt y-l-lower)) ; only add to list if point is inside the given Y-range
(set! points (cons (cons (car X-ext) cnt ) points)))
(if (and (< (+ cnt (/ stepLeft 2)) y-l-upper) (> (+ cnt (/ stepLeft 2)) y-l-lower))
(set! points (cons (cons (- (car X-ext) l-width) (+ cnt (/ stepLeft 2)) ) points)))
(loop (+ cnt stepLeft))))))
; upper-left corner:
(set! points (cons
(cons (car X-ext) y-l-upper)
points ))
; upper-right corner:
(set! points (cons
(cons (cdr X-ext) y-r-upper)
points ))
; right outer zigzag border:
(if (and (> stepRight 0) (not open-on-right))
(let loop ((cnt y-r-upper))
(if (> cnt y-r-lower)
(begin
(if (and (< cnt y-r-upper) (> cnt y-r-lower))
(set! points (cons (cons (cdr X-ext) cnt ) points)))
(if (and (< (- cnt (/ stepRight 2)) y-r-upper) (> (- cnt (/ stepRight 2)) y-r-lower))
(set! points (cons (cons (+ (cdr X-ext) r-width) (- cnt (/ stepRight 2)) ) points)))
(loop (- cnt stepRight))))))
; lower-right corner:
(set! points (cons
(cons (cdr X-ext) y-r-lower)
points ))
; shrink X-ext for use with inner stuff:
(if (not open-on-left)
(if (> stepLeft 0)
(set! X-ext (cons (+ (car X-ext) h-thick) (cdr X-ext)))
(set! X-ext (cons (+ (car X-ext) thick) (cdr X-ext)))
)
)
(if (not open-on-right)
(if (> stepRight 0)
(set! X-ext (cons (car X-ext) (- (cdr X-ext) h-thick)))
(set! X-ext (cons (car X-ext) (- (cdr X-ext) thick)))
)
) ; Now X-ext represents INNER polygon's width WITHOUT the zigzag corners
; Now calculate inner borders:
; xp and yp will be the coordinates of the corner currently being calculated
; calculate lower-left corner:
(set! yLowerLimit y-l-lower)
(set! yUpperLimit y-l-upper)
(if open-on-left
(begin
(set! xp (car X-ext))
(set! yp (+ y-l-lower d-lower))
)
(if (> stepLeft 0)
(if (not (eq? slope-lower -1))
(begin
(set! jumps 0)
(while (> (- (+ (* slope-lower h-thick) d-lower) (* jumps stepLeft)) stepLeft)
(set! jumps (+ 1 jumps)))
(set! xtemp (/ (- (+ h-thick (* jumps stepLeft)) d-lower) (+ slope-lower 1)))
; results from the solution for a system of two equations. Forgive me, I'm a maths teacher :-)
(if (< xtemp (- h-thick (/ stepLeft 2)))
(if (= 1 slope-lower)
(set! xtemp h-thick)
(set! xtemp
(/ (+ (- d-lower (* stepLeft (+ 1 jumps))) h-thick) (- 1 slope-lower))))) ; another system of 2 equations...
(set! xp (+ (- (car X-ext) h-thick) xtemp))
(set! yp (+ (+ y-l-lower (* slope-lower xtemp)) d-lower))
)
)
(begin
(set! xp (car X-ext))
(set! yp (+ (+ y-l-lower (* thick slope-lower)) d-lower))
)
)
)
; insert lower-left corner's coordinates into list:
(if (not (and (and (not open-on-left) (> stepLeft 0)) (eq? slope-lower -1)))
(begin
(set! points-i (cons (cons xp yp) points-i))
(set! yLowerLimit yp)
)
)
; calculate upper-left corner:
(if open-on-left
(begin
(set! xp (car X-ext))
(set! yp (- y-l-upper d-upper))
)
(if (> stepLeft 0)
(if (not (eq? slope-upper 1))
(begin
(set! jumps 0)
(while (<
(+ (- (* slope-upper h-thick) d-upper) (* jumps stepLeft))
(- stepLeft))
(set! jumps (+ jumps 1)))
(set! xtemp (/ (- d-upper (+ h-thick (* jumps stepLeft))) (- slope-upper 1)))
(if (< xtemp (- h-thick (/ stepLeft 2)))
(if (= -1 slope-upper)
(set! xtemp h-thick)
(set! xtemp
(/ (- (- (* stepLeft (+ 1 jumps)) d-upper) h-thick) (- (- 1) slope-upper)))
)
)
(set! xp (+ (- (car X-ext) h-thick) xtemp))
(set! yp (- (+ y-l-upper (* slope-upper xtemp)) d-upper))
)
)
(begin
(set! xp (car X-ext))
(set! yp (- (+ y-l-upper (* thick slope-upper)) d-upper))
)
)
)
(if (not
(and (and (not open-on-left) (> stepLeft 0)) (eq? slope-upper 1))
)
(set! yUpperLimit yp))
; left (inner) zigzag:
(if (and (> stepLeft 0) (not open-on-left))
(begin
(let loop ((cnt y-l-lower))
(if (< cnt y-l-upper)
(begin
(if (and (> cnt yLowerLimit) (< cnt yUpperLimit))
(set! points-i (cons (cons (car X-ext) cnt ) points-i))
)
(if (and (> (+ cnt (/ stepLeft 2)) yLowerLimit) (< (+ cnt (/ stepLeft 2)) yUpperLimit))
(set! points-i (cons (cons (- (car X-ext) l-width) (+ cnt (/ stepLeft 2)) ) points-i))
)
(loop (+ cnt stepLeft))
)
)
)
)
)
; insert upper-left corner (yes, AFTER the zigzag points, so all the points will be given in clockwise order):
(if (not
(and (and (not open-on-left) (> stepLeft 0)) (eq? slope-upper 1))
)
(set! points-i (cons (cons xp yp) points-i)))
; calculate upper-right corner:
(set! yLowerLimit y-r-lower)
(set! yUpperLimit y-r-upper)
(if open-on-right
(begin
(set! xp (cdr X-ext))
(set! yp (- y-r-upper d-upper))
)
(if (> stepRight 0)
(if (not (eq? slope-upper -1))
(begin
(set! jumps 0)
(while (<
(+ (- (* slope-upper (- h-thick)) d-upper) (* jumps stepRight))
(- stepRight))
(set! jumps (+ jumps 1)))
(set! xtemp (/ (- d-upper (+ h-thick (* jumps stepRight))) (+ slope-upper 1)))
(if (> xtemp (- (/ stepRight 2) h-thick ))
(if (= 1 slope-upper)
(set! xtemp (- h-thick))
(set! xtemp
(/ (- (- (* stepRight (+ 1 jumps)) d-upper) h-thick) (- 1 slope-upper)))
)
)
(set! xp (+ (+ (cdr X-ext) h-thick) xtemp))
(set! yp (- (+ y-r-upper (* slope-upper xtemp)) d-upper))
)
)
(begin
(set! xp (cdr X-ext))
(set! yp (- (- y-r-upper (* thick slope-upper)) d-upper))
)
)
)
; insert upper-right corner:
(if (not
(and (and (not open-on-right) (> stepRight 0)) (eq? slope-upper -1)))
(begin
(set! points-i (cons (cons xp yp) points-i))
(set! yUpperLimit yp)))
; calculate lower-right corner:
(if open-on-right
(begin
(set! xp (cdr X-ext))
(set! yp (+ y-r-lower d-lower))
)
(if (> stepRight 0)
(if (not (eq? slope-lower 1))
(begin
(set! jumps 0)
(while (> (- (- d-lower (* slope-lower h-thick)) (* jumps stepRight)) stepRight)
(set! jumps (+ 1 jumps)))
(set! xtemp (/ (- (+ h-thick (* jumps stepRight)) d-lower) (- slope-lower 1)))
(if (> xtemp (- (/ stepRight 2) h-thick) )
(if (= -1 slope-lower)
(set! xtemp (- h-thick))
(set! xtemp
(/ (+ (- d-lower (* stepRight (+ 1 jumps))) h-thick) (- -1 slope-lower)))))
(set! xp (+ (+ (cdr X-ext) h-thick) xtemp))
(set! yp (+ (+ y-r-lower (* slope-lower xtemp)) d-lower))
)
)
(begin
(set! xp (cdr X-ext))
(set! yp (+ (- y-r-lower (* thick slope-lower)) d-lower))
)
)
)
(if (not (and (and (not open-on-right) (> stepRight 0)) (eq? slope-lower 1)))
(set! yLowerLimit yp))
; right zigzag:
(if (and (> stepRight 0) (not open-on-right))
(begin
(let loop ((cnt y-r-upper))
(if (> cnt y-r-lower)
(begin
(if (and (> cnt yLowerLimit) (< cnt yUpperLimit))
(set! points-i (cons (cons (cdr X-ext) cnt ) points-i)))
(if (and (> (- cnt (/ stepRight 2)) yLowerLimit) (< (- cnt (/ stepRight 2)) yUpperLimit))
(set! points-i (cons (cons (+ (cdr X-ext) r-width) (- cnt (/ stepRight 2)) ) points-i)))
(loop (- cnt stepRight))
)
)
)
)
)
; insert lower-right corner:
(if (not (and (and (not open-on-right) (> stepRight 0)) (eq? slope-lower 1)))
(set! points-i (cons (cons xp yp) points-i)))
(ly:stencil-add
; draw outer polygon:
(if (color? frame-color) ; only add stencil if set to a valid color (could also be set to ##f)
(ly:make-stencil (list 'color frame-color
(ly:stencil-expr (ly:round-filled-polygon points radius))
X-ext Y-ext))
empty-stencil)
; draw inner polygon:
(if (color? fill-color) ; only add stencil if set to a valid color (could also be set to ##f)
(ly:make-stencil (list 'color fill-color
(ly:stencil-expr (ly:round-filled-polygon points-i radius))
X-ext Y-ext))
empty-stencil)
)
)
)
#(define (music-boxer-stencil grob)
(let* ((elts (ly:grob-object grob 'elements))
(refp-X (ly:grob-common-refpoint-of-array grob elts X))
(X-ext (ly:relative-group-extent elts refp-X X))
(refp-Y (ly:grob-common-refpoint-of-array grob elts Y))
(Y-ext (ly:relative-group-extent elts refp-Y Y))
(padding (ly:grob-property grob 'padding 0.3))
(slope (ly:grob-property grob 'slope 0)) ; Y-difference between left and right edge (artificially applied)
(extra-dy (ly:grob-property grob 'extra-dy 0)) ; additional box height
(bb-padding (ly:grob-property grob 'broken-bound-padding -6))
(thick (ly:grob-property grob 'thickness 0.1))
(X-ext (interval-widen X-ext padding)) ; already applied here because makeDeltaSpan has no padding parameter
(Y-ext (interval-widen Y-ext padding)) ; dto.
(Y-ext (interval-widen Y-ext thick)) ; because makeDeltaSpan will take the Y-space for frame thickness from inside
(Y-ext (interval-widen Y-ext (/ extra-dy 2)))
(frame-color (ly:grob-property grob 'color black))
(fill-color (ly:grob-property grob 'fill-color white))
(offset (ly:grob-relative-coordinate grob refp-X X))
(stepLeft (ly:grob-property grob 'zigzag-left 0)) ; zigzag size for left edge (only used as approximate value )
(stepRight (ly:grob-property grob 'zigzag-right 0)) ; dto., right edge
(open-on-left
(and (ly:spanner? grob)
(= 1 (ly:item-break-dir (ly:spanner-bound grob LEFT)))))
(open-on-right
(and (ly:spanner? grob)
(= -1 (ly:item-break-dir (ly:spanner-bound grob RIGHT)))))
(y-l-lower (- (car Y-ext) (/ slope 2)))
(y-l-upper (- (cdr Y-ext) (/ slope 2)))
(y-r-lower (+ (car Y-ext) (/ slope 2)))
(y-r-upper (+ (cdr Y-ext) (/ slope 2)))
(cnt 0) ; counter, will be used later...
(stil empty-stencil))
(if (not (= stepLeft 0))
(begin ; calculate exact size for only entire zigzag squiggles should be used
(set! cnt (round (/ (- y-l-upper y-l-lower) stepLeft)))
(if (> cnt 0)
(set! stepLeft (/ (- y-l-upper y-l-lower) cnt))
(set! stepLeft 0))))
(if (not (= stepRight 0))
(begin
(set! cnt (round (/ (- y-r-upper y-r-lower) stepRight)))
(if (> cnt 0)
(set! stepRight (/ (- y-r-upper y-r-lower) cnt))
(set! stepRight 0))))
(set! stil
(makeDeltaSpan
y-l-lower y-l-upper
y-r-lower y-r-upper
frame-color fill-color
stepLeft stepRight
#f #f ; open-on-bottom open-on-top
thick bb-padding X-ext open-on-left open-on-right
0 ; radius
)
)
(ly:stencil-translate-axis stil (- offset) X)
)
)
%#(define box-stil music-boxer-stencil)
%% Test callback for Box.stencil
#(define (box-stil grob)
(let* ((elts (ly:grob-object grob 'elements))
(refp-X (ly:grob-common-refpoint-of-array grob elts X))
(X-ext (ly:relative-group-extent elts refp-X X))
(refp-Y (ly:grob-common-refpoint-of-array grob elts Y))
; following line triggers vertical spacing too early
;(Y-ext (ly:relative-group-extent elts refp-Y Y))
(Y-ext '(-3 . 3))
(padding (ly:grob-property grob 'padding 0.3))
(slope (ly:grob-property grob 'slope 0)) ; Y-difference between left and right edge (artificially applied)
(extra-dy (ly:grob-property grob 'extra-dy 0)) ; additional box height
(bb-padding (ly:grob-property grob 'broken-bound-padding -6))
(thick (ly:grob-property grob 'thickness 0.1))
(X-ext (interval-widen X-ext padding)) ; already applied here because makeDeltaSpan has no padding parameter
(Y-ext (interval-widen Y-ext padding)) ; dto.
(Y-ext (interval-widen Y-ext thick)) ; because makeDeltaSpan will take the Y-space for frame thickness from inside
(Y-ext (interval-widen Y-ext (/ extra-dy 2)))
(frame-color (ly:grob-property grob 'color black))
(fill-color (ly:grob-property grob 'fill-color white))
(offset (ly:grob-relative-coordinate grob refp-X X))
(stepLeft (ly:grob-property grob 'zigzag-left 0)) ; zigzag size for left edge (only used as approximate value )
(stepRight (ly:grob-property grob 'zigzag-right 0)) ; dto., right edge
(open-on-left
(and (ly:spanner? grob)
(= 1 (ly:item-break-dir (ly:spanner-bound grob LEFT)))))
(open-on-right
(and (ly:spanner? grob)
(= -1 (ly:item-break-dir (ly:spanner-bound grob RIGHT)))))
(y-l-lower (- (car Y-ext) (/ slope 2)))
(y-l-upper (- (cdr Y-ext) (/ slope 2)))
(y-r-lower (+ (car Y-ext) (/ slope 2)))
(y-r-upper (+ (cdr Y-ext) (/ slope 2)))
(cnt 0) ; counter, will be used later...
(stil empty-stencil))
(if (not (= stepLeft 0))
(begin ; calculate exact size for only entire zigzag squiggles should be used
(set! cnt (round (/ (- y-l-upper y-l-lower) stepLeft)))
(if (> cnt 0)
(set! stepLeft (/ (- y-l-upper y-l-lower) cnt))
(set! stepLeft 0))))
(if (not (= stepRight 0))
(begin
(set! cnt (round (/ (- y-r-upper y-r-lower) stepRight)))
(if (> cnt 0)
(set! stepRight (/ (- y-r-upper y-r-lower) cnt))
(set! stepRight 0))))
(set! stil
(makeDeltaSpan
y-l-lower y-l-upper
y-r-lower y-r-upper
frame-color fill-color
stepLeft stepRight
#f #f ; open-on-bottom open-on-top
thick bb-padding X-ext open-on-left open-on-right
0 ; radius
)
)
(ly:stencil-translate-axis stil (- offset) X)
)
)
#(add-grob-definition
'Box
`(
(direction . ,UP)
(outside-staff-priority . 251) ; just larger than DynamicText
(stencil . ,box-stil)
(meta . ((class . Item)
(interfaces . (outside-staff-interface))))))
#(add-grob-definition
'MusicBoxer
`(
(direction . ,UP)
(outside-staff-priority . 251) ; just larger than DynamicText
(stencil . ,music-boxer-stencil)
(meta . ((class . Spanner)
(interfaces . (outside-staff-interface))))))
#(define box-types
'(
(BoxEvent
. ((description . "A box encompassing music at a single timestep.")
(types . (general-music box-event music-event event))
))
))
#(define music-boxer-types
'(
(MusicBoxerEvent
. ((description . "Used to signal where boxes encompassing music start and stop.")
(types . (general-music music-boxer-event span-event event))
))
))
#(set!
music-boxer-types
(map (lambda (x)
(set-object-property! (car x)
'music-description
(cdr (assq 'description (cdr x))))
(let ((lst (cdr x)))
(set! lst (assoc-set! lst 'name (car x)))
(set! lst (assq-remove! lst 'description))
(hashq-set! music-name-to-property-table (car x) lst)
(cons (car x) lst)))
music-boxer-types))
#(set!
box-types
(map (lambda (x)
(set-object-property! (car x)
'music-description
(cdr (assq 'description (cdr x))))
(let ((lst (cdr x)))
(set! lst (assoc-set! lst 'name (car x)))
(set! lst (assq-remove! lst 'description))
(hashq-set! music-name-to-property-table (car x) lst)
(cons (car x) lst)))
box-types))
#(set! music-descriptions
(append music-boxer-types music-descriptions))
#(set! music-descriptions
(append box-types music-descriptions))
#(set! music-descriptions
(sort music-descriptions alist<?))
#(define (add-bound-item spanner item)
(if (null? (ly:spanner-bound spanner LEFT))
(ly:spanner-set-bound! spanner LEFT item)
(ly:spanner-set-bound! spanner RIGHT item)))
musicBoxerEngraver =
#(lambda (context)
(let ((span '())
(finished '())
(current-event '())
(event-start '())
(event-stop '())
)
`((listeners
(music-boxer-event .
,(lambda (engraver event)
(if (= START (ly:event-property event 'span-direction))
(set! event-start event)
(set! event-stop event)))))
(acknowledgers
(note-column-interface .
,(lambda (engraver grob source-engraver)
(if (ly:spanner? span)
(begin
(ly:pointer-group-interface::add-grob span 'elements grob)
(add-bound-item span grob)))
(if (ly:spanner? finished)
(begin
(ly:pointer-group-interface::add-grob finished 'elements grob)
(add-bound-item finished grob)))))
(inline-accidental-interface .
,(lambda (engraver grob source-engraver)
(if (ly:spanner? span)
(begin
(ly:pointer-group-interface::add-grob span 'elements grob)))
(if (ly:spanner? finished)
(ly:pointer-group-interface::add-grob finished 'elements grob))))
(dots-interface .
,(lambda (engraver grob source-engraver)
(if (ly:spanner? span)
(begin
(ly:pointer-group-interface::add-grob span 'elements grob)))
(if (ly:spanner? finished)
(ly:pointer-group-interface::add-grob finished 'elements grob))))
(ledger-line-spanner-interface .
,(lambda (engraver grob source-engraver)
(if (ly:spanner? span)
(begin
(ly:pointer-group-interface::add-grob span 'elements grob)))
(if (ly:spanner? finished)
(ly:pointer-group-interface::add-grob finished 'elements grob))))
(script-interface .
,(lambda (engraver grob source-engraver)
(if (and (ly:spanner? span)
(eq? #t (ly:grob-property span 'acknowledge-script-interface)))
(begin
(ly:pointer-group-interface::add-grob span 'elements grob)))
(if (and (ly:spanner? finished)
(eq? #t (ly:grob-property finished 'acknowledge-script-interface)))
(ly:pointer-group-interface::add-grob finished 'elements grob))))
(finger-interface .
,(lambda (engraver grob source-engraver)
(if (and (ly:spanner? span)
(eq? #t (ly:grob-property span 'acknowledge-finger-interface)))
(begin
(ly:pointer-group-interface::add-grob span 'elements grob)))
(if (and (ly:spanner? finished)
(eq? #t (ly:grob-property finished 'acknowledge-finger-interface)))
(ly:pointer-group-interface::add-grob finished 'elements grob))))
;; add additional interfaces to acknowledge here
)
(process-music .
,(lambda (trans)
(if (ly:stream-event? event-stop)
(if (null? span)
(ly:warning "No start to this box.")
(begin
(set! finished span)
(ly:engraver-announce-end-grob trans finished event-start)
(set! span '())
(set! event-stop '()))))
(if (ly:stream-event? event-start)
(begin
(set! span (ly:engraver-make-grob trans 'MusicBoxer event-start))
(set! event-start '())))))
(stop-translation-timestep .
,(lambda (trans)
(if (and (ly:spanner? span)
(null? (ly:spanner-bound span LEFT)))
(ly:spanner-set-bound! span LEFT
(ly:context-property context 'currentMusicalColumn)))
(if (ly:spanner? finished)
(begin
(if (null? (ly:spanner-bound finished RIGHT))
(ly:spanner-set-bound! finished RIGHT
(ly:context-property context 'currentMusicalColumn)))
(set! finished '())
(set! event-start '())
(set! event-stop '())))))
(finalize
(lambda (trans)
(if (ly:spanner? finished)
(begin
(if (null? (ly:spanner-bound finished RIGHT))
(set! (ly:spanner-bound finished RIGHT)
(ly:context-property context 'currentMusicalColumn)))
(set! finished '())))
(if (ly:spanner? span)
(begin
(ly:warning "unterminated box :-(")
(ly:grob-suicide! span)
(set! span '())))
)))))
boxEngraver =
#(lambda (context)
(let ((box '())
(ev '()))
`((listeners
(box-event .
,(lambda (engraver event)
(set! ev event))))
(acknowledgers
(note-column-interface .
,(lambda (engraver grob source-engraver)
(if (ly:grob? box)
(begin
; (set! (ly:grob-parent box X) grob) ;; ??
(set! (ly:grob-parent box Y) grob)
(ly:pointer-group-interface::add-grob box 'elements grob)))))
(inline-accidental-interface .
,(lambda (engraver grob source-engraver)
(if (ly:item? box)
(ly:pointer-group-interface::add-grob box 'elements grob))))
(dots-interface .
,(lambda (engraver grob source-engraver)
(if (ly:item? box)
(ly:pointer-group-interface::add-grob box 'elements grob))))
(ledger-line-spanner-interface .
,(lambda (engraver grob source-engraver)
(if (ly:item? box)
(ly:pointer-group-interface::add-grob box 'elements grob))))
(script-interface .
,(lambda (engraver grob source-engraver)
(if (and (ly:item? box) (eq? #t (ly:grob-property box 'acknowledge-script-interface)))
(ly:pointer-group-interface::add-grob box 'elements grob))))
(finger-interface .
,(lambda (engraver grob source-engraver)
(if (and (ly:item? box) (eq? #t (ly:grob-property box 'acknowledge-finger-interface)))
(ly:pointer-group-interface::add-grob box 'elements grob))))
;; add additional interfaces to acknowledge here
)
(process-music .
,(lambda (trans)
(if (ly:stream-event? ev)
(begin
(set! box (ly:engraver-make-grob trans 'Box ev))
(set! ev '())))))
(stop-translation-timestep .
,(lambda (trans)
(set! box '()))))))
musicBoxerStart =
#(make-span-event 'MusicBoxerEvent START)
musicBoxerEnd =
#(make-span-event 'MusicBoxerEvent STOP)
box = #(make-music 'BoxEvent)
\layout {
\context {
\Global
\grobdescriptions #all-grob-descriptions
}
\context {
\Voice
\consists \musicBoxerEngraver % for spans
\consists \boxEngraver
% default settings:
\override MusicBoxer.layer = -10
\override Box.layer = -10
\once \override Box.acknowledge-script-interface = ##f
\once \override Box.acknowledge-finger-interface = ##f
\once \override MusicBoxer.acknowledge-script-interface = ##f
\once \override MusicBoxer.acknowledge-finger-interface = ##f
%\override MusicBoxer.outside-staff-priority = #10000
% \override Box.outside-staff-priority = #10000
}
}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% EXAMPLE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
melody = \relative c' {
\override MusicBoxer.thickness = 0.5
\override MusicBoxer.broken-bound-padding = -12
\override MusicBoxer.color = #red
\override MusicBoxer.fill-color = #(rgb-color 1 0.8 0.8)
\time 3/4
\musicBoxerStart
e4 e d
\musicBoxerEnd
c2.
\musicBoxerStart
e4 e4 d
\musicBoxerEnd
c2.
\once \override MusicBoxer.zigzag-right = #1.5
\musicBoxerStart e4 e \musicBoxerEnd d g2. ~
g4
\once \override MusicBoxer.zigzag-left = #1.5
\musicBoxerStart e d \musicBoxerEnd c2.
\override MusicBoxer.color = #blue
\override MusicBoxer.fill-color = #(rgb-color 0.8 0.8 1)
\musicBoxerStart
e4 f g
g4 f8 e \musicBoxerEnd f4
\musicBoxerStart
d4 e f
\break
f4 e8 d \musicBoxerEnd e4
\override MusicBoxer.color = #(rgb-color 1 0.4 0.0)
\override MusicBoxer.fill-color = #(rgb-color 1 0.9 0.8)
\once \override MusicBoxer.slope = #2
\musicBoxerStart
e4 e f
\musicBoxerEnd
g2.
\override MusicBoxer.color = #red
\override MusicBoxer.fill-color = #(rgb-color 1 0.8 0.8)
\once \override MusicBoxer.slope = #-2
\musicBoxerStart
e4 e d
\musicBoxerEnd
c2.
}
another = \relative c' {
\set fingeringOrientations = #'(left)
\override Box.thickness = 0.5
\override Box.color = #(rgb-color 0.0 0.9 0.0)
\override Box.fill-color = #(rgb-color 0.9 1 0.8)
\time 4/4
\musicBoxerStart c4\f e g \musicBoxerEnd c
\once \override MusicBoxer.acknowledge-script-interface = ##t
\musicBoxerStart
c,4\f e g \musicBoxerEnd c
\musicBoxerStart c,4-1 e-2 g-3 \musicBoxerEnd c-5
\once \override MusicBoxer.acknowledge-finger-interface = ##t
\musicBoxerStart c,4-1 e-2 g-3 \musicBoxerEnd c-5
\box <c-5 g-3 e-2 c-1>1 \f \fermata
\once \override Box.acknowledge-script-interface = ##t
\once \override Box.acknowledge-finger-interface = ##t
\box <c-5 g-3 e-2 c-1>1 \f \fermata
\break
\override Box.layer = #-9
\musicBoxerStart c,4 e8 f g4 \musicBoxerEnd c
\musicBoxerStart
c,4 _"Box around \"f\" makes beam disappear :-("
e8
\box
f g4
\musicBoxerEnd
c
R1 R1
c,8 _"No problem with MusicBoxer" d \musicBoxerStart
e8 \musicBoxerEnd f
g4 c
R1
}
\score {
\new Staff { \melody \another }
}
%{
#: axis-group-interface.cc:786
msgid "an outside-staff object should have a direction, defaulting to up"
msgstr "Ein Objekt außerhalb der Notenzeile sollte eine Richtung haben, Vorgabe ist »nach oben«"
%}_______________________________________________
lilypond-user mailing list
[email protected]
https://lists.gnu.org/mailman/listinfo/lilypond-user
