Complex chords with splayed stems - Script-positioning

[Thomas Morley]

Hi,

after an idea by Mike Solomon
-> http://lists.gnu.org/archive/html/lilypond-user/2011-12/msg00421.html
I've worked on complex chords with splayed stems.
Seems to work so far.

But if I add an articulation it moves to an unexpected NoteHead.
TextScript doesn't move!

I tried to set an explicit grob-parent, without success.

Any hints?


Cheers,
  Harm

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\version "2.15.39"

\paper {
        indent = 25
        print-all-headers = ##t
}

#(define ((positioning-done l1 l2) grob)
  (if (< (ly:grob-property grob 'duration-log) 1)
    #f
    (let* ((nh (ly:grob-array->list (ly:grob-object grob 'note-heads)))
           (default-nh-x-width (interval-length (ly:stencil-extent
(ly:note-head::print grob) X)))
           (accidental-grobs (map (lambda (x) (ly:grob-object x
'accidental-grob)) nh))
           (sys (ly:grob-parent (ly:grob-parent (ly:grob-parent grob X) X) X))
           (nh-ref-pts (map (lambda (x) (ly:grob-relative-coordinate x
sys X)) nh))
           (acc-ref-pts
             (map
               (lambda (x) (if (ly:grob? x)
(ly:grob-relative-coordinate x sys X) #f))
                 accidental-grobs)))

  ;; note-heads
      (for-each
        (lambda (x y z)
          (ly:grob-translate-axis! x (* y z) X))
            nh (iota (length nh)) l1)

  ;; accidentals
      (for-each
        (lambda (a b c d add)
        (if (null? a)
          #f
          (ly:grob-translate-axis! a (- (* b c) d default-nh-x-width add) X)))
            accidental-grobs (iota (length nh)) l1 acc-ref-pts l2)))
    0.0)

#(define (splayed-stem-stencil grob)
  (if (< (ly:grob-property grob 'duration-log) 1)
    #f
    (let* ((pc (ly:grob-parent (ly:grob-parent grob X) X))
           (nc (ly:grob-parent grob Y))
           (dir (ly:grob-property grob 'direction))
           (half-space (* 0.5 (ly:staff-symbol-staff-space grob)))
           (thick (* (ly:grob-property grob 'thickness)
                     (ly:staff-symbol-line-thickness grob)))
           (y1 (* half-space (ly:stem::calc-stem-begin-position grob)))
           (y2 (- (* half-space (ly:stem::calc-stem-end-position
grob)) (* 2 thick)))
           (nh (ly:grob-array->list (ly:grob-object grob 'note-heads)))
           (x (ly:grob-relative-coordinate (car nh) pc X))
           (first-nh-staff-pos (ly:grob-property (car nh) 'staff-position))
           (targets-staff-pos (map (lambda (x) (ly:grob-property x
'staff-position)) nh))
           (sorted-targets-staff-pos (sort targets-staff-pos <))
           (beam (ly:grob-object grob 'beam))
           (beam-corr (if (and (= dir -1) (ly:grob? beam)) -1 1))
           (corr-add (if (and (>= first-nh-staff-pos (car
sorted-targets-staff-pos)) (= dir 1))
                       (/ (- first-nh-staff-pos (car
sorted-targets-staff-pos)) 2)
                       (/ (- first-nh-staff-pos (car (reverse
sorted-targets-staff-pos))) 2)))
           (stem-y-corr (map (lambda (x)  (+  (/ (- x
first-nh-staff-pos) 2) corr-add)) targets-staff-pos))
           (stencil (apply
                      ly:stencil-add
                      (map (lambda (nh y)
                             (let ((my-x (car (ly:grob-extent nh pc X))))
                               (make-line-stencil thick x (* beam-corr
y2) my-x (+  y y1))))
                           nh stem-y-corr))))
    stencil)))

#(define (new-flag-stencil grob)
    (let* ((stil (ly:flag::print grob))
           (stem (ly:grob-parent grob X))
           (dir (ly:grob-property stem 'direction))
           (thick (* (ly:grob-property stem 'thickness)
             (ly:staff-symbol-line-thickness grob)))
           (x-ext (ly:stencil-extent stil X))
           (y-ext (ly:stencil-extent stil Y))
           (line-stil (make-line-stencil thick (car x-ext) (car y-ext)
(car x-ext) (cdr y-ext)))
           (new-stil (ly:stencil-translate-axis
                         (ly:stencil-combine-at-edge
                           stil
                           X LEFT
                           line-stil 0)
                             (* dir (- (interval-length y-ext) (* 3
thick))) Y)))
    new-stil))

#(define (new-X-extent grob)
;; TODO Better spacing
  (let* ((x-ext (ly:grob-property grob 'X-extent)))
  (ly:grob-set-property! grob 'X-extent (cons (* 2 (car x-ext)) (* 2
(cdr x-ext))))))

splayedStemChord =
#(define-music-function (parser location l1 l2 mus)
   (list? list? ly:music?)
#{
        \once \override Flag #'stencil = #new-flag-stencil
        \once \override Score.NoteColumn #'before-line-breaking = #new-X-extent
        \once \override Stem #'positioning-done = #(positioning-done l1 l2)
        \once \override Stem #'stencil = #splayed-stem-stencil


        \once \override Score.Script #'before-line-breaking =
          #(lambda (grob)
             (let* ((nc (ly:grob-parent grob X))
                    (nh (ly:grob-array->list (ly:grob-object nc 'note-heads))))
               (set! (ly:grob-parent grob X)
                     (car nh))))

         $mus
#})

%---------- test

\relative c {
         \clef bass

         \splayedStemChord
           % Note-head-offsets. Note: elements are multipliers.
           #'(0 -4 3.5 -2.5 0.9 0 1.6)
           % Accidental-offsets, elements are added to the calculated values.
           #'(0 0 0 0 0 1 0)
           \displayMusic <b,! dis bes f'! d! d! gis>8-.-- -\markup "↑"
}


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

splayed-stems-post.png
Description: PNG image