Re: shifting accidentals horizontally

[Valentin Petzel]

Hello Werner,

I’ve tried something using an engraver that sends of accidentals from the 
given context to a separate AccidentalPlacement grob:

%%%%%
#(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)
   (let ((placement #f))
     (make-engraver
      (acknowledgers
       ((accidental-interface engraver grob source-engraver)
        (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* ((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)))))

{
  << { <b'! e''!>2. } \\
   \new Voice \with { \consists #custom_accidental_placement_engraver } { 
\once \override NoteColumn.force-hshift = #3.3 bes'!8 } >>
}
%%%%%


Sadly this does not really do the trick because the Accidental-Placement grob 
uses the NoteCollision grob to gain access to all heads and stems and 
positions relative to the common refpoint. In my opinion this could be 
improved by using this common refpoint as offset for the AccidentalPlacement, 
and then position the Accidentals relative to this AccidentalPlacement. This 
would give us the ability to shift the Accidentals by shifting the X-offset.

We can still do something like

{
  << { <b'! e''!>2. } \\
   \new Voice \with { \consists #custom_accidental_placement_engraver }
   { \once\override AccidentalPlacement.right-padding = #-3.7 \once \override 
NoteColumn.force-hshift = #3.4 bes'!8 } >>
},

So what I’ve done now is to use that property to automatically determine a 
"correct" value. Note that this may cause collisions!


%%%%%
#(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)
   (let ((placement #f))
     (make-engraver
      (acknowledgers
       ((accidental-interface engraver grob source-engraver)
        (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)
                                          (ly:grob-array->list (ly:grob-object 
x 'elements)))
                                        collisions)))
                         (heads2 (apply append
                                        (map
                                         (lambda (x)
                                           (ly: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)))))

{
  << { <b'! e''!>2. } \\
   \new Voice \with { \consists #custom_accidental_placement_engraver }
   { \once \override NoteColumn.force-hshift = #3.4 bes'!8 } >>
}
%%%%%

Finally I added a check to Accidental.details.capture to allow switching this 
behaviour on and off. See the appended file for the final result.

Cheers,
Valentin

Am Montag, 12. Juni 2023, 19:02:52 CEST schrieb Werner LEMBERG:
> 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 } >>
> ```
> 
> 
>     Werner

independent_accidentals.ly
Description: Text Data

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