Hello Jean,

I think a possible case would be something like the appended case, so if we 
have some sort of superimposed patterns.

@Werner I’ve added a small fix concerning the case when there is no 
NoteCollision grob (in which case this should not be relevant in the first 
place).

Cheers,
Valentin

Am Montag, 12. Juni 2023, 22:32:17 CEST schrieb Jean Abou Samra:
> Le lundi 12 juin 2023 à 17:02 +0000, Werner LEMBERG a écrit :
> > Please consider the example code below.  The first line shows
> > LilyPond's default, the second line shows what I need.  As can be
> > seen, the solution in the second line is imperfect – I just did the
> > most basic changes to demonstrate what I want, namely the down-stemmed
> > note to be positioned after the up-stemmed chord.
> > 
> > Is there an automated solution for this problem (namely correctly
> > positioned and spaced naturals for the chord)?  The LSR doesn't really
> > help, unfortunately.
> > 
> > BTW, such situations happen from time to time in piano music.
> > 
> > ```
> > \version "2.25.6"
> > 
> > << { <b'! e''!>2. } \\
> >    { bes'!8 } >>
> > 
> > << { <b'! e''!>2. } \\
> >    {
> >      \once \override NoteColumn.force-hshift = #3.3
> >      \once \override Accidental.extra-offset = #'(4.7 . 0)
> >      bes'!8 } >>
> > ```
> 
> Even though I can imagine this happening, I don't recall seeing
> it as a pianist. Even if you tweak it to swap the note columns,
> I think it will still be a bit confusing.
> 
> There are two obvious fixes: if you are the composer, you could
> consider changing the B♭ into an A♯. And the other solution is
> to move the B♭ note to the lower staff in a local treble clef.

#(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))
     (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)))
                     (ly:grob-set-property!
                      placement
                      'right-padding
                      (lambda (grob)
                        (let* ((grobs (ly:grob-object placement '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)))
                (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))))))
      ((finish-timestep engraver)
       (set! placement #f)))))

\layout {
  \context {
    \Voice
    \consists #custom_accidental_placement_engraver
  }
}

{
  << { <b'! e''!>2. <c'' f''>4 | <b'! e''!>2. <c'' f''>4 } \\
     { \once \override NoteColumn.force-hshift = #2.4
       bes'!8 a' g' f' bes' a' g' f'
       \once \override NoteColumn.force-hshift = #3.4
       \once\override Accidental.details.capture = ##t
       bes'!8 a' g' f' bes' a' g' f' } >>
}

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

Reply via email to