On 11/3/2018 4:25 PM, David Nalesnik wrote:
On Sat, Nov 3, 2018 at 3:21 PM Ben <soundsfromso...@gmail.com> wrote:
On 11/3/2018 4:16 PM, David Nalesnik wrote:
On Sat, Nov 3, 2018 at 2:57 PM Ben <soundsfromso...@gmail.com> wrote:
On 11/3/2018 2:54 PM, m...@opus11.net wrote:
Just wondered if anyone has a working solution to creating Lutoslawski-style
box repeats such as this one: https://goo.gl/images/TYKdWt
I couldn't find a complete solution in either the LSR or mailing list archives.
If not, I'll start putting together something probably based on the frame
module from https://github.com/openlilylib/analysis, but any tips would be
appreciated.
Thanks,
Mark
Hi Mark,
For a long while I was using the frameengraver21 but I remember encountering a
bug and never being able to move past it since. I'm not sure what is available
recently, but I am curious as well :) I would use it quite often if there was a
boxed notation module.
The solution to this error has come up several times on the list.
Searching "must be type `list'" returns
https://www.mail-archive.com/lilypond-user@gnu.org/msg117642.html
You can also find the FrameEngraver code in that thread.
Best,
David
Thank you David! Not sure how I missed that...
Easy enough--the archives are not a good place to version-control
code! I think I finally need to put this stuff up on GitHub so
there's an easy place to find the "latest" version (which I will need
search the list archives to discover...)
David
David,
Here are the files I am working with - I tried to make the change but
still no dice. When you get a minute, could you take a look and tell me
what is wrong with these files? As of now, I cannot even run
frameEngraver25 it flat out crashes LilyPond every time. frameEngraver21
doesn't crash but does have those list-return errors to prevent it from
working as well.
Thank you!
\version "2.17.21"
% Uncomment the following line to show the skylines.
%#(ly:set-option 'debug-skylines)
\paper {
indent = #0
}
% Note: In order to prevent "bleed-over" from one session to another, it is
% recommended that .ly files using the following functions be processed
% individually (rather than in a batch).
%%%%%%%%%%%%%%%%%%%%%%%%%%% CREATE NEW EVENT CLASSES %%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define my-event-classes (ly:make-context-mod))
defineEventClass =
#(define-void-function (parser location class parent)
(symbol? symbol?)
(ly:add-context-mod
my-event-classes
`(apply
,(lambda (context class parent)
(ly:context-set-property!
context
'EventClasses
(event-class-cons
class
parent
(ly:context-property context 'EventClasses '()))))
,class ,parent)))
\defineEventClass #'frame-event #'span-event
\defineEventClass #'frame-extender-event #'span-event
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% MUSIC DESCRIPTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define frame-types
'(
(FrameEvent
. ((description . "Signals where a frame starts and stops.")
(types . (general-music frame-event span-event event))
))
))
#(set!
frame-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)))
frame-types))
#(define frame-extender-types
'(
(FrameExtenderEvent
. ((description . "Signals where a frame extender line stops.")
(types . (general-music frame-extender-event span-event event))
))
))
#(set!
frame-extender-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)))
frame-extender-types))
#(set! music-descriptions
(append frame-types music-descriptions))
#(set! music-descriptions
(sort music-descriptions alist<?))
%%%%%%%%%%%%%%%%%%%%%%%%% ADD NEW GROB INTERFACES %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(ly:add-interface
'frame-interface
"A box for frame notation."
'(frame-elements))
#(ly:add-interface
'frame-extender-interface
"An extender line (with arrow) for frame notation."
'())
#(ly:add-interface
'frame-bracket-interface
"A bracket with text (possibly to indicate duration) for frame notation."
'(bracket-elements side-support-elements))
%%%%%%%%%%%%%%%%%%%%%%%%% CREATE NEW GROB PROPERTIES %%%%%%%%%%%%%%%%%%%%%%%%%%%
#(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))
`(
(extender-Y-offset ,number?
"Vertical displacement of extender line from center staff line")
))
%%%%%%%%%%%%%%%%%%%%%%%% DIMENSIONS OF STENCILS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% The following functions calculate dimensions for those grobs which have
% stencils: Frame, FrameExtender, and FrameBracket. Grobs with stencils
% should not use the 'axis-group-interface for calculating height and width.
% Relevant grobs have been stored in arrays other than 'elements, which
% is the grob-array used by the axis-group-interface for its calculations.
% Thanks to Mike Solomon for explanations and code.
#(define (dim-hack grob ax)
(let* ((frame-elts (ly:grob-object grob 'frame-elements))
(common (ly:grob-common-refpoint-of-array grob frame-elts ax))
(rel (ly:relative-group-extent frame-elts common ax))
(off (ly:grob-relative-coordinate grob common ax)))
;(format #t "rel-~a: ~a off: ~a~%" ax rel off)
(coord-translate rel (- off))))
#(define (height-hack grob)
(dim-hack grob Y))
#(define (width-hack grob)
(dim-hack grob X))
#(define (bracket-width grob)
(let* ((bracket-elts (ly:grob-object grob 'bracket-elements))
(common (ly:grob-common-refpoint-of-array grob bracket-elts X))
(rel (ly:relative-group-extent bracket-elts common X))
(off (ly:grob-relative-coordinate grob common X)))
(coord-translate rel (- off))))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% PRINT FUNCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define (frame::print grob)
"Draw a box around a group of notes for use in frame notation."
(let* ((staff-space (ly:staff-symbol-staff-space grob))
(box-padding (* (ly:grob-property grob 'padding) staff-space))
(height (height-hack grob))
; cannot use axis-group-interface, as there are no elements
(width (width-hack grob))
(th (ly:grob-property grob 'thickness))
(stencil (ly:make-stencil '() width height))
(stencil (box-stencil stencil th box-padding)))
stencil))
#(define (ly:frame-extender::print grob)
"Draw an extender line with arrow for use in frame notation."
(let* ((refp (ly:grob-system grob))
(staff-space (ly:staff-symbol-staff-space grob)) ; for scaling
;; NOTE: The frame grob is only available to the portion of a broken
;; extender which is on the same line. The following property lookup
;; will return '() for siblings. It would be nice to have the option
;; to center the extender vertically on the frame, and have the
;; siblings at the same height. How can this be done automatically
;; without the frame being "remembered"?
(frame (ly:grob-object grob 'frame))
(left-bound (ly:spanner-bound grob LEFT))
(right-bound (ly:spanner-bound grob RIGHT))
(left-bound-ext (ly:grob-extent left-bound left-bound X))
(extender-th (* (ly:grob-property grob 'thickness) staff-space))
(half-extender-th (/ extender-th 2.0))
;; Calculate an offset so that extender segment is lined up with the
;; inside edge of the frame, or clears prefatory material if a
;; broken piece.
(left-offset
(if (ly:grob? frame)
(* (ly:grob-property frame 'padding) staff-space)
1.0))
(right-bound-ext (ly:grob-extent right-bound right-bound X))
(right-offset
(if (interval-empty? right-bound-ext)
0.0
(interval-length right-bound-ext)))
(left-bound-coord (ly:grob-relative-coordinate left-bound refp X))
(right-bound-coord (ly:grob-relative-coordinate right-bound refp X))
;; By default, the line will be drawn at the center line of the staff.
(extender-dy (ly:grob-property grob 'extender-Y-offset))
;; the 1.0 is a hardcoded value which ensures that there is some whitespace
;; between the end of the extender and what follows. It would be nice
;; if the extender could actually push material that follows.
(right-offset (+ right-offset (* 1.0 staff-space)))
(layout (ly:grob-layout grob))
(line-th (ly:output-def-lookup layout 'line-thickness))
(start (+ (/ line-th 2) (cdr left-bound-ext) left-offset))
(end (- right-bound-coord left-bound-coord right-offset))
;; Line is drawn as filled box because there is no rounding
;; of corners. Rounded corners make alignment with frame
;; problematic. For this reason, the public function
;; `arrow-stencil-maker' from `stencil.scm' has not been used.
(extender
(markup
#:override '(filled . #t)
#:path
line-th
;; If extender is very short, do not draw arrow
(if (<= (- end start) (* 3.5 extender-th))
`((moveto ,start ,(+ extender-dy half-extender-th))
(lineto ,end
,(+ extender-dy half-extender-th))
(lineto ,end
,(- extender-dy half-extender-th))
(lineto ,start ,(- extender-dy half-extender-th))
(closepath))
`(; line with arrow-head
(moveto ,start ,(+ extender-dy half-extender-th))
(lineto ,(- end (* 3 extender-th) half-extender-th)
,(+ extender-dy half-extender-th))
(lineto ,(- end (* 3 extender-th) half-extender-th)
,(- extender-dy half-extender-th))
(lineto ,start ,(- extender-dy half-extender-th))
(closepath)
; the arrow-head
(moveto ,end ,extender-dy)
(curveto
,end
,extender-dy
,(- end (* 1.5 extender-th) (/ half-extender-th 2))
,extender-dy
,(- end (* 3 extender-th) half-extender-th)
,(+ extender-dy (* 1.5 extender-th)))
(lineto ,(- end (* 3 extender-th) half-extender-th)
,(- extender-dy (* 1.5 extender-th)))
(curveto
,(- end (* 3 extender-th) half-extender-th)
,(- extender-dy (* 1.5 extender-th))
,(- end (* 1.5 extender-th) (/ half-extender-th 2))
,extender-dy
,end
,extender-dy)
(closepath)))))
(extender (grob-interpret-markup grob extender)))
extender))
#(define (ly:frame-bracket::print grob)
"Draw a bracket for use in frame notation."
(let* ((orig (ly:grob-original grob))
(staff-space (ly:staff-symbol-staff-space grob)) ; for scaling
(layout (ly:grob-layout grob))
(line-th (ly:output-def-lookup layout 'line-thickness))
(siblings (ly:spanner-broken-into orig))
(width (bracket-width grob))
;; We need the blot-diameter so that there is no gap between the
;; horizontal line and the vertical edges of the bracket
(blot (ly:output-def-lookup (ly:grob-layout grob) 'blot-diameter))
(text (ly:grob-property grob 'text))
(text (if (null? text)
text
(markup #:scale (cons staff-space staff-space) text)))
;; if no text is specified, create a dummy stencil.
(text (if (null? text)
point-stencil
(grob-interpret-markup grob text)))
;; center the text on its own extents and those of the bracket
(text (ly:stencil-aligned-to text X CENTER))
(text (ly:stencil-translate-axis text (car width) X))
(text (ly:stencil-translate-axis text (/ (interval-length width) 2) X))
(stil (make-line-stencil line-th
(car width) 0
(cdr width) 0))
;; create the vertical lines for bracket edges
(protrusion (make-line-stencil line-th
0 0
0 (* -1 staff-space))))
;; Add edges and text depending on whether we have a broken bracket.
;; Left edge:
(if (or
(and (>= (length siblings) 2)
(eq? grob (first siblings)))
(< (length siblings) 2))
(set! stil
(ly:stencil-combine-at-edge stil X LEFT protrusion (- blot))))
;; Right edge:
(if (or
(and (>= (length siblings) 2)
(eq? grob (last siblings)))
(< (length siblings) 2))
(set! stil
(ly:stencil-combine-at-edge stil X RIGHT protrusion (- blot))))
;; Text is only added to the first piece of a broken bracket. Possibly
;; the text should be added in parentheses to the pieces (as in a measure
;; count). 0.5 is a hardcoded padding value which controls the separation
;; between the text and the bracket.
(if (or
(and (>= (length siblings) 2) (eq? grob (first siblings)))
(< (length siblings) 2))
(set! stil
(ly:stencil-combine-at-edge stil Y UP text (* 0.5 staff-space))))
stil))
%%%%%%%%%%%%%%%%%%%%%%%%% ADD NEW GROB DEFINITIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define my-grob-descriptions '())
#(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)))
(set-object-property! grob-name 'translation-type? list?)
(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! my-grob-descriptions
(cons (cons grob-name grob-entry)
my-grob-descriptions))))
#(add-grob-definition
'Frame
`((padding . 0.8)
(stencil . ,frame::print)
(thickness . 0.3)
(meta . ((class . Spanner)
(interfaces . (frame-interface
line-interface))))))
#(add-grob-definition
'FrameExtender
`((extender-Y-offset . 0)
(stencil . ,ly:frame-extender::print)
(thickness . 0.3)
(meta . ((class . Spanner)
(interfaces . (frame-extender-interface
line-interface))))))
#(add-grob-definition
'FrameBracket
`((stencil . ,ly:frame-bracket::print)
(side-axis . ,Y)
(Y-offset . ,ly:side-position-interface::y-aligned-side)
(padding . 1)
(direction . ,UP)
(outside-staff-priority . 0)
(outside-staff-padding . 1)
(vertical-skylines . ,ly:grob::vertical-skylines-from-stencil)
(meta . ((class . Spanner)
(interfaces . (frame-bracket-interface
line-interface
side-position-interface))))))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%% FRAME ENGRAVER %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(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)))
frameEngraver =
#(lambda (context)
(let ((frame '()) ; the box enclosing the items to be repeated
(extender '()) ; a horizontal line with arrow
(event-drul (cons '() '())) ; the events which begin and end a frame
(extender-event '()) ; the event which signals END of extender line
(bracket '()) ; a bracket with text (i.e., timing)
;; In order to handle the situation when a FrameBracket begins in the
;; same timestep as another ends (i.e., when the user calls
;; \frameExtenderEnd and \frameStart together), some shuffling of
;; grobs between variables is necessary. We copy the spanner held in
;; 'bracket' to 'finished-bracket' once it has been begun. We will
;; complete it there. This frees 'bracket' to contain the beginnings
;; of another FrameBracket grob.
(finished-bracket '()))
(make-engraver
(listeners
((frame-event engraver event)
(if (= START (ly:event-property event 'span-direction))
(set-car! event-drul event)
(set-cdr! event-drul event)))
((frame-extender-event engraver event)
;; The extender is begun automatically when a frame ends, so we listen
;; only for the extender's termination event.
(if (= STOP (ly:event-property event 'span-direction))
(set! extender-event event))))
(acknowledgers
((note-column-interface engraver grob source-engraver)
(if (ly:spanner? frame)
(begin
(ly:pointer-group-interface::add-grob frame 'frame-elements grob)
;; The box is attached to a note column on left and right sides.
(add-bound-item frame grob)))
(if (ly:spanner? extender)
;; The extender line is attached to a note column on the left.
;; A NonMusicalPaperColumn will be the right bound.
(if (null? (ly:spanner-bound extender LEFT))
(ly:spanner-set-bound! extender LEFT grob)))
(if (ly:spanner? bracket)
(begin
(ly:pointer-group-interface::add-grob bracket 'columns grob)
;; Bracket is attached to a NonMusicalPaperColumn on either side.
(add-bound-item bracket
(ly:context-property context 'currentCommandColumn))))
(if (ly:spanner? finished-bracket)
(begin
(ly:pointer-group-interface::add-grob finished-bracket 'columns grob))))
((script-interface engraver grob source-engraver)
(if (ly:spanner? frame)
(ly:pointer-group-interface::add-grob frame 'frame-elements grob)))
;((text-script-interface engraver grob source-engraver)
;(if (ly:spanner? frame)
; (ly:pointer-group-interface::add-grob frame 'frame-elements grob)))
((inline-accidental-interface engraver grob source-engraver)
;; Frame will be sized to accommodate leading accidental.
(if (ly:spanner? frame)
(ly:pointer-group-interface::add-grob frame 'frame-elements grob))))
((process-music trans)
;; When the user requests a frame (with `FrameStart'), we begin a
;; Frame and a FrameBracket.
;; TODO: for horizontal spacing purposes, a FrameStub (an invisible
;; rectangle) will be created.
(if (ly:stream-event? (car event-drul))
(begin
(set! frame (ly:engraver-make-grob trans 'Frame (car event-drul)))
(set! bracket
(ly:engraver-make-grob trans 'FrameBracket (car event-drul)))
(ly:pointer-group-interface::add-grob
bracket 'bracket-elements frame)
(ly:pointer-group-interface::add-grob
bracket 'side-support-elements frame)
(set-car! event-drul '())))
;; User has requested completion of Frame grob.
(if (ly:stream-event? (cdr event-drul))
;; Error: user has written \frameEnd without \frameStart.
;; Nothing will be drawn.
(if (null? frame)
(ly:programming-error "No start to frame. Nothing drawn.")
;; no error: finish Frame, begin FrameExtender, and add references
;; to the completed Frame in FrameExtender and FrameBracket
(begin
(ly:engraver-announce-end-grob trans frame (cdr event-drul))
(set! extender
(ly:engraver-make-grob
trans 'FrameExtender (cdr event-drul)))
(ly:grob-set-object! extender 'frame frame)
;; Store FrameBracket-in-progress in another variable
;; so that new FrameBracket might be begun at same timestep.
(set! finished-bracket bracket)
(set! bracket '()))))
;; When we hear an extender-event, we finish both FrameExtender and
;; FrameBracket
(if (ly:stream-event? extender-event)
;; If there is an extender to end...
(if (ly:spanner? extender)
(let ((col (ly:context-property context 'currentCommandColumn)))
(ly:spanner-set-bound! extender RIGHT col)
(ly:engraver-announce-end-grob trans extender extender-event)
(ly:spanner-set-bound! finished-bracket RIGHT col)
(ly:grob-set-object! finished-bracket 'extender extender)
(ly:pointer-group-interface::add-grob
finished-bracket 'bracket-elements extender)
(ly:pointer-group-interface::add-grob
finished-bracket 'side-support-elements extender)
(ly:engraver-announce-end-grob
trans finished-bracket extender-event)
(set! extender '())
(set! finished-bracket '())
(set! extender-event '()))
;; There is a request to end a non-existent extender...
(set! extender-event '()))))
((stop-translation-timestep trans)
;; Frame is complete.
(if (ly:stream-event? (cdr event-drul))
(begin
(set! frame '())
(set-cdr! event-drul '()))))
((finalize trans)
;; If there is an incomplete extender at the end of the context, the
;; variable 'extender' won't be empty. Finish the extender and bracket
;; with a warning.
(if (ly:spanner? extender)
(let ((col (ly:context-property context 'currentCommandColumn)))
(ly:warning "You didn't finish final extender. Completing...")
(ly:spanner-set-bound! extender RIGHT col)
(ly:spanner-set-bound! finished-bracket RIGHT col)
(ly:grob-set-object! finished-bracket 'extender extender)
(ly:pointer-group-interface::add-grob
finished-bracket 'bracket-elements extender)
(ly:pointer-group-interface::add-grob
finished-bracket 'side-support-elements extender)
(ly:engraver-announce-end-grob
trans finished-bracket extender-event)
(set! extender '())
(set! extender-event '())
(set! finished-bracket '())))))))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% EVENT FUNCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
frameStart =
#(make-span-event 'FrameEvent START)
frameEnd =
#(make-span-event 'FrameEvent STOP)
frameExtenderEnd =
#(make-span-event 'FrameExtenderEvent STOP)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% EXAMPLE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\new StaffGroup <<
\new Staff
%{
\with {
fontSize = #-3
\override StaffSymbol #'staff-space = #(magstep -3)
}
%}
{
%% increase number of reps here (and below) to see issue with vertical
%% spacing/page breaking
\repeat unfold 4 {
\relative c'' {
%% Commenting the following line demonstrates horizontal spacing issue
%% which will be alleviated by the addition of FrameStub grobs.
\set Timing.defaultBarType = ""
\once \override FrameBracket.text = \markup "10''"
\frameStart
%% Uncomment dynamic: box is sized to accommodate, but dynamic
%% is pushed aside.
g8%\p
[ es' des gis bes,
\frameEnd
e]
s4
s1*4
\frameExtenderEnd
}
}
}
\new Staff {
\relative c'' {
\repeat unfold 4 {
\once \override FrameBracket.text = \markup "6''"
\frameStart
%% scripts are OK
f8%-\accent\mordent\fermata
[ fis, a b d
\frameEnd
\override FrameExtender.thickness = #0.75
c]
s4
s1*2
\frameExtenderEnd
%\once \override FrameBracket.text = \markup "4''"
\once \override FrameBracket.text = \markup \note #"4.." #UP
\frameStart
fis,8[ f' a, b' c,
%% the FrameExtender begins at the end of the Frame, so put \once
%% \override at the same timestep as you use \frameEnd
%\once \override FrameExtender.color = #red
\once \override FrameExtender.extender-Y-offset = #3.5
\frameEnd
d']
s4
s1
\frameExtenderEnd
}
}
}
>>
\layout {
%ragged-right = ##t
\context {
\Global
\grobdescriptions #my-grob-descriptions
#my-event-classes
}
\context {
\Score
\remove "Bar_number_engraver"
proportionalNotationDuration = #(ly:make-moment 1 4)
\override SpacingSpanner #'uniform-stretching = ##t
}
\context {
\Staff
\remove "Time_signature_engraver"
}
\context {
\Voice
%\override Beam.stencil = ##f
%\override Stem.stencil = #point-stencil
\consists \frameEngraver
}
}
\version "2.17.22"
% Uncomment the following line to show the skylines.
%#(ly:set-option 'debug-skylines)
%#(set-global-staff-size 10)
% Note: In order to prevent "bleed-over" from one session to another, it is
% recommended that .ly files using the following functions be processed
% individually (rather than in a batch).
%%%%%%%%%%%%%%%%%%%%%%%%%%% CREATE NEW EVENT CLASSES %%%%%%%%%%%%%%%%%%%%%%%%%%%
% NOTE: The following definitions work as of version 2.17.22. If you are using
% an earlier version, please see
% https://codereview.appspot.com/10965043/diff/8001/input/regression/scheme-text-spanner.ly
% to make necessary changes.
#(define-event-class 'frame-event 'span-event)
#(define-event-class 'frame-extender-event 'span-event)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% MUSIC DESCRIPTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define frame-types
'(
(FrameEvent
. ((description . "Signals where a frame starts and stops.")
(types . (general-music frame-event span-event event))
))
))
#(define frame-extender-types
'(
(FrameExtenderEvent
. ((description . "Signals where a frame extender line stops.")
(types . (general-music frame-extender-event span-event event))
))
))
#(for-each
(lambda (x)
(set! x
(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)))
x))
(set! music-descriptions
(append x music-descriptions)))
(list frame-types frame-extender-types))
#(set! music-descriptions
(sort music-descriptions alist<?))
%%%%%%%%%%%%%%%%%%%%%%%%% ADD NEW GROB INTERFACES %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(ly:add-interface
'frame-interface
"A box for frame notation."
'(frame-elements))
#(ly:add-interface
'frame-extender-interface
"An extender line (with arrow) for frame notation."
'(frame))
#(ly:add-interface
'frame-bracket-interface
"A bracket with text (possibly to indicate duration) for frame notation."
'(bracket-elements columns edge-height
extender no-bracket side-support-elements))
#(ly:add-interface
'frame-stub-interface
"A stub for horizontal spacing of frames."
'(arrowhead elements frame))
%%%%%%%%%%%%%%%%%%%%%%%%% CREATE NEW GROB PROPERTIES %%%%%%%%%%%%%%%%%%%%%%%%%%%
#(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))
`(
(no-arrowhead ,boolean?
"If set, do not draw an arrowhead on a frame extender line.")
(extender-Y-offset ,number?
"Vertical displacement of extender line from center staff line")
(no-bracket ,boolean?
"If set, do not draw bracket in frame notation.")
))
%%%%%%%%%%%%%%%%%%%%%%%% WIDTH/HEIGHT FUNCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Thanks to Mike Solomon for explanations and code.
% The following functions calculate dimensions for those grobs which have
% stencils: Frame, FrameExtender, and FrameBracket. Grobs with stencils
% should not use the 'axis-group-interface for calculating height and width.
% Relevant grobs have been stored in arrays other than 'elements, which
% is the grob-array used by the axis-group-interface for its calculations.
#(define (dim-hack grob ax)
(let* ((frame-elts (ly:grob-object grob 'frame-elements))
(common (ly:grob-common-refpoint-of-array grob frame-elts ax))
(rel (ly:relative-group-extent frame-elts common ax))
(off (ly:grob-relative-coordinate grob common ax)))
;(format #t "rel-~a: ~a off: ~a~%" ax rel off)
(coord-translate rel (- off))))
#(define (height-hack grob)
(dim-hack grob Y))
#(define (width-hack grob)
(dim-hack grob X))
#(define (bracket-width grob)
(let* ((bracket-elts (ly:grob-object grob 'bracket-elements))
(common (ly:grob-common-refpoint-of-array grob bracket-elts X))
(rel (ly:relative-group-extent bracket-elts common X))
(off (ly:grob-relative-coordinate grob common X)))
(coord-translate rel (- off))))
% The FrameStub is a sort of spacer which is added to the left and right
% of Frame grobs.
#(define (frame-stub::width grob)
(let* ((elts (ly:grob-object grob 'elements))
(staff-space (ly:staff-symbol-staff-space grob))
(frame (ly:grob-object grob 'frame))
(box-padding (* (ly:grob-property frame 'padding) staff-space))
(frame-th (* (ly:grob-property frame 'thickness) staff-space))
(direction (ly:grob-property grob 'direction))
(extra-space (* 0.5 staff-space))
(axis-group-width (ly:axis-group-interface::width grob)))
(if (eq? direction LEFT)
(cons (- (car axis-group-width) frame-th box-padding extra-space)
(car axis-group-width))
(cons (cdr axis-group-width)
(+ (cdr axis-group-width) box-padding frame-th extra-space)))))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% PRINT FUNCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define (frame::print grob)
"Draw a box around a group of notes for use in frame notation."
(let* ((staff-space (ly:staff-symbol-staff-space grob)) ; for scaling
(box-padding (* (ly:grob-property grob 'padding) staff-space))
(height (height-hack grob))
; cannot use axis-group-interface, as there are no elements
(width (width-hack grob))
(th (* (ly:grob-property grob 'thickness) staff-space))
(stencil (ly:make-stencil '() width height))
(stencil (box-stencil stencil th box-padding)))
stencil))
#(define (ly:frame-extender::print grob)
"Draw an extender line with optional arrow for use in frame notation."
(let* ((refp (ly:grob-system grob))
(staff-space (ly:staff-symbol-staff-space grob)) ; for scaling
(line-th (layout-line-thickness grob)) ; scaled for uniform thickness
;; NOTE: The frame grob is only available to the portion of a broken
;; extender which is on the same line. The following lookup will
;; return '() for siblings. It would be nice to have the option
;; to center the extender vertically on the frame, and have the
;; siblings at the same height. How can this be done automatically
;; without the frame being "remembered"?
(frame (ly:grob-object grob 'frame))
(frame-ext
(if (ly:grob? frame)
(ly:grob-extent frame refp X)
(cons 0.0 0.0)))
(frame-th
(if (ly:grob? frame)
(* (ly:grob-property frame 'thickness) staff-space)
0.0))
(left-bound (ly:spanner-bound grob LEFT))
(left-bound-coord (ly:grob-relative-coordinate left-bound refp X))
(left-bound-ext (ly:grob-extent left-bound left-bound X))
;; Calculate an offset so that extender segment begins within the
;; right side of the frame, or clears prefatory material if a
;; broken piece.
(start
(if (ly:grob? frame)
(- (cdr frame-ext) left-bound-coord (* 0.5 frame-th))
(+ (cdr left-bound-ext) (* 1.0 staff-space))))
(right-bound (ly:spanner-bound grob RIGHT))
(right-bound-coord (ly:grob-relative-coordinate right-bound refp X))
(right-bound-ext (ly:grob-extent right-bound right-bound X))
(right-offset
(if (interval-empty? right-bound-ext)
0.0
(interval-length right-bound-ext)))
;; Ensure that there is some space after end of extender line.
(right-offset (+ right-offset (* 0.5 staff-space)))
(end (- right-bound-coord left-bound-coord right-offset))
;; By default, the line will be drawn at the center line of the staff.
(extender-dy (* (ly:grob-property grob 'extender-Y-offset) staff-space))
(extender-th (* (ly:grob-property grob 'thickness) staff-space))
(half-extender-th (/ extender-th 2.0))
;; Line is drawn as filled box because there is no rounding
;; of corners. Rounded corners make alignment with frame
;; problematic. For this reason, the public function
;; `arrow-stencil-maker' from `stencil.scm' has not been used.
(extender
(markup
#:override '(filled . #t)
#:path
line-th
;; Do not draw arrowhead if extender line isn't longer
;; than the arrowhead, or per user request
(if (or
(<= (- end start) (+ (* 3.5 extender-th) frame-th))
(ly:grob-property grob 'no-arrowhead))
`((moveto ,start ,(+ extender-dy half-extender-th))
(lineto ,end
,(+ extender-dy half-extender-th))
(lineto ,end
,(- extender-dy half-extender-th))
(lineto ,start ,(- extender-dy half-extender-th))
(closepath))
`(; line with arrowhead
(moveto ,start ,(+ extender-dy half-extender-th))
(lineto ,(- end (* 3 extender-th) half-extender-th)
,(+ extender-dy half-extender-th))
(lineto ,(- end (* 3 extender-th) half-extender-th)
,(- extender-dy half-extender-th))
(lineto ,start ,(- extender-dy half-extender-th))
(closepath)
; the arrowhead
(moveto ,end ,extender-dy)
(curveto
,end
,extender-dy
,(- end (* 1.5 extender-th) (/ half-extender-th 2))
,extender-dy
,(- end (* 3 extender-th) half-extender-th)
,(+ extender-dy (* 1.5 extender-th)))
(lineto ,(- end (* 3 extender-th) half-extender-th)
,(- extender-dy (* 1.5 extender-th)))
(curveto
,(- end (* 3 extender-th) half-extender-th)
,(- extender-dy (* 1.5 extender-th))
,(- end (* 1.5 extender-th) (/ half-extender-th 2))
,extender-dy
,end
,extender-dy)
(closepath)))))
(extender (grob-interpret-markup grob extender)))
extender))
#(define (ly:frame-bracket::print grob)
"Draw a bracket for use in frame notation."
(let* ((orig (ly:grob-original grob))
(staff-space (ly:staff-symbol-staff-space grob)) ; for scaling
(line-th (layout-line-thickness grob))
(siblings (ly:spanner-broken-into orig))
(width (bracket-width grob))
;; We need the blot-diameter so that there is no gap between the
;; horizontal line and the vertical edges of the bracket
(layout (ly:grob-layout grob))
(blot (ly:output-def-lookup layout 'blot-diameter))
(text (ly:grob-property grob 'text))
;; if no text is specified, create a dummy stencil.
(text (if (null? text)
point-stencil
(markup #:scale (cons staff-space staff-space) text)))
(text (grob-interpret-markup grob text))
;; center the text on its own extents and those of the bracket
(text (ly:stencil-aligned-to text X CENTER))
(text (ly:stencil-translate-axis text (car width) X))
(text (ly:stencil-translate-axis text (/ (interval-length width) 2) X))
(stil (make-line-stencil line-th
(car width) 0
(cdr width) 0))
(dir (ly:grob-property grob 'direction))
;; create the vertical lines for bracket edges
(edge-height (* 1.0 staff-space))
(protrusion (make-line-stencil line-th
0 0
0 (* edge-height (- dir)))))
;; Add edges and text depending on whether we have a broken bracket.
;; Left edge:
(if (or
(and (>= (length siblings) 2)
(eq? grob (first siblings)))
(< (length siblings) 2))
(set! stil
(ly:stencil-combine-at-edge stil X LEFT protrusion (- blot))))
;; Right edge:
(if (or
(and (>= (length siblings) 2)
(eq? grob (last siblings)))
(< (length siblings) 2))
(set! stil
(ly:stencil-combine-at-edge stil X RIGHT protrusion (- blot))))
;; Text is only added to the first piece of a broken bracket. Possibly
;; the text should be added in parentheses to the pieces (as in a measure
;; count). 0.5 is a hardcoded padding value which controls the separation
;; between the text and the bracket.
(if (or
(and (>= (length siblings) 2) (eq? grob (first siblings)))
(< (length siblings) 2))
(set! stil
(ly:stencil-combine-at-edge stil Y dir text (* 0.5 staff-space))))
stil))
%%%%%%%%%%%%%%%%%%%%%%%%% PURE HEIGHT ESTIMATION %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% A pure height function is necessary so that the FrameBracket is taken into
% account in page-breaking decisions. Without this function, the spacing engine
% will fit too many systems on the page. The result is that an error will be
% returned and the music will be compressed (regardless of collisions).
#(define (frame-bracket-interface::pure-height grob start end)
(let* ((text (ly:grob-property grob 'text))
(staff-space (ly:staff-symbol-staff-space grob))
(padding (* (ly:grob-property grob 'padding) staff-space))
(text-padding (* 0.5 staff-space)) ; distance between bracket and text
;; height of bracket "wings"
(edge-height (* 1.0 staff-space))
(text-stil (grob-interpret-markup grob (markup text)))
(text-stil-ext (ly:stencil-extent text-stil Y)))
(cons (- (+ edge-height padding))
(+ text-padding (interval-length text-stil-ext)))))
%%%%%%%%%%%%%%%%%%%%%%%%% ADD NEW GROB DEFINITIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(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)))
(set-object-property! grob-name 'translation-type? list?)
(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))))
#(add-grob-definition
'Frame
`((padding . 0.8)
(stencil . ,frame::print)
(thickness . 0.3)
(meta . ((class . Spanner)
(interfaces . (frame-interface
line-interface))))))
#(add-grob-definition
'FrameExtender
`((no-arrowhead . #f)
(extender-Y-offset . 0.0)
(stencil . ,ly:frame-extender::print)
(thickness . 0.3)
(meta . ((class . Spanner)
(interfaces . (frame-extender-interface
line-interface))))))
#(add-grob-definition
'FrameBracket
`((direction . ,UP)
(no-bracket . #f)
(outside-staff-padding . 1.0)
(outside-staff-priority . 0)
(padding . 1.0)
(side-axis . ,Y)
(stencil . ,ly:frame-bracket::print)
(vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
(Y-extent . ,(grob::unpure-Y-extent-from-stencil frame-bracket-interface::pure-height))
(Y-offset . ,ly:side-position-interface::y-aligned-side)
(meta . ((class . Spanner)
(interfaces . (frame-bracket-interface
line-interface
side-position-interface))))))
#(add-grob-definition
'FrameStub
`((X-extent . ,frame-stub::width)
(Y-extent . ,axis-group-interface::height)
(meta . ((class . Item)
(object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
(pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
(interfaces . ())))))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%% FRAME ENGRAVER %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define (add-bound-item spanner item)
"Set left and right bounds of a spanner"
(if (null? (ly:spanner-bound spanner LEFT))
(ly:spanner-set-bound! spanner LEFT item)
(ly:spanner-set-bound! spanner RIGHT item)))
frameEngraver =
#(lambda (context)
(let ((frame '()) ; the box enclosing the items to be repeated
(extender '()) ; a horizontal line with arrow
(frame-start '()) ; the event which signals the beginning of a frame
(frame-stop '()) ; signals the end of a frame
(extender-stop '()) ; the event which signals end of extender line
(bracket '()) ; a bracket with text (i.e., timing)
;; In order to handle the situation when a FrameBracket begins in the
;; same timestep as another ends (i.e., when the user calls
;; \frameExtenderEnd and \frameStart together), some shuffling of
;; grobs between variables is necessary. We copy the spanner held in
;; 'bracket' to 'finished-bracket' once it has been begun. We will
;; complete it there. This frees 'bracket' to contain the beginnings
;; of another FrameBracket grob.
(finished-bracket '())
;; A spacer for the left and right sides of the Frame grob. This is
;; necessary to prevent collisions between the Frame and grobs which
;; precede and follow it, such as barlines.
(frame-stub '()))
(make-engraver
(listeners
((frame-event engraver event)
(if (= START (ly:event-property event 'span-direction))
(set! frame-start event)
(set! frame-stop event)))
((frame-extender-event engraver event)
;; The extender is begun automatically when a frame ends, so we listen
;; only for the extender's termination event.
(if (= STOP (ly:event-property event 'span-direction))
(set! extender-stop event))))
(acknowledgers
((note-column-interface engraver grob source-engraver)
(if (ly:spanner? frame)
(begin
(ly:pointer-group-interface::add-grob frame 'frame-elements grob)
;; The box is attached to a note column on left and right sides.
(add-bound-item frame grob)))
(if (ly:spanner? extender)
;; The extender line is attached to a note column on the left.
;; A NonMusicalPaperColumn will be the right bound.
(if (null? (ly:spanner-bound extender LEFT))
(ly:spanner-set-bound! extender LEFT grob)))
(if (ly:spanner? bracket)
(begin
(ly:pointer-group-interface::add-grob bracket 'columns grob)
;; Bracket is attached to a NonMusicalPaperColumn on either side.
(add-bound-item bracket
(ly:context-property context 'currentCommandColumn))))
(if (ly:spanner? finished-bracket)
(begin
(ly:pointer-group-interface::add-grob finished-bracket 'columns grob)))
(if (ly:item? frame-stub)
(ly:pointer-group-interface::add-grob frame-stub 'elements grob)))
((script-interface engraver grob source-engraver)
(if (ly:spanner? frame)
(ly:pointer-group-interface::add-grob frame 'frame-elements grob))
(if (ly:item? frame-stub)
(ly:pointer-group-interface::add-grob frame-stub 'elements grob)))
;((text-script-interface engraver grob source-engraver)
;(if (ly:spanner? frame)
;(ly:pointer-group-interface::add-grob frame 'frame-elements grob)))
((inline-accidental-interface engraver grob source-engraver)
;; Frame will be sized to accommodate leading accidental.
(if (ly:spanner? frame)
(ly:pointer-group-interface::add-grob frame 'frame-elements grob))
(if (ly:item? frame-stub)
(ly:pointer-group-interface::add-grob frame-stub 'elements grob))))
((process-music trans)
;; When the user requests a frame (with \frameStart), we begin a
;; Frame and a FrameBracket. A FrameStub is created for the left
;; side of the Frame.
(if (ly:stream-event? frame-start)
(begin
(set! frame (ly:engraver-make-grob trans 'Frame frame-start))
(set! bracket
(ly:engraver-make-grob trans 'FrameBracket frame-start))
(ly:pointer-group-interface::add-grob
bracket 'bracket-elements frame)
(ly:pointer-group-interface::add-grob
bracket 'side-support-elements frame)
(set! frame-stub
(ly:engraver-make-grob trans 'FrameStub frame-start))
(ly:grob-set-object! frame-stub 'frame frame)
(ly:grob-set-property! frame-stub 'direction LEFT)
(set! frame-start '())))
;; User has requested completion of Frame grob.
(if (ly:stream-event? frame-stop)
;; Error: user has written \frameEnd without \frameStart.
;; Nothing will be drawn.
(if (null? frame)
(ly:programming-error "No start to frame. Nothing drawn.")
;; no error: finish Frame, begin FrameExtender, and add references
;; to the completed Frame in FrameExtender and FrameBracket.
;; Create FrameStub for right side of Frame.
(begin
(ly:engraver-announce-end-grob trans frame frame-stop)
(set! extender
(ly:engraver-make-grob
trans 'FrameExtender frame-stop))
(ly:grob-set-object! extender 'frame frame)
(set! frame-stub
(ly:engraver-make-grob trans 'FrameStub frame-stop))
(ly:grob-set-object! frame-stub 'frame frame)
(ly:grob-set-property! frame-stub 'direction RIGHT)
;; Store FrameBracket-in-progress in another variable
;; so that new FrameBracket might be begun at same timestep.
(set! finished-bracket bracket)
(set! bracket '()))))
;; When we hear an extender-event, we finish both FrameExtender and
;; FrameBracket
(if (ly:stream-event? extender-stop)
;; If there is an extender to end...
(if (ly:spanner? extender)
(let ((col (ly:context-property context 'currentCommandColumn)))
(ly:spanner-set-bound! extender RIGHT col)
(ly:engraver-announce-end-grob trans extender extender-stop)
(ly:spanner-set-bound! finished-bracket RIGHT col)
(ly:grob-set-object! finished-bracket 'extender extender)
(ly:pointer-group-interface::add-grob
finished-bracket 'bracket-elements extender)
(ly:pointer-group-interface::add-grob
finished-bracket 'side-support-elements extender)
(ly:engraver-announce-end-grob
trans finished-bracket extender-stop)
(if (ly:grob-property finished-bracket 'no-bracket)
(ly:grob-suicide! finished-bracket))
(set! extender '())
(set! finished-bracket '())
(set! extender-stop '()))
;; There is a request to end a non-existent extender...
(set! extender-stop '()))))
((stop-translation-timestep trans)
(set! frame-stub '())
;; Frame is complete.
(if (ly:stream-event? frame-stop)
(begin
(set! frame '())
(set! frame-stop '()))))
((finalize trans)
;; If there is an incomplete extender at the end of the context, the
;; variable 'extender' won't be empty. Finish the extender and bracket
;; with a warning.
(if (ly:spanner? extender)
(let ((col (ly:context-property context 'currentCommandColumn)))
(ly:warning "You didn't finish final extender. Completing...")
(ly:spanner-set-bound! extender RIGHT col)
(ly:spanner-set-bound! finished-bracket RIGHT col)
(ly:grob-set-object! finished-bracket 'extender extender)
(ly:pointer-group-interface::add-grob
finished-bracket 'bracket-elements extender)
(ly:pointer-group-interface::add-grob
finished-bracket 'side-support-elements extender)
(ly:engraver-announce-end-grob
trans finished-bracket extender-stop)
(if (ly:grob-property finished-bracket 'no-bracket)
(ly:grob-suicide! finished-bracket))
(set! extender '())
(set! extender-stop '())
(set! finished-bracket '())))))))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% EVENT FUNCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
frameStart =
#(make-span-event 'FrameEvent START)
frameEnd =
#(make-span-event 'FrameEvent STOP)
% There is no `frameExtenderStart' because extender is begun with \frameEnd
frameExtenderEnd =
#(make-span-event 'FrameExtenderEvent STOP)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% EXAMPLE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\new StaffGroup <<
\new Staff
%{
\with {
fontSize = #-3
\override StaffSymbol #'staff-space = #(magstep -3)
}
%}
{
\repeat unfold 14 {
\relative c'' {
%\override FrameBracket.no-bracket = ##t
\set Timing.defaultBarType = ""
\once \override FrameBracket.text = \markup "10''"
\frameStart
%% Uncomment dynamic: box is sized to accommodate, but dynamic
%% is pushed aside. The following two overrides are a workaround.
%\once \override DynamicLineSpanner.outside-staff-priority = ##f
%\once \override DynamicLineSpanner.Y-offset = #-6
g8%\p
[ es' des gis bes,
\frameEnd
e]
s4
s1*4
\frameExtenderEnd
}
}
}
\new Staff {
\relative c'' {
\repeat unfold 14 {
%\override FrameBracket.direction = #DOWN
\override FrameExtender.thickness = #0.75
%\override FrameExtender.no-arrowhead = ##t
\once \override FrameBracket.text = \markup ""
\frameStart
%% scripts are OK
f8%-\accent\mordent\fermata
[ fis, a b d
\frameEnd
c]
s4
s1*2
\frameExtenderEnd
%\once \override FrameBracket.text = \markup "4''"
\once \override FrameBracket.text = \markup { \note #"4.." #UP }
\frameStart
fis,8[ f' a, b' c,
%% the FrameExtender begins at the end of the Frame, so put \once
%% \override at the same timestep as you use \frameEnd
%\once \override FrameExtender.color = #red
\once \override FrameExtender.extender-Y-offset = #3.5
\frameEnd
d']
s4
s1
\frameExtenderEnd
}
}
}
>>
\layout {
%ragged-right = ##t
\context {
\Global
\grobdescriptions #all-grob-descriptions
}
\context {
\Score
\remove "Bar_number_engraver"
proportionalNotationDuration = #(ly:make-moment 1 4)
\override SpacingSpanner #'uniform-stretching = ##t
}
\context {
\Staff
\remove "Time_signature_engraver"
}
\context {
\Voice
%\override Beam.stencil = ##f
%\override Stem.stencil = #point-stencil
\consists \frameEngraver
}
}
%\version "2.17.23"
% Uncomment the following line to show the skylines.
%#(ly:set-option 'debug-skylines)
%#(set-global-staff-size 10)
% Note: In order to prevent "bleed-over" from one session to another, it is
% recommended that .ly files using the following functions be processed
% individually (rather than in a batch).
%%%%%%%%%%%%%%%%%%%%%%%%%%% CREATE NEW EVENT CLASSES %%%%%%%%%%%%%%%%%%%%%%%%%%%
% NOTE: The following definitions work as of version 2.17.22. If you are using
% an earlier version, please see
%
https://codereview.appspot.com/10965043/diff/8001/input/regression/scheme-text-spanner.ly
% to make necessary changes.
#(define-event-class 'frame-event 'span-event)
#(define-event-class 'frame-extender-event 'span-event)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% MUSIC DESCRIPTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define frame-types
'(
(FrameEvent
. ((description . "Signals where a frame starts and stops.")
(types . (general-music frame-event span-event event))
))
))
#(define frame-extender-types
'(
(FrameExtenderEvent
. ((description . "Signals where a frame extender line stops.")
(types . (general-music frame-extender-event span-event event))
))
))
#(for-each
(lambda (x)
(set! x
(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)))
x))
(set! music-descriptions
(append x music-descriptions)))
(list frame-types frame-extender-types))
#(set! music-descriptions
(sort music-descriptions alist<?))
%%%%%%%%%%%%%%%%%%%%%%%%% ADD NEW GROB INTERFACES %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(ly:add-interface
'frame-interface
"A box for frame notation."
'(frame-elements))
#(ly:add-interface
'frame-extender-interface
"An extender line (with arrow) for frame notation."
'(frame))
#(ly:add-interface
'frame-bracket-interface
"A bracket with text (possibly to indicate duration) for frame notation."
'(bracket-elements columns edge-height
extender no-bracket side-support-elements))
#(ly:add-interface
'frame-stub-interface
"A stub for horizontal spacing of frames."
'(no-arrowhead elements frame))
%%%%%%%%%%%%%%%%%%%%%%%%% CREATE NEW GROB PROPERTIES %%%%%%%%%%%%%%%%%%%%%%%%%%%
#(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))
`(
(extender-Y-offset ,number?
"Vertical displacement of extender line from center staff line")
(no-arrowhead ,boolean?
"If #t, do not draw an arrowhead on a frame extender line. Default is
#f.")
(no-bracket ,boolean?
"If #t, do not draw bracket in frame notation. Default is #f.")
(repeat-barlines ,boolean?
"If #t, use repeat barlines in frame notation. Otherwise, use boxes.")
))
%%%%%%%%%%%%%%%%%%%%%%%% WIDTH/HEIGHT FUNCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Thanks to Mike Solomon for explanations and code.
% The following functions calculate dimensions for those grobs which have
% stencils: Frame, FrameExtender, and FrameBracket. Grobs with stencils
% should not use the 'axis-group-interface for calculating height and width.
% Relevant grobs have been stored in arrays other than 'elements, which
% is the grob-array used by the axis-group-interface for its calculations.
#(define (dim-hack grob ax)
(let* ((frame-elts (ly:grob-object grob 'frame-elements))
(common (ly:grob-common-refpoint-of-array grob frame-elts ax))
(rel (ly:relative-group-extent frame-elts common ax))
(off (ly:grob-relative-coordinate grob common ax)))
;(format #t "rel-~a: ~a off: ~a~%" ax rel off)
(coord-translate rel (- off))))
#(define (height-hack grob)
(dim-hack grob Y))
#(define (width-hack grob)
(dim-hack grob X))
#(define (bracket-width grob)
(let* ((bracket-elts (ly:grob-object grob 'bracket-elements))
(common (ly:grob-common-refpoint-of-array grob bracket-elts X))
(rel (ly:relative-group-extent bracket-elts common X))
(off (ly:grob-relative-coordinate grob common X)))
(coord-translate rel (- off))))
% The FrameStub is a sort of spacer which is added to the left and right
% of Frame grobs.
#(define (frame-stub::width grob)
"Select the appropriate callback for FrameStub.X-extent depending on whether
frame notation uses repeat barlines or boxes."
(let* ((frame (ly:grob-object grob 'frame))
(repeat-barlines? (ly:grob-property frame 'repeat-barlines)))
(if (not repeat-barlines?)
(frame-stub::width-with-box grob)
(frame-stub::width-with-repeat-barlines grob))))
#(define (frame-stub::width-with-box grob)
(let* ((elts (ly:grob-object grob 'elements))
(staff-space (ly:staff-symbol-staff-space grob))
(frame (ly:grob-object grob 'frame))
(box-padding (* (ly:grob-property frame 'padding) staff-space))
(frame-th (* (ly:grob-property frame 'thickness) staff-space))
(direction (ly:grob-property grob 'direction))
(extra-space (* 0.5 staff-space))
(axis-group-width (ly:axis-group-interface::width grob)))
(if (eq? direction LEFT)
(cons (- (car axis-group-width) frame-th box-padding extra-space)
(car axis-group-width))
(cons (cdr axis-group-width)
(+ (cdr axis-group-width) box-padding frame-th extra-space)))))
% The following is selected if you are using repeat-bars-with-extender
% notation.
#(define (frame-stub::width-with-repeat-barlines grob)
(let* ((elts (ly:grob-object grob 'elements))
(axis-group-width (ly:axis-group-interface::width grob))
(staff-space (ly:staff-symbol-staff-space grob))
;; The stencil extent of the repeat barline must be calculated here.
;; While the frame is accessible, attempting to get relevant
imformation
;; about its extents has disastrous results.
(line-thickness (ly:staff-symbol-line-thickness grob))
(thick-bar (* 6.0 line-thickness))
(thin-bar (* 1.9 line-thickness))
(kern (* 3.0 line-thickness))
(dot-radius (/ staff-space 5.0))
(bar-extent (+ thick-bar kern thin-bar kern (* dot-radius 2.0)))
(direction (ly:grob-property grob 'direction))
(frame (ly:grob-object grob 'frame))
(box-padding (* (ly:grob-property frame 'padding) staff-space)))
(if (eq? direction LEFT)
(cons (- (car axis-group-width) bar-extent box-padding)
(car axis-group-width))
(cons (cdr axis-group-width)
(+ (cdr axis-group-width) bar-extent box-padding)))))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% PRINT FUNCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define (frame::print grob)
"Select the appropriate print function for frame notation. Stencil options are
a box or repeat barlines encompassing the contents."
(if (not (ly:grob-property grob 'repeat-barlines))
(frame::print-with-box grob)
(frame::print-with-repeat-barlines grob)))
#(define (frame::print-with-box grob)
"Draw a box around a group of notes. For use in frame notation."
(let* ((staff-space (ly:staff-symbol-staff-space grob)) ; for scaling
(box-padding (* (ly:grob-property grob 'padding) staff-space))
; cannot use axis-group-interface, as there are no elements
(height (height-hack grob))
(width (width-hack grob))
(th (* (ly:grob-property grob 'thickness) staff-space))
(stencil (ly:make-stencil '() width height))
(stencil (box-stencil stencil th box-padding)))
stencil))
% adapted from scm\bar-line.scm
#(define (make-thin-barline grob extent)
"Draw a simple barline. The width is constant."
(let* ((line-thickness (layout-line-thickness grob))
(thickness (* 1.9 line-thickness)))
(ly:round-filled-box (cons 0.0 thickness)
extent
0.0)))
#(define (make-thick-barline grob extent)
"Draw a thick barline. The width is constant."
(let* ((line-thickness (layout-line-thickness grob))
(thickness (* 6.0 line-thickness)))
(ly:round-filled-box (cons 0.0 thickness)
extent
0.0)))
#(define (make-colon-barline grob extent)
"Draw repeat dots. Scaled to match staff size."
(let* ((staff-space (ly:staff-symbol-staff-space grob))
(line-thickness (ly:staff-symbol-line-thickness grob))
(dot-radius (/ staff-space 5))
(dot (make-circle-stencil dot-radius 0.0 #t)))
(ly:stencil-add
(ly:stencil-combine-at-edge point-stencil
Y UP dot (* 0.25 staff-space))
(ly:stencil-combine-at-edge point-stencil
Y DOWN dot (* 0.25 staff-space)))))
#(define (frame::print-with-repeat-barlines grob)
"Draw repeat barlines encompassing a group of notes. For use in frame
notation."
(let* ((staff-space (ly:staff-symbol-staff-space grob)) ; for scaling
(box-padding (* (ly:grob-property grob 'padding) staff-space))
(staff-radius (* (ly:staff-symbol-staff-radius grob) staff-space))
(height (cons (- staff-radius) staff-radius))
(width (width-hack grob))
;; value is scaled to reflect constant line thickness
(line-thickness (layout-line-thickness grob))
;; kern, thick-bar, and thin-bar have widths independent of staff size
(kern (* 3.0 line-thickness))
(thick-bar (make-thick-barline grob height))
(thin-bar (make-thin-barline grob height))
(colon-bar (make-colon-barline grob height))
(left-bar
(ly:stencil-combine-at-edge
(ly:stencil-combine-at-edge thick-bar X RIGHT thin-bar kern)
X RIGHT colon-bar kern))
(left-bar-ext (ly:stencil-extent left-bar X))
(right-bar
(ly:stencil-combine-at-edge
(ly:stencil-combine-at-edge colon-bar X RIGHT thin-bar kern)
X RIGHT thick-bar kern))
(right-bar-ext (ly:stencil-extent right-bar X))
(stencil
(ly:stencil-add
(ly:stencil-translate-axis
left-bar
(- (car width) (interval-length left-bar-ext) box-padding)
X)
(ly:stencil-translate-axis
right-bar
(+ (cdr width) box-padding)
X))))
stencil))
#(define (ly:frame-extender::print grob)
"Draw an extender line with optional arrow for use in frame notation."
(let* ((refp (ly:grob-system grob))
(staff-space (ly:staff-symbol-staff-space grob)) ; for scaling
(line-th (layout-line-thickness grob)) ; scaled for uniform thickness
;; NOTE: The frame grob is only available to the portion of a broken
;; extender which is on the same line. The following lookup will
;; return '() for siblings. It would be nice to have the option
;; to center the extender vertically on the frame, and have the
;; siblings at the same height. How can this be done automatically
;; without the frame being "remembered"?
(frame (ly:grob-object grob 'frame))
(frame-ext
(if (ly:grob? frame)
(ly:grob-extent frame refp X)
(cons 0.0 0.0)))
(frame-th
(if (ly:grob? frame)
(* (ly:grob-property frame 'thickness) staff-space)
0.0))
(left-bound (ly:spanner-bound grob LEFT))
(left-bound-coord (ly:grob-relative-coordinate left-bound refp X))
(left-bound-ext (ly:grob-extent left-bound left-bound X))
;; Calculate an offset so that extender segment begins within the
;; right side of the frame, or clears prefatory material if a
;; broken piece.
(start
(if (ly:grob? frame)
(- (cdr frame-ext) left-bound-coord (* 0.5 frame-th))
(+ (cdr left-bound-ext) (* 1.0 staff-space))))
(right-bound (ly:spanner-bound grob RIGHT))
(right-bound-coord (ly:grob-relative-coordinate right-bound refp X))
(right-bound-ext (ly:grob-extent right-bound right-bound X))
(right-offset
(if (interval-empty? right-bound-ext)
0.0
(interval-length right-bound-ext)))
;; Ensure that there is some space after end of extender line.
(right-offset (+ right-offset (* 0.5 staff-space)))
(end (- right-bound-coord left-bound-coord right-offset))
;; By default, the line will be drawn at the center line of the staff.
(extender-dy (* (ly:grob-property grob 'extender-Y-offset)
staff-space))
(extender-th (* (ly:grob-property grob 'thickness) staff-space))
(half-extender-th (/ extender-th 2.0))
;; Line is drawn as filled box because there is no rounding
;; of corners. Rounded corners make alignment with frame
;; problematic. For this reason, the public function
;; `arrow-stencil-maker' from `stencil.scm' has not been used.
(extender
(markup
#:override '(filled . #t)
#:path
line-th
;; Do not draw arrowhead if extender line isn't longer
;; than the arrowhead, or per user request
(if (or
(<= (- end start) (+ (* 3.5 extender-th) frame-th))
(ly:grob-property grob 'no-arrowhead))
`((moveto ,start ,(+ extender-dy half-extender-th))
(lineto ,end
,(+ extender-dy half-extender-th))
(lineto ,end
,(- extender-dy half-extender-th))
(lineto ,start ,(- extender-dy half-extender-th))
(closepath))
`(; line with arrowhead
(moveto ,start ,(+ extender-dy half-extender-th))
(lineto ,(- end (* 3 extender-th) half-extender-th)
,(+ extender-dy half-extender-th))
(lineto ,(- end (* 3 extender-th) half-extender-th)
,(- extender-dy half-extender-th))
(lineto ,start ,(- extender-dy half-extender-th))
(closepath)
; the arrowhead
(moveto ,end ,extender-dy)
(curveto
,end
,extender-dy
,(- end (* 1.5 extender-th) (/ half-extender-th 2))
,extender-dy
,(- end (* 3 extender-th) half-extender-th)
,(+ extender-dy (* 1.5 extender-th)))
(lineto ,(- end (* 3 extender-th) half-extender-th)
,(- extender-dy (* 1.5 extender-th)))
(curveto
,(- end (* 3 extender-th) half-extender-th)
,(- extender-dy (* 1.5 extender-th))
,(- end (* 1.5 extender-th) (/ half-extender-th 2))
,extender-dy
,end
,extender-dy)
(closepath)))))
(extender (grob-interpret-markup grob extender)))
extender))
#(define (ly:frame-bracket::print grob)
"Draw a bracket for use in frame notation."
(let* ((orig (ly:grob-original grob))
(staff-space (ly:staff-symbol-staff-space grob)) ; for scaling
(line-th (layout-line-thickness grob))
(siblings (ly:spanner-broken-into orig))
(width (bracket-width grob))
;; We need the blot-diameter so that there is no gap between the
;; horizontal line and the vertical edges of the bracket
(layout (ly:grob-layout grob))
(blot (ly:output-def-lookup layout 'blot-diameter))
(text (ly:grob-property grob 'text))
;; if no text is specified, create a dummy stencil.
(text (if (null? text)
(markup #:null)
(markup #:scale (cons staff-space staff-space) text)))
(text (grob-interpret-markup grob text))
;; center the text on its own extents and those of the bracket
(text (ly:stencil-aligned-to text X CENTER))
(text (ly:stencil-translate-axis text (car width) X))
(text (ly:stencil-translate-axis text (/ (interval-length width) 2) X))
(stil (make-line-stencil line-th
(car width) 0
(cdr width) 0))
(dir (ly:grob-property grob 'direction))
;; create the vertical lines for bracket edges
(edge-height (* 1.0 staff-space))
(protrusion (make-line-stencil line-th
0 0
0 (* edge-height (- dir)))))
;; Add edges and text depending on whether we have a broken bracket.
;; Left edge:
(if (or
(and (>= (length siblings) 2)
(eq? grob (first siblings)))
(< (length siblings) 2))
(set! stil
(ly:stencil-combine-at-edge stil X LEFT protrusion (- blot))))
;; Right edge:
(if (or
(and (>= (length siblings) 2)
(eq? grob (last siblings)))
(< (length siblings) 2))
(set! stil
(ly:stencil-combine-at-edge stil X RIGHT protrusion (- blot))))
;; Text is only added to the first piece of a broken bracket. Possibly
;; the text should be added in parentheses to the pieces (as in a measure
;; count). 0.5 is a hardcoded padding value which controls the separation
;; between the text and the bracket.
(if (or
(and (>= (length siblings) 2) (eq? grob (first siblings)))
(< (length siblings) 2))
(set! stil
(ly:stencil-combine-at-edge stil Y dir text (* 0.5 staff-space))))
stil))
%%%%%%%%%%%%%%%%%%%%%%%%% PURE HEIGHT ESTIMATION %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% A pure height function is necessary so that the FrameBracket is taken into
% account in page-breaking decisions. Without this function, the spacing engine
% will fit too many systems on the page. The result is that an error will be
% returned and the music will be compressed (regardless of collisions).
#(define (frame-bracket-interface::pure-height grob start end)
(let* ((text (ly:grob-property grob 'text (markup #:null)))
(staff-space (ly:staff-symbol-staff-space grob))
(padding (* (ly:grob-property grob 'padding) staff-space))
(text-padding (* 0.5 staff-space)) ; distance between bracket and text
;; height of bracket "wings"
(edge-height (* 1.0 staff-space))
(text-stil (grob-interpret-markup grob (markup text)))
(text-stil-ext (ly:stencil-extent text-stil Y)))
(cons (- (+ edge-height padding))
(+ text-padding (interval-length text-stil-ext)))))
%%%%%%%%%%%%%%%%%%%%%%%%% ADD NEW GROB DEFINITIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(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)))
(set-object-property! grob-name 'translation-type? list?)
(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))))
#(add-grob-definition
'Frame
`((padding . 0.8)
(stencil . ,frame::print)
(thickness . 0.3)
(repeat-barlines . #f)
(meta . ((class . Spanner)
(interfaces . (frame-interface
line-interface))))))
#(add-grob-definition
'FrameExtender
`((extender-Y-offset . 0.0)
(no-arrowhead . #f)
(stencil . ,ly:frame-extender::print)
(thickness . 0.3)
(meta . ((class . Spanner)
(interfaces . (frame-extender-interface
line-interface))))))
#(add-grob-definition
'FrameBracket
`((direction . ,UP)
(no-bracket . #f)
(outside-staff-padding . 1.0)
(outside-staff-priority . 0)
(padding . 1.0)
(side-axis . ,Y)
(stencil . ,ly:frame-bracket::print)
(vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
(Y-extent . ,(grob::unpure-Y-extent-from-stencil
frame-bracket-interface::pure-height))
(Y-offset . ,ly:side-position-interface::y-aligned-side)
(meta . ((class . Spanner)
(interfaces . (frame-bracket-interface
line-interface
side-position-interface))))))
#(add-grob-definition
'FrameStub
`((X-extent . ,frame-stub::width)
(Y-extent . ,axis-group-interface::height)
(meta . ((class . Item)
(object-callbacks . ((pure-Y-common .
,ly:axis-group-interface::calc-pure-y-common)
(pure-relevant-grobs .
,ly:axis-group-interface::calc-pure-relevant-grobs)))
(interfaces . (frame-stub-interface))))))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%% FRAME ENGRAVER %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define (add-bound-item spanner item)
"Set left and right bounds of a spanner"
(if (null? (ly:spanner-bound spanner LEFT))
(ly:spanner-set-bound! spanner LEFT item)
(ly:spanner-set-bound! spanner RIGHT item)))
frameEngraver =
#(lambda (context)
(let ((frame '()) ; the box enclosing the items to be repeated
(extender '()) ; a horizontal line with arrow
(frame-start '()) ; the event which signals the beginning of a frame
(frame-stop '()) ; signals the end of a frame
(extender-stop '()) ; the event which signals end of extender line
(bracket '()) ; a bracket with text (i.e., timing)
;; In order to handle the situation when a FrameBracket begins in the
;; same timestep as another ends (i.e., when the user calls
;; \frameExtenderEnd and \frameStart together), some shuffling of
;; grobs between variables is necessary. We copy the spanner held in
;; 'bracket' to 'finished-bracket' once it has been begun. We will
;; complete it there. This frees 'bracket' to contain the beginnings
;; of another FrameBracket grob.
(finished-bracket '())
;; A spacer for the left and right sides of the Frame grob. This is
;; necessary to prevent collisions between the Frame and grobs which
;; precede and follow it, such as barlines.
(frame-stub '()))
(make-engraver
(listeners
((frame-event engraver event)
(if (= START (ly:event-property event 'span-direction))
(set! frame-start event)
(set! frame-stop event)))
((frame-extender-event engraver event)
;; The extender is begun automatically when a frame ends, so we listen
;; only for the extender's termination event.
(if (= STOP (ly:event-property event 'span-direction))
(set! extender-stop event))))
(acknowledgers
((note-column-interface engraver grob source-engraver)
(if (ly:spanner? frame)
(begin
(ly:pointer-group-interface::add-grob frame 'frame-elements grob)
;; The box is attached to a note column on left and right sides.
(add-bound-item frame grob)))
(if (ly:spanner? extender)
;; The extender line is attached to a note column on the left.
;; A NonMusicalPaperColumn will be the right bound.
(if (null? (ly:spanner-bound extender LEFT))
(ly:spanner-set-bound! extender LEFT grob)))
(if (ly:spanner? bracket)
(begin
(ly:pointer-group-interface::add-grob bracket 'columns grob)
;; Bracket is attached to a NonMusicalPaperColumn on either side.
(add-bound-item bracket
(ly:context-property context
'currentCommandColumn))))
(if (ly:spanner? finished-bracket)
(begin
(ly:pointer-group-interface::add-grob finished-bracket 'columns
grob)))
(if (ly:item? frame-stub)
(ly:pointer-group-interface::add-grob frame-stub 'elements grob)))
((script-interface engraver grob source-engraver)
(if (and (ly:spanner? frame)
(not (ly:grob-property frame 'repeat-barlines)))
(ly:pointer-group-interface::add-grob frame 'frame-elements grob))
(if (and (ly:item? frame-stub)
(not (ly:grob-property frame 'repeat-barlines)))
(ly:pointer-group-interface::add-grob frame-stub 'elements grob)))
;((text-script-interface engraver grob source-engraver)
;(if (ly:spanner? frame)
;(ly:pointer-group-interface::add-grob frame 'frame-elements
grob)))
((inline-accidental-interface engraver grob source-engraver)
;; Frame will be sized to accommodate leading accidental.
(if (ly:spanner? frame)
(ly:pointer-group-interface::add-grob frame 'frame-elements grob))
(if (ly:item? frame-stub)
(ly:pointer-group-interface::add-grob frame-stub 'elements grob))))
((process-music trans)
;; When the user requests a frame (with \frameStart), we begin a
;; Frame and a FrameBracket. A FrameStub is created for the left
;; side of the Frame.
(if (ly:stream-event? frame-start)
(begin
(set! frame (ly:engraver-make-grob trans 'Frame frame-start))
(set! bracket
(ly:engraver-make-grob trans 'FrameBracket frame-start))
(ly:pointer-group-interface::add-grob
bracket 'bracket-elements frame)
(ly:pointer-group-interface::add-grob
bracket 'side-support-elements frame)
(set! frame-stub
(ly:engraver-make-grob trans 'FrameStub frame-start))
(ly:grob-set-object! frame-stub 'frame frame)
(ly:grob-set-property! frame-stub 'direction LEFT)
(set! frame-start '())))
;; User has requested completion of Frame grob.
(if (ly:stream-event? frame-stop)
;; Error: user has written \frameEnd without \frameStart.
;; Nothing will be drawn.
(if (null? frame)
(ly:programming-error "No start to frame. Nothing drawn.")
;; no error: finish Frame, begin FrameExtender, and add
references
;; to the completed Frame in FrameExtender and FrameBracket.
;; Create FrameStub for right side of Frame.
(begin
(ly:engraver-announce-end-grob trans frame frame-stop)
(set! extender
(ly:engraver-make-grob
trans 'FrameExtender frame-stop))
(ly:grob-set-object! extender 'frame frame)
(set! frame-stub
(ly:engraver-make-grob trans 'FrameStub frame-stop))
(ly:grob-set-object! frame-stub 'frame frame)
(ly:grob-set-property! frame-stub 'direction RIGHT)
;; Store FrameBracket-in-progress in another variable
;; so that new FrameBracket might be begun at same timestep.
(set! finished-bracket bracket)
(set! bracket '()))))
;; When we hear an extender-event, we finish both FrameExtender and
;; FrameBracket
(if (ly:stream-event? extender-stop)
;; If there is an extender to end...
(if (ly:spanner? extender)
(let ((col (ly:context-property context 'currentCommandColumn)))
(ly:spanner-set-bound! extender RIGHT col)
(ly:engraver-announce-end-grob trans extender extender-stop)
(ly:spanner-set-bound! finished-bracket RIGHT col)
(ly:grob-set-object! finished-bracket 'extender extender)
(ly:pointer-group-interface::add-grob
finished-bracket 'bracket-elements extender)
(ly:pointer-group-interface::add-grob
finished-bracket 'side-support-elements extender)
(ly:engraver-announce-end-grob
trans finished-bracket extender-stop)
(if (ly:grob-property finished-bracket 'no-bracket)
(ly:grob-suicide! finished-bracket))
(set! extender '())
(set! finished-bracket '())
(set! extender-stop '()))
;; There is a request to end a non-existent extender...
(set! extender-stop '()))))
((stop-translation-timestep trans)
(set! frame-stub '())
;; Frame is complete.
(if (ly:stream-event? frame-stop)
(begin
(set! frame '())
(set! frame-stop '()))))
((finalize trans)
;; If there is an incomplete extender at the end of the context, the
;; variable 'extender' won't be empty. Finish the extender and bracket
;; with a warning.
(if (ly:spanner? extender)
(let ((col (ly:context-property context 'currentCommandColumn)))
(ly:warning "You didn't finish final extender. Completing...")
(ly:spanner-set-bound! extender RIGHT col)
(ly:spanner-set-bound! finished-bracket RIGHT col)
(ly:grob-set-object! finished-bracket 'extender extender)
(ly:pointer-group-interface::add-grob
finished-bracket 'bracket-elements extender)
(ly:pointer-group-interface::add-grob
finished-bracket 'side-support-elements extender)
(ly:engraver-announce-end-grob
trans finished-bracket extender-stop)
(if (ly:grob-property finished-bracket 'no-bracket)
(ly:grob-suicide! finished-bracket))
(set! extender '())
(set! extender-stop '())
(set! finished-bracket '())))))))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% EVENT FUNCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
frameStart =
#(make-span-event 'FrameEvent START)
frameEnd =
#(make-span-event 'FrameEvent STOP)
% There is no `frameExtenderStart' because extender is begun with \frameEnd
frameExtenderEnd =
#(make-span-event 'FrameExtenderEvent STOP)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
_______________________________________________
lilypond-user mailing list
lilypond-user@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-user
