Or rather there is the

NoteColumn.ignore-collision

property. If set to #t the Note column will not be added to any NoteCollision 
grob. The problem here is that in this case there need to be no positional 
correction. So we require some additional check in the engraver to apply this 
correction depending on whether this ignore-collision property is true.

Cheers,
Valentin

Am Dienstag, 13. Juni 2023, 12:13:46 CEST schrieb Werner LEMBERG:
> > A possible solution for this could be to do a similar thing to add
> > certain note columns to separate NoteCollision grobs, so they can be
> > spaced independently.  However, it your case it should suffice to
> > prevent any Collisions to be detected by doing
> > 
> > \once\override Staff.NoteCollision.note-collision-threshold = #-1
> 
> 
> Excellent, and thanks again!  It works just fine.
> 
> I'm more and more convinced that the whole issue is stuff for an
> excellent LSR snippet :-) Will you have time to provide that?
> 
> 
>     Werner

#(define (which lst)
   (define (impl lst count)
     (if (null? lst)
         #f
         (if (car lst)
             count
             (impl (cdr lst) (1+ count)))))
   (impl lst 0))


#(define (custom_accidental_placement_engraver context)
   (define (grob-array->list x)
     (if (ly:grob-array? x)
         (ly:grob-array->list x)
         '()))
   (let ((placement #f) (right-padding #f))
     (make-engraver
      (acknowledgers
       ((accidental-interface engraver grob source-engraver)
        (if (assoc-get 'capture (ly:grob-property grob 'details) #f)
            (begin
              (if (not placement)
                  (begin
                   (set! placement (ly:engraver-make-grob engraver 'AccidentalPlacement '()))
                   (ly:grob-set-parent! placement X (ly:grob-parent (ly:grob-parent grob Y) X))
                   (let ((padding (ly:grob-property-data placement 'right-padding)))
                     (set!
                      right-padding
                      (lambda (grob)
                        (let* ((grobs (ly:grob-object grob 'accidental-grobs))
                               (grobs (apply append (map cdr grobs)))
                               (heads (map (lambda (x) (ly:grob-parent x Y)) grobs))
                               (stems (map (lambda (x) (ly:grob-object x 'stem)) heads))
                               (cols (map (lambda (x) (ly:grob-parent x X)) heads))
                               (collisions (map (lambda (x) (ly:grob-parent x X)) cols))
                               (cols2 (apply append
                                             (map 
                                              (lambda (x)
                                                (grob-array->list (ly:grob-object x 'elements)))
                                              collisions)))
                               (heads2 (apply append
                                              (map
                                               (lambda (x)
                                                 (grob-array->list (ly:grob-object x 'note-heads)))
                                               cols2)))
                               (stems2 (map (lambda (x) (ly:grob-object x 'stem)) heads))
                               (grob-set1 (ly:grob-list->grob-array (append heads stems)))
                               (grob-set2 (ly:grob-list->grob-array (append heads stems heads2 stems2)))
                               (refp (ly:grob-common-refpoint-of-array grob grob-set1 X))
                               (refp2 (ly:grob-common-refpoint-of-array grob grob-set2 X))
                               (ext (ly:grob-extent refp refp2 X))
                               (ext2 (ly:grob-extent refp2 refp2 X))
                               (offset (car ext))
                               (offset (- offset (car ext2))))
                          (- (if (procedure? padding) (padding grob) padding) offset)))))))
              (let* ((src-placement (ly:grob-parent grob X))
                     (grobs (ly:grob-object src-placement 'accidental-grobs))
                     (has-grob? (map (lambda (pair) (memq grob (cdr pair))) grobs))
                     (pair (list-ref grobs (which has-grob?)))
                     (notename (car pair))
                     (groblist (cdr pair))
                     (new-grobs (ly:grob-object placement 'accidental-grobs))
                     (new-groblist (assoc-get notename new-grobs '()))
                     (groblist (delete grob groblist eq?))
                     (new-groblist (cons grob new-groblist))
                     (grobs (assoc-set! grobs notename groblist))
                     (new-grobs (assoc-set! new-grobs notename new-groblist)))
                (if (not (ly:grob-property (ly:grob-parent (ly:grob-parent grob Y) X) 'ignore-collision #f))
                    (ly:grob-set-property! placement 'right-padding right-padding))
                (ly:grob-set-object! src-placement 'accidental-grobs grobs)
                (ly:grob-set-object! placement 'accidental-grobs new-grobs)
                (ly:grob-set-parent! grob X placement))))))
      ((stop-translation-timestep engraver)
       (set! placement #f)))))

\layout {
  \context {
    \Voice
    \consists #custom_accidental_placement_engraver
    % Make NoteColumn use force-hshift even if ingnore-collision is #t
    \override NoteColumn.X-offset = #(lambda (grob) (ly:grob-property grob 'force-hshift 0))
  }
}

<<
  \new Staff {
    << 
      \repeat unfold 4 { <b'! e''!>2. <c'' f''>4 }
      \\
      <<
        \repeat unfold 4 { bes'!8 a' g' f' bes' a' g' f' }
        {
          \once \override NoteColumn.force-hshift = #2.4
          s1
          \once \override NoteColumn.force-hshift = #3.4
          \once \override Accidental.details.capture = ##t
          s1
          \once \override NoteColumn.force-hshift = #2.4
          \once \override NoteColumn.ignore-collision = ##t
          s1
          \once \override NoteColumn.force-hshift = #3.8
          \once \override NoteColumn.ignore-collision = ##t
          \once \override Accidental.details.capture = ##t
        }
      >>
    >>
  }
  \new Staff \with { \clef bass } \repeat unfold 8 { <a d'>2 }
>>

Attachment: signature.asc
Description: This is a digitally signed message part.

Reply via email to