Re: Layout of a (piano) hand indicator

[Thomas Morley]

Hi,

I've read your post in the morning and some things in Simon's function
were obvious to impove.
But then I started testing use-cases and noticed the problem is very
complex, if you try a high amount of automatism (but still with the
possibility for the user to adjust values).
Some points of the coding challenge:
Make it robust for \voiceXxx, suspended NoteHeads in the column, accidentals.
The real problems arise when you try to make it work together with
common fingerings for fingeringOrientation set 'left or even unset.

First some remarks to Simon's coding

2018-05-06 9:45 GMT+02:00 foxfanfare <address@hidden>:

> hook =
> #(let ((direction? (lambda (n) (= 1 (abs n))))

No need to define a predicate, we have ly:dir?

>         (hook-markup #{ \markup \path #0.12 #'((moveto 0 0)
>                                                 (rlineto -0.85 0)
>                                                 (rlineto 0 3)) #}))
>     (define-event-function (direction on-line)
>       (direction? boolean?)

`on-line' can be read, no need to have it as a function's argument.

>       (let* ((self-al (if on-line 0 0.31))
>              (self-al (if (= direction 1) (- self-al) self-al)))

`direction' could be used as a multiplier.

>
>         #{
>           \tweak self-alignment-Y $self-al
>           \tweak extra-offset #'(0.75 . 0)
>           \tweak extra-spacing-width #'(-0.5 . 0)
>           \finger \markup \scale #(cons 1 direction) #hook-markup
>         #})))



Below my own attempt.
The function has an optional argument, `details', for finetuning.

There are some helper-procedures, probably overkill, but it was going
on my nerves ;)

Still, there are some issues, when FingeringColumn comes into the game ...



\version "2.19.81"

%% From
%% https://archiv.lilypondforum.de/index.php/topic,2507.msg14157.html#msg14157
%% slightly changed
#(define (get-parent-in-hierarchie grob searchword)
  ;; goes up in hierarchie until it finds
  ;; a grob named searchword
  (define result #f)

  (define compare
    (lambda (x)
      (and (ly:grob? x)
           (eq? searchword (grob::name x)))))

  (define (get-par grob)
    (let* ((parx (ly:grob-parent grob X))
           (pary (ly:grob-parent grob Y)))

      (cond ((not(equal? result #f))
              result )
            ((compare parx)
              (set! result parx)
              result)
            ((compare pary)
              (set! result pary)
              result)
            (else
              (if (ly:grob? parx)
                  (get-par parx))
              (if(ly:grob? pary)
                  (get-par pary))))))
      ;; the inner function gets called from here
      (let* ((result (get-par grob)))
        ;; check if we found something
        (if (ly:grob? result)
            result
            #f)))

#(define (get-grob-most-left-relative-coordinate ref-point)
  ;; most suitable for container-grobs
  (lambda (grob)
    (if (ly:grob? grob)
        (cond
          ((eq? (grob::name grob) 'NoteColumn)
             (let* ((note-heads-array (ly:grob-object grob 'note-heads))
                    (note-heads-grobs
                      (if (ly:grob-array? note-heads-array)
                          (ly:grob-array->list note-heads-array)
                          '()))
                    (note-heads-refpoints
                      (map
                        (lambda (nh)
                          (ly:grob-relative-coordinate nh ref-point X))
                        note-heads-grobs))
                    (sorted-note-heads-refpoints (sort note-heads-refpoints <)))
              (if (not (null? sorted-note-heads-refpoints))
                  (car sorted-note-heads-refpoints))))
           ((eq? (grob::name grob) 'AccidentalPlacement)
              (let* ((acc-list (ly:grob-object grob 'accidental-grobs))
                     (acc-refpoints
                       (map
                         (lambda (acc)
                           (ly:grob-relative-coordinate (cadr acc) ref-point X))
                         acc-list))
                     (sorted-acc-refpoints (sort acc-refpoints <)))
               (if (not (null? sorted-acc-refpoints))
                   (car sorted-acc-refpoints))))
           (else
             (if (ly:grob? grob)
                 (ly:grob-relative-coordinate grob ref-point X))))
        '())))

hook =
#(define-event-function (details direction)
  ((number-list? '(0 0 -0.85 3)) ly:dir?)
  (let* ((hook-markup
         #{
             \markup
               \path
                 #0.175
                 #`((moveto 0 0)
                   (rlineto ,(caddr details) 0)
                   (rlineto 0 ,(* direction (cadddr details))))
         #}))
    #{
       \tweak before-line-breaking
         #(lambda (grob)
            (let* (;; grob-parent may be FingeringColumn
                   (grob-parent (ly:grob-parent grob X))
                   (note-head (get-parent-in-hierarchie grob 'NoteHead))
                   (staff-pos (ly:grob-property note-head 'staff-position))
                   (staff-space (ly:staff-symbol-staff-space grob))
                   (fingering-column
                     (grob::has-interface
                       grob-parent
                       'fingering-column-interface)))
        ;; If `fingeringOrientations = #'(left)' and more than one fingering
        ;; is present, we need to go via FingeringColumn.positioning-done
        (if fingering-column
            (let* ((fingers-array (ly:grob-object grob-parent 'fingerings))
                   (fingers-list
                     (if (ly:grob-array? fingers-array)
                         (ly:grob-array->list fingers-array)
                         '())))
              (ly:grob-set-property! grob-parent 'positioning-done
                (lambda (x)
                  (for-each
                    (lambda (f)
                      (if (equal? grob f)
                          (ly:grob-set-property! f 'stencil
                            (ly:stencil-translate
                              (ly:grob-property f 'stencil)
                              (cons
                                (car details)
                                (* direction
                                   (+
                                      (/ (cadddr details) 2)
                                      (cadr details)
                                      (* staff-space
                                         (if (even? staff-pos) -0.5 -1)))))))
                          (ly:grob-set-property! f 'stencil
                            (ly:stencil-aligned-to
                              (ly:grob-property f 'stencil)
                              Y
                              DOWN))))
                    fingers-list))))


            (let* ((side-axis (ly:grob-property grob 'side-axis))
                   (padding (ly:grob-property grob 'padding))
                   (sys (get-parent-in-hierarchie grob 'System))
                   (note-column (ly:grob-parent note-head X))
                   (note-head-ext
                     (ly:grob-extent note-head note-column X))
                   (nc-left
                     ((get-grob-most-left-relative-coordinate sys)
                      note-column))
                   (acc-placement (ly:note-column-accidentals note-column))
                   (acc-left
                     ((get-grob-most-left-relative-coordinate sys)
                      acc-placement))
                   (val
                     (cond ((and (null? acc-left) (not (negative? nc-left)))
                            (+ (- nc-left)
                               (if (not (zero? (car note-head-ext)))
                                   (car note-head-ext)
                                   0)))
                           ((and (not (null? acc-left)) (negative? nc-left))
                            (+
                               (- acc-left)
                               (if (negative? (car note-head-ext))
                                   (car note-head-ext)
                                   0)))
                           ((not (null? acc-left))
                            (+ (- nc-left acc-left)
                               (if (not (zero? (car note-head-ext)))
                                   (car note-head-ext)
                                   0)))
                           (else
                             (if (negative? (car note-head-ext))
                                 0
                                 (- nc-left))))))

         (if (not (zero? side-axis))
             (ly:grob-translate-axis!
               grob
               (- (+ val (car details) padding))
               X))
              (ly:grob-set-property! grob 'Y-offset
                (+ (* direction staff-space (if (even? staff-pos) -0.5 -1))
                   (if (zero? side-axis)
                       0
                       (/ staff-pos 2))
                   (cadr details)))))))
       \finger #hook-markup
    #}))

%%%%%%%%%%%%%%%%%%%%
%% EXAMLES
%%%%%%%%%%%%%%%%%%%%

\paper { ragged-right = ##t }

\layout {
  \accidentalStyle Score.forget
}

%\transpose c cis
{
  \set fingeringOrientations = #'(left)
  %\voiceOne
  %\voiceTwo
  %% no FingeringColumn
  <d'' -\hook #DOWN >2
  <d'' -\hook #UP >2
  <d'' -\hook #'(0 -1 -0.85 3) #UP >2
  <c'' -\hook #DOWN >2
  <c'' -\hook #UP >2
  r2

  \break

  %% FingeringColumn present, because two or more fingerings present and
  %% `fingeringOrientations' is `left'
  %%
  %% need to manually adjust Fingerings, but sometimes FingeringColumn still
  %% delivers surprises ...
  <d'' -1 -\hook #'(1 -1 -0.85 2) #DOWN    e''-\tweak X-offset #-4.5 -2 >2
  <d'' -\hook #'(0 -0.5 -0.85 2)  #DOWN -1 e''-\tweak X-offset #-4.0 -2 >2
  <d'  -1 -\hook #'(1 0 -0.85 4) #UP      e'-\tweak X-offset #-3.7  -2 >2
  <d'  -\hook #'(0.5 0.5 -0.85 4)  #UP -1   e'-\tweak X-offset #-3.0  -2 >2
  <d'' -1 -\hook #DOWN >2
  <d'' -\hook #DOWN -2 >2
  <d'' -1 -\hook #'(0 0 -0.85 2) #DOWN >2
  <d'' -\hook #'(0 0 -0.85 4) #DOWN -1 >2
  <d'' -1 -\hook #'(0 0 -0.85 2) #DOWN -3 >2
  <d' -1 -\hook #'(0 0 -0.85 2) #UP -3 >2
}

%\transpose c cis
{
  %\voiceOne
  %\voiceTwo
  %% no FingeringColumn
  <c'' -\hook #DOWN d'' >2
  <c'' -\hook #UP d'' >2
  <b' c'' -\hook #DOWN >2
  <b' c'' -\hook #UP >2

  \break

  <d''-1 -\hook #DOWN >2
  <d'' -\hook #UP -2 >2
  <c''-1 -\hook #DOWN -2 >2
  <c'' -\hook #UP >2

  \break

  <d''-1 -\hook #'(0 0 -2 3) #DOWN >2
  <d'' -\hook #'(0 0 -0.85 5) #UP -2 >2
  <c''-1 -\hook #'(-0.7 0 -0.85 3) #DOWN -2 >2
}



Cheers,
  Harm