Hello dear Pondmates, for some question on SE I constructed a nice little function for parenthesizing or bracketing whole notes (rather than just note heads this includes heads, stems, flags, dots, tremolo and accidentals).
I’m posting it here in the hope this might prove useful for some out there. This does not currently work with Beaming. Cheers, Valentin
% modification for scm/stencil.scm:parenthesize-stencil that allows to specify direction
#(define* (parenthesize-stencil
stencil half-thickness width angularity padding #:optional (direction CENTER))
"Add parentheses around @var{stencil}, returning a new stencil."
(let* ((y-extent (ly:stencil-extent stencil Y))
(lp ((@@ (lily) make-parenthesis-stencil)
y-extent half-thickness width angularity 1))
(rp ((@@ (lily) make-parenthesis-stencil)
y-extent half-thickness width angularity -1)))
(if (<= direction CENTER)
(set! stencil (ly:stencil-combine-at-edge stencil X LEFT lp padding)))
(if (>= direction CENTER)
(set! stencil (ly:stencil-combine-at-edge stencil X RIGHT rp padding)))
stencil))
% modification for scm/stencil.scm:bracketify-stencil that allows to specify direction
#(define* (bracketify-stencil stil axis thick protrusion padding #:optional (direction CENTER))
"Add brackets around @var{stil}, producing a new stencil."
(let* ((ext (ly:stencil-extent stil axis))
(lb (ly:bracket axis ext thick protrusion))
(rb (ly:bracket axis ext thick (- protrusion))))
(if (>= direction CENTER)
(set! stil
(ly:stencil-combine-at-edge stil (other-axis axis) 1 rb padding)))
(if (<= direction CENTER)
(set! stil
(ly:stencil-combine-at-edge stil (other-axis axis) -1 lb padding)))
stil))
%%% Change Stem.stencil to #(parenthesize-note ...) to paranthesize a whole note. Use
%%% key arguments to change details e.g. #(parenthesize-note #:thickness 0.2)
%%% We are not directly using this to calculate stencil, but rather use this in
%%% Stem.before-line-breaking, as else we get circular dependency warnings for
%%% Stem.Y-extent with Flags.
%%%
%%% WARNING: THIS IS NOT COMPATIBLE WITH BEAMS!
%%% THIS WILL TRY TO ADD EXTRA SPACE TO THE STEM SO IT DOES NOT COLLIDE!
%%% THIS MIGHT PRODUCE AWKWARD RESULTS!
#(define* (parenthesize-note #:key
(addleft 0)
(addright 0)
(addtop 0)
(addbottom 0)
(thickness 0.2)
(width 0.4)
(angularity 0)
(direction CENTER)
(bracket #f)
(bracket-protrusion 0.25)
(bracket-padding 0.1))
(lambda (grob)
(let* ((orig (ly:grob-property grob 'stencil))
(orig (if (not (ly:stencil? orig)) empty-stencil orig))
; Collect all grobs belonging to note from Stem (Flag, Heads, Accidentals)
(flag (ly:grob-object grob 'flag))
(trem-flag (ly:grob-object grob 'tremolo-flag))
(heads (ly:grob-object grob 'note-heads))
(heads (ly:grob-array->list heads))
(accidentals (map (lambda (head) (ly:grob-object head 'accidental-grob))
heads))
(dots (map (lambda (head) (ly:grob-object head 'dot))
heads))
(all-add-grobs (append (list flag trem-flag) heads accidentals dots))
(all-add-grobs (filter (lambda (x) (not (null? x))) all-add-grobs))
; Determine X extents of each such grob relative to Paper Column (second X parent of Stem).
; This is necessariy as Accidentals do not have the Note Column as parent
(all-x-exts (map (lambda (g) (ly:grob-extent g (ly:grob-parent (ly:grob-parent grob X) X) X))
all-add-grobs))
; Determine Y extents of each such grob relative to Vertical Axis Group (second Y parent of Stem).
; This is necessariy as Tremolo Flags do not have the Note Column as parent
(all-y-exts (map (lambda (g) (ly:grob-extent g (ly:grob-parent (ly:grob-parent grob Y) Y) Y))
all-add-grobs))
(all-x-exts (filter (lambda (x) (not (null? x))) all-x-exts))
(all-y-exts (filter (lambda (x) (not (null? x))) all-y-exts))
; Add extent of this stencil
(ext-x (ly:grob-extent grob (ly:grob-parent grob X) X))
(ext-y (ly:grob-extent grob (ly:grob-parent grob Y) Y))
; Get offset of grob
(off-x (ly:grob-property grob 'X-offset))
(off-y (ly:grob-property grob 'Y-offset))
; Add stencil extents
(all-x-exts (cons ext-x all-x-exts))
(all-y-exts (cons ext-y all-y-exts))
; unify extents
(ext-x (reduce (lambda (x y) (interval-union x y)) '(0 0) all-x-exts))
(ext-y (reduce (lambda (x y) (interval-union x y)) '(0 0) all-y-exts))
; correct for offset
(ext-x (cons (- (car ext-x) off-x) (- (cdr ext-x) off-x)))
(ext-y (cons (- (car ext-y) off-y) (- (cdr ext-y) off-y)))
; extend by padding
(ext-x (cons (- (car ext-x) addleft) (+ (cdr ext-x) addright)))
(ext-y (cons (- (car ext-y) addbottom) (+ (cdr ext-y) addtop)))
; Change dimensions of bar line
(orig-box (ly:stencil-outline orig (make-filled-box-stencil ext-x ext-y)))
(pstc (parenthesize-stencil orig-box (/ thickness 2) width angularity 0 direction))
(bktstc (bracketify-stencil orig-box Y thickness bracket-protrusion bracket-padding direction))
(newstc (if bracket bktstc pstc))
; Try to add more space if necessary
(extra-sw (ly:grob-property grob 'extra-spacing-width '(0 . 0)))
(new-ext (ly:stencil-extent newstc X))
(old-ext (ly:stencil-extent orig X))
(diff1 (- (car new-ext) (car old-ext)))
(diff2 (- (cdr new-ext) (cdr old-ext)))
(new-extra-sw (cons (+ (car extra-sw) diff1) (+ (cdr extra-sw) diff2))))
(if bracket
(ly:grob-set-property! grob 'stencil bktstc)
(ly:grob-set-property! grob 'stencil pstc))
(ly:grob-set-property! grob 'extra-spacing-width new-extra-sw))))
#(define (alist->arglist alist)
(define (impl alist)
(if (null? alist)
'()
(append (list (symbol->keyword (caar alist)) (cdar alist))
(alist->arglist (cdr alist)))))
; If one key is duplicate #:key arguments will use the last one
; as the assoc-get-behaviour is opposite we reverse the alist
(impl (reverse alist)))
#(define (list-of-pairs? l)
(define (all-pairs? l)
(if (null? l)
#t
(and (pair? (car l)) (all-pairs? (cdr l)))))
(and (list? l) (all-pairs? l)))
parenthesizeNote =
#(define-music-function (opts mus)
((list-of-pairs? '()) ly:music?)
#{
\once\override Stem.before-line-breaking =
#(apply parenthesize-note (alist->arglist opts))
#mus
#})
parenthesizeNoteLeft =
#(define-music-function (opts mus)
((list-of-pairs? '()) ly:music?)
(parenthesizeNote (append opts `((direction . ,LEFT))) mus))
parenthesizeNoteRight =
#(define-music-function (opts mus)
((list-of-pairs? '()) ly:music?)
(parenthesizeNote (append opts `((direction . ,RIGHT))) mus))
bracketNote =
#(define-music-function (opts mus)
((list-of-pairs? '()) ly:music?)
(parenthesizeNote (append opts `((bracket . #t))) mus))
bracketNoteLeft =
#(define-music-function (opts mus)
((list-of-pairs? '()) ly:music?)
(parenthesizeNote (append opts `((bracket . #t) (direction . ,LEFT))) mus))
bracketNoteRight =
#(define-music-function (opts mus)
((list-of-pairs? '()) ly:music?)
(parenthesizeNote (append opts `((bracket . #t) (direction . ,RIGHT))) mus))
%%% EXAMPLES
\new Staff {
c''
\acciaccatura { \parenthesizeNote d'8 } c'4
d''4 \parenthesize ( c''4) |
}
\new Staff {
c''
\acciaccatura { \bracketNote d'8 } c'4
d''4 \parenthesize ( c''4) |
}
\new Staff {
\parenthesizeNote a'
\parenthesizeNote 8\noBeam
\parenthesizeNote 16\noBeam
\parenthesizeNote 16\noBeam
\parenthesizeNote ais'16
r8.
\parenthesizeNoteLeft a'4 g' f' e' \parenthesizeNoteRight d'
}
\new Staff {
\bracketNote a'
\bracketNote 8\noBeam
\bracketNote 16\noBeam
\bracketNote 16\noBeam
\bracketNote ais'16
r8.
\bracketNoteLeft a'4 g' f' e' \bracketNoteRight d'
}
\new Staff {
\parenthesizeNote <c' d' f'>1
\bracketNote #'((addright . 2)) 4
\bracketNote 4...
r32
\bracketNote 4:32
\omit Stem
\bracketNote #'((addtop . 0.5) (addbottom . 0.5)) c'4
\bracketNote #'((addtop . 0.5) (addbottom . 0.5)) d'
\bracketNote #'((addtop . 0.5) (addbottom . 0.5)) e'
\bracketNote #'((addtop . 0.5) (addbottom . 0.5)) f
\revert Stem.stencil
<>^"Beams do not work this way"
\parenthesizeNote c'8 d' e' f'
}
signature.asc
Description: This is a digitally signed message part.
