Hi Klaus,
On Fri, Jan 16, 2015 at 11:35 AM, Klaus Blum <benbigno...@gmx.de> wrote:
> Hi David,
> thanks again. You're my hero: now it works.
>
>
> I've added a few things so far:
>
> - "thickness" property can be used to control frame thickness, can even be
> set to zero ("color" property and "layer" property work by default)
> - "filled" property (boolean) controls whether the box is to be filled with
> a colored rectangle whose color can be set by "fill-color" property.
>
> I've also added two global boolean variables "acknowledge-finger-interface"
> and "acknowledge-script-interface" to control whether the boxes take care
> of
> fingerings and dynamics. For example, if you want to mark themes and
> motifs,
> you might only want to consider the notes and rests.
> Unfortunately, these settings are valid for the whole score and therefore
> cannot change during a piece. I'd prefer to use properties, because this
> would allow \once \override etc. But I don't know how to access these
> properties from within musicBoxerEngraver.
>
In the attached, I simply added new properties:
acknowledge-finger-interface and acknowledge-script-interface. In the
engraver, I used ly:grob-property to read the setting. You'll notice that
if something is ignored it doesn't get pushed out of the way, though.
Adding properties like this would get cumbersome. It would be nice to have
a property which takes a flexible list of interfaces to include (over and
above interfaces which need to be acknowledged, like note-column-interface).
> If a box is split due to a line break, it would be cool to have those two
> boxes open at the right/left side. For this, musicBoxerEngraver would need
> to tell if a box is started/stopped by a line break instead of a manual
> command.
>
This is not a problem. I use the function ly:item-break-status on the
spanner bounds to determine the state of "brokenness," then add in the left
or right vertical only if that bound has a break-status of 0 (indicating an
unbroken bound).
I tried to keep music-boxer-stencil and make-box separate. In so doing, I
had to add two more parameters to make-box. (You may decide to merge the
two functions in the end.)
Hope this is helpful,
David
\version "2.19.15"
\header {
tagline = ##f
}
%#(define acknowledge-finger-interface #t)
%#(define acknowledge-script-interface #t)
#(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))
`(
(filled ,boolean? "Should we fill in this box?")
(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?")
; add more properties here
))
#(define (make-box thick padding filled fill-color open-on-left open-on-right xext yext) ; modified by KB
(let ((xext (interval-widen xext padding))
(yext (interval-widen yext padding))
(temp-stil-inner empty-stencil)
(temp-stil-outer empty-stencil))
(if
(eq? #t filled)
(set! temp-stil-inner
(ly:make-stencil (list 'color fill-color
(list 'round-filled-box (- (car xext)) (cdr xext)
(- (car yext)) (cdr yext) 0.0)
xext yext))))
(if
(> thick 0)
(set! temp-stil-outer
(ly:stencil-add
(make-filled-box-stencil (cons (- (car xext) thick) (+ (cdr xext) thick)) (cons (- (car yext) thick) (car yext) )) ; modified by KB
(make-filled-box-stencil (cons (- (car xext) thick) (+ (cdr xext) thick)) (cons (cdr yext) (+ (cdr yext) thick))) ; modified by KB
(if (not open-on-right)
(make-filled-box-stencil (cons (cdr xext) (+ (cdr xext) thick)) yext)
empty-stencil)
(if (not open-on-left)
(make-filled-box-stencil (cons (- (car xext) thick) (car xext)) yext)
empty-stencil)
)))
(ly:stencil-add
temp-stil-inner
temp-stil-outer
)
)
)
#(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))
(thick (ly:grob-property grob 'thickness 0.1)) ; added by KB
(filled (ly:grob-property grob 'filled #t)) ; added by KB
(fill-color (ly:grob-property grob 'fill-color grey)) ; added by KB
(offset (ly:grob-relative-coordinate grob refp-X X))
(left-bound (ly:spanner-bound grob LEFT))
(right-bound (ly:spanner-bound grob RIGHT))
(break-dir-L (ly:item-break-dir left-bound))
(open-on-left (if (= 1 break-dir-L) #t #f))
(break-dir-R (ly:item-break-dir right-bound))
(open-on-right (if (= -1 break-dir-R) #t #f))
(stil (make-box thick padding filled fill-color
open-on-left open-on-right X-ext Y-ext))
)
(ly:stencil-translate-axis stil (- offset) X)
)
)
#(define box-stil music-boxer-stencil)
#(add-grob-definition
'Box
`(
(stencil . ,box-stil)
(meta . ((class . Item)
(interfaces . ())))))
#(add-grob-definition
'MusicBoxer
`(
(stencil . ,music-boxer-stencil)
(meta . ((class . Spanner)
(interfaces . ())))))
#(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))))
(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))))
(script-interface .
,(lambda (engraver grob source-engraver)
(if (and (ly:item? box) (eq? #t 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 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)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% EXAMPLE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
melody = \relative c' {
% #(set! acknowledge-finger-interface #f)
% #(set! acknowledge-script-interface #f)
\override Score.MusicBoxer.filled = ##t
\override Score.MusicBoxer.layer = -10
\override Score.MusicBoxer.filled = ##t
\override Score.MusicBoxer.thickness = 0.5
\override Score.MusicBoxer.color = #red
\override Score.MusicBoxer.fill-color = #(rgb-color 1 0.8 0.8)
\time 3/4
\musicBoxerStart
e4 e d
\musicBoxerEnd
c2.
\musicBoxerStart
e4 e d
\musicBoxerEnd
c2.
\override Score.MusicBoxer.color = #blue
\override Score.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 Score.MusicBoxer.color = #(rgb-color 1 0.4 0.0)
\override Score.MusicBoxer.fill-color = #(rgb-color 1 0.9 0.8)
\musicBoxerStart
e4 e f
\musicBoxerEnd
g2.
\override Score.MusicBoxer.color = #red
\override Score.MusicBoxer.fill-color = #(rgb-color 1 0.8 0.8)
\musicBoxerStart
e4 e d
\musicBoxerEnd
c2.
}
another = \relative c' {
\time 4/4
\musicBoxerStart c4\f e g \musicBoxerEnd c
\once \override Score.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 Score.MusicBoxer.acknowledge-finger-interface = ##t
\musicBoxerStart c,4-1 e-2 g-3 \musicBoxerEnd c-5
}
\score {
\new Staff { \melody \another }
}
\layout {
\context {
\Global
\grobdescriptions #all-grob-descriptions
}
\context {
\Score
\consists \musicBoxerEngraver % for spans
%\consists \boxEngraver
}
}
_______________________________________________
lilypond-user mailing list
lilypond-user@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-user
