%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% http://lsr.dsi.unimi.it/LSR/Snippet?id=639 :
% 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 ((alter-curve offsets) grob)
   ;; get default control-points
   (let ((coords (ly:slur::calc-control-points 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 ((shape-slur 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:
                       ((alter-curve (list-ref offsets n)) grob)
                       (if (< n total-found)
                           (loop (1+ n))
                           ;; end of list -- none found?!
                           ;; return defaults:
                           ((alter-curve '()) grob))))
         ;;
         ;; shape UNBROKEN
         ((alter-curve offsets) grob))))

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

\version "2.13.28"
  
\relative c'' {
  \once \override Slur #'color = #green
  \shapeSlur #'(
    ;; make them funny enough:
    (0 0  1 3  0 4  0 0)
    ;; shorten a bit:
    (2 0  2 0  0 1  0 0))
  c4( b \stemUp <d d'> \stemNeutral c
  \break
  a4 d c b)
  \break
  \once \override Slur #'color = #blue
  \shapeSlur #'(
    (0 0  1 3  0 4  0 0)
    (0 -7  -1 -9  0 -9  0 -4)
    ;; do not touch:
    ()
    (2 0  2 0  0 1  0 0))
  c4( b \stemUp <d d'> \stemNeutral c
  \break
  a4 d c b
  \break
  a4 d c b
  \break
  a4 d c b)
  \break
  % shape unbroken:
  \shapeSlur #'(0 -3  1 1  1 2  0 -3)
  c4( b \stemUp <d d'> \stemNeutral c)
}

\paper {
  indent = 0
  ragged-right = ##t
}

\header {
  tagline = ""
}