\version "2.13.43"

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% http://lsr.dsi.unimi.it/LSR/Snippet?id=639 :
%LSR Thanks to Neil Puttock for his help!

% http://lists.gnu.org/archive/html/lilypond-user/2007-08/msg00539.html
% http://lists.gnu.org/archive/html/lilypond-user/2009-09/msg00495.html
% thanks, Neil!!

#(define (grob-name grob)
         (assoc-get 'name
           (assoc-get 'meta
             (ly:grob-basic-properties grob))))


#(define ((alter-curve offsets) grob)
   ;; get default control-points
   (let* (
         (name (grob-name grob))
         (calculator (if (eq? name 'Slur)
                          ly:slur::calc-control-points
                          ly:tie::calc-control-points))
         (coords (calculator grob))
         (n 0))
     ;; add offsets to default coordinates
     (define loop (lambda (n)
                    (set-car! (list-ref coords n)
                              (+ (list-ref offsets (* 2 n))
                                 (car (list-ref coords n))))
                    (set-cdr! (list-ref coords n)
                              (+ (list-ref offsets (1+ (* 2 n)))
                                 (cdr (list-ref coords n))))
                    (if (< n 3)
                        (loop (1+ n)))))
     (if (null? offsets)
         coords
         ;; return altered coordinates
         (begin
           (loop n)
           coords))))


#(define (brokeness-changed grob)
  ;; mark in red color and return defaults:
  (ly:grob-set-property! grob 'color red)
  ((alter-curve '()) grob))


#(define ((shape-curve offsets) grob)
   (let* (
          ;; have we been split?
          (orig (ly:grob-original grob))
          ;; if yes, get the split pieces (our siblings)
          (siblings (if (ly:grob? orig)
                        (ly:spanner-broken-into orig) '() ))
          (total-found (length siblings)))
     (if (>= total-found 2)
         ;; shape BROKEN
         ;; walk through siblings, find index in list
         ;; and apply offsets from list of offsets:
         (let loop ((n 0))
                   (if (eq? (list-ref siblings n) grob)
                       ;; return altered:
                       (if (list? (list-ref offsets n))
                          ((alter-curve (list-ref offsets n)) grob)
                          (brokeness-changed grob))
                       (if (< n total-found)
                           (loop (1+ n))
                           ;; end of list -- none found?!
                           ;; return defaults:
                           ((alter-curve '()) grob))))
         ;;
         ;; shape UNBROKEN
         (if (number? (car offsets))
             ((alter-curve offsets) grob)
             (brokeness-changed grob)))))

shapeSlur =
#(define-music-function (parser location offsets)
                        (list?)
  #{
    \once \override Slur #'control-points = #(shape-curve $offsets)
  #})

shapeTie =
#(define-music-function (parser location offsets)
                        (list?)
  #{
    \once \override Tie #'control-points = #(shape-curve $offsets)
  #})
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


#(set-global-staff-size 24)

\relative c'' {
  \time 6/4
  << {
      a'8 g fis e dis e \acciaccatura e d4. c'8 b4 |
      c4 r2 s2. |
      dis8 b c b a g b2\rest <e gis,>4 |
    } \\ {
      fis,,,8 e' dis e fis b, c4. g8 a4 |
      dis2 r4 s2. |
      b2 r4 r2. |
    } \\ {
      fis4 s2 s2. |
      s8 e'' fis e g fis ~ fis4. gis8 a4 ~ |
      a4 c,2\rest s2. |
    } \\ {
      s1. |
      c8\rest b a g a c dis4. e,8
      % \once \override Tie #'control-points = #'((1 . -2) (2.5 . -2.5) (3.5 . -2.5) (5 . -2))
      \shapeTie#'(() (0 .7  0 .7  0 .7  0 .7))
      fis4 ~ |
      fis4 s2 fis'8 e dis cis dis b |
  } >>
}

\header {
  tagline = ""
}