I think I have addressed the original issue in this patched version of the System_start_delimiter_engraver. This is implemented in Scheme, but the changes should be easily ported back to C++.

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 }
>>

Attachment: 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

Reply via email to