Changing orientation of noteheads in tuplets

[clavis]

Hello everybody,

I'm having a problem with beams when using  

http://lsr.di.unimi.it/LSR/Item?id=861

to change the direction of noteheads of chords that are part of a tuplet.
The beams just disappear, and If the tuplet is more complex, like 14/8, it gets 
really bad.

Would anybody have an idea, how I could "fix" this?
Here's my simplified example:

%% BEGIN OF EXAMPLE

#(define ((shift offsets) grob)
"Defines how NoteHeads should be moved according to the given list of offsets."
 (let* (
 ;; NoteHeads
        ;; Get the NoteHeads of the NoteColumn
        (note-heads (ly:grob-array->list (ly:grob-object grob 'note-heads)))
        ;; Get their durations
        (nh-duration-log 
          (map 
            (lambda (note-head-grobs)
              (ly:grob-property note-head-grobs 'duration-log))
            note-heads))
        ;; Get the stencils of the NoteHeads
        (nh-stencils 
          (map 
            (lambda (note-head-grobs)
              (ly:grob-property note-head-grobs 'stencil))
            note-heads))
        ;; Get their length in X-axis-direction
        (stencils-x-lengths 
          (map 
            (lambda (x) 
                (let* ((stencil (ly:grob-property x 'stencil))
                       (stencil-X-exts (ly:stencil-extent stencil X))
                       (stencil-lengths (interval-length stencil-X-exts)))
                stencil-lengths))
             note-heads))
 ;; Stem
        (stem (ly:grob-object grob 'stem))
        (stem-thick (ly:grob-property stem 'thickness 1.3))
        (stem-stil (ly:grob-property stem 'stencil))
        (stem-x-width (if (ly:stencil? stem-stil)
                         (interval-length (ly:stencil-extent stem-stil X))
                         ;; if no stem-stencil use 'thickness-property
                         (/ stem-thick 10)))
        (stem-dir (ly:grob-property stem 'direction))
        ;; Calculate a value to compensate the stem-extension
        (stem-x-corr 
          (map 
            (lambda (q)
               ;; TODO better coding if (<= log 0)
               (cond ((and (= q 0) (= stem-dir 1))
                      (* -1 (+ 2  (* -4 stem-x-width))))
                     ((and (< q 0) (= stem-dir 1))
                      (* -1 (+ 2  (* -1 stem-x-width))))
                     ((< q 0)
                      (* 2 stem-x-width))
                     (else (/ stem-x-width 2))))
             nh-duration-log)))
 ;; Final Calculation for moving the NoteHeads
   (for-each
     (lambda (nh nh-x-length off x-corr) 
         (if (= off 0)  
           #f 
           (ly:grob-translate-axis! nh (* off (- nh-x-length x-corr)) X)))
     note-heads stencils-x-lengths offsets stem-x-corr)))

displaceHeads =
#(define-music-function (parser location offsets) (list?)
"
 Moves the NoteHeads, using (shift offsets)
"
 #{
   \once \override NoteColumn.before-line-breaking = #(shift offsets)
 #})
 
adjustStem =
#(define-music-function (parser location val)(pair?)
"
 Adjust 'stem-attachment via 
 adding multiples of the stem-width to the x-default (car val)
 and multiplying the y-default with (cdr val).
"
#{
   \once \override NoteHead.before-line-breaking = 
   #(lambda (grob)
     (let* ((stem-at (ly:grob-property grob 'stem-attachment))
            (stem (ly:grob-object grob 'stem))
            (stem-x-width (interval-length (ly:grob-property stem 'X-extent))))
     (ly:grob-set-property! 
       grob
       'stem-attachment 
       (cons (+ (car stem-at) (* stem-x-width (car val))) (* (cdr val) (cdr 
stem-at))) 
       )))
#})
 
setOtherScriptParent =
#(define-music-function (parser location which-note-head)(integer?)
"
 If the parent-NoteHead of a Script is moved, another parent from the 
 NoteColumn could be chosen.
 The NoteHeads are numbered 1 2 3 ...
 not 0 1 2 ...
"
#{
        %% Let "staccato" be centered on NoteHead, if Stem 'direction is forced
        %% with \stemUp, \stemDown, \voiceOne, \voiceTwo etc
        \once \override Script.toward-stem-shift = #0
        
        \once \override Script.after-line-breaking =
          #(lambda (grob)
             (let* ((note-head (ly:grob-parent grob X))
                    (note-column (ly:grob-parent note-head X))
                    (note-heads-list 
                      (ly:grob-array->list 
                        (ly:grob-object note-column 'note-heads)))
                    (count-note-heads (length note-heads-list)))
             (if (> which-note-head count-note-heads)
               (ly:warning "Can't find specified note-head - ignoring")
               (set! (ly:grob-parent grob X)
                     (list-ref note-heads-list (- which-note-head 1))))))
#})


%%%%%%%% LSR EXAMPLE %%%%%%%%

originalMusic = \relative c' { 
  e4
  d'
  <c, e>
  <e'g>
  <f, a c>
  <c' e g>
  <ees f a c>
  <ees, f a c>---.-!
  \tuplet 3/2 { <g ais cis e>8 q q }
}

alteredMusic = \relative c' { 
  
  \displaceHeads #'(1) 
  \adjustStem #'(0.75 . -1)
  e4
  
  \displaceHeads #'(-1) 
  \adjustStem #'(0.75 . -1)
  d'
  
   \displaceHeads #'(0 1) 
   <c, e>

   \displaceHeads #'(-1 0) 
   <e' g>
  
  \displaceHeads #'(1 0 0) 
  \adjustStem #'(0.75 . -1)
  <f, a c>
 
  \displaceHeads #'(-1 -1 0)
  <c' e g>
  
  \displaceHeads #'(1 -1 0 0) 
  <ees f a c>

  \setOtherScriptParent #2
  \adjustStem #'(0.75 . -1)
  \displaceHeads #'(1 -1 0 0) 
  <ees, f a c>---.-!
  
   
  \tuplet 3/2 { \displaceHeads #'(1 -1 0 0) <g ais cis e>8 \displaceHeads #'(1 
-1 0 0) <g ais cis e>8 \displaceHeads #'(1 -1 0 0) <g ais cis e>8  }
}

<<
  \new Staff \with { instrumentName = "original " }{
    \originalMusic
  }
  \new Staff \with { instrumentName = "altered " }{
    \alteredMusic
  }
>>

%% END OF EXAMPLE

Thanks for any idea with this!
Kind regards

Orlando López
Hamburg