The strategy is to acknowledge the end of StaffSymbols to be able to remove their corresponding entries in the internal structure. Additionally, the context in which the StaffSymbol correlates is recorded so a future StaffSymbol of the same context takes the same place. This should keep things stable if staves stop and start at odd places.
One thing I noticed was the C++ engraver acknowledges SystemStartDelimiters (of which it is the one creating them) and calls the Bracket_nesting_group::add_support function. However, in my porting of the engraver to Scheme, I could not get this acknowledger to trigger. Does LilyPond have code coverage tests that could confirm whether that logic is necessary? In any event, I omitted it from my Scheme engraver.
-- Aaron Hill
\version "2.20.0"
System_start_delimiter_engraver_patched =
#(lambda (context)
(let ((nesting #f))
(define (nesting-node node-type)
(let ((node-grob #f)
(prior-context #f)
(children '())
(symbol #f))
(define (append-child child)
(set! children (append children (list child))))
(define (create-grobs engraver default)
(let ((type (if (symbol? symbol) symbol default)))
(set! node-grob
(ly:engraver-make-grob engraver type '()))
(for-each
(lambda (child)
(child 'create-grobs engraver default))
children)))
(define (from-list lst)
(for-each
(lambda (entry)
(if (member
entry
'(SystemStartBar
SystemStartBrace
SystemStartBracket
SystemStartSquare))
(set! symbol entry)
(let ((child (nesting-node
(if (pair? entry) 'group 'staff))))
(if (pair? entry) (child 'from-list entry))
(append-child child))))
lst))
(define (group-add-staff staff context)
(let loop ((pair children))
(and (pair? pair)
(if ((car pair) 'add-staff staff context)
(begin
(ly:pointer-group-interface::add-grob
node-grob
'elements
staff)
#t)
(loop (cdr pair))))))
(define (group-remove-staff staff context)
(let loop ((pair children))
(and (pair? pair)
(or ((car pair) 'remove-staff staff context)
(loop (cdr pair))))))
(define (set-bound direction grob)
(ly:spanner-set-bound! node-grob direction grob)
(for-each
(lambda (child)
(child 'set-bound direction grob))
children))
(define (set-nesting-support parent)
(and (ly:grob? parent)
(ly:pointer-group-interface::add-grob
node-grob
'side-support-elements
parent))
(for-each
(lambda (child)
(child 'set-nesting-support node-grob))
children))
(define (staff-add-staff staff context)
(if (or (ly:grob? node-grob)
(and (ly:context? prior-context)
(not (eq? prior-context context))))
#f
(begin
(set! prior-context #f)
(set! node-grob staff)
#t)))
(define (staff-remove-staff staff context)
(and (ly:grob? node-grob)
(eq? node-grob staff)
(begin
(set! prior-context context)
(set! node-grob #f)
#t)))
(define (null-procedure . args) #f)
(lambda args
(apply (case node-type
((group)
(case (car args)
((add-staff) group-add-staff)
((append-child) append-child)
((create-grobs) create-grobs)
((from-list) from-list)
((remove-staff) group-remove-staff)
((set-bound) set-bound)
((set-nesting-support) set-nesting-support)
(else null-procedure)))
((staff)
(case (car args)
((add-staff) staff-add-staff)
((remove-staff) staff-remove-staff)
(else null-procedure)))
(else null-procedure))
(cdr args)))))
(make-engraver
((process-music engraver)
(or (procedure? nesting)
(begin
(set! nesting (nesting-node 'group))
(nesting
'from-list
(ly:context-property
context
'systemStartDelimiterHierarchy))
(nesting
'create-grobs
engraver
(ly:context-property
context
'systemStartDelimiter))
(nesting
'set-bound
LEFT
(ly:context-property
context
'currentCommandColumn)))))
((finalize engraver)
(and (procedure? nesting)
(begin
(nesting
'set-bound
RIGHT
(ly:context-property
context
'currentCommandColumn))
(nesting 'set-nesting-support #f)
(set! nesting '()))))
(acknowledgers
((staff-symbol-interface
engraver
grob
grob-engraver)
(or (nesting
'add-staff
grob
(ly:translator-context grob-engraver))
(begin
(nesting 'append-child (nesting-node 'staff))
(nesting
'add-staff
grob
(ly:translator-context grob-engraver))))))
(end-acknowledgers
((staff-symbol-interface
engraver
grob
grob-engraver)
(nesting
'remove-staff
grob
(ly:translator-context grob-engraver)))))))
\new StaffGroup \with {
\remove "System_start_delimiter_engraver"
\consists \System_start_delimiter_engraver_patched
\override SystemStartBracket.color = #'(0.9 0.2 0.3)
\override SystemStartBrace.color = #'(0.3 0.9 0.2)
\override SystemStartSquare.color = #'(0.2 0.3 0.9)
systemStartDelimiter = #'SystemStartBar
systemStartDelimiterHierarchy =
#'((SystemStartBracket a b c)
(SystemStartSquare (SystemStartBrace d e) f))
}
<<
\new Staff { \clef "treble" R1*4 \break R1*5 \break R1 \bar "|." }
\new Staff { \clef "alto" R1*6 \stopStaff s1*2 \startStaff R1*2 }
\new Staff { \clef "bass" R1 \stopStaff s1*2 \startStaff R1*7 }
\new Staff { \clef "treble" R1 \stopStaff s1 \startStaff R1*8 }
\new Staff { \clef "bass" R1*5 \stopStaff s1*2 \startStaff R1*3 }
\new Staff { \clef "bass" R1*4 \stopStaff s1*2 \startStaff R1*4 }
>>
patch-system-start-delimiter-engraver.pdf
Description: Adobe PDF document
_______________________________________________ bug-lilypond mailing list bug-lilypond@gnu.org https://lists.gnu.org/mailman/listinfo/bug-lilypond
