%{
  shapeXXX.ily
  base include file with typographic tweaks
  modifing the shapes of Bezier curved spanners.
  
  Provided by Urs Liska (address@hidden)
  
  Exported functions:
  - shapeSlur
  - shapePhrasingSlur
  - shapeTie
  
  This version works also with line broken curves
  and modifies the shapes of the siblings individually
  
  Usage: \shapeXXX (offsets) music
  offset is a list of eight numbers indicating the x and y offsets
  for the four control-points of the curve
  for each part of a broken slur one can give a separate list.
  An empty list means that the respective slur isn't altered
  
  in contrast to overriding the control-points property
  this function takes offsets relative to LilyPond's 
  default decision. So the function can often be left
  unaltered even when the layout changes slightly
  
  example for a single slur:
    \shapeSlur #'( 0 0  3 -1  6 2  -5 0 ) ...
  example for a broken phrasing slur
    \shapePhrasingSlur #'(
      (0 1  0 0  0 -4  0 2)
      (4 3  2 5  -1 4  0 0)
      () % Don't change the third part
      ) ...  
  
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  
  The first version of a shapeSlur function was developed by Neil Puttock
    (see http://lists.gnu.org/archive/html/lilypond-user/2009-09/msg00495.html)
  Another version was added to the Lilypond Snippet Repository
    (see http://lsr.dsi.unimi.it/LSR/Snippet?id=639)
  Later the function was enhanced to deal with broken slurs
  by Dmytro O. Redchuk and David Nalesnik (don't know exactly how)
    (see http://permalink.gmane.org/gmane.comp.gnu.lilypond.general/65612)
  With the help of the lilypond-user mailing list I finally 
  adapted the function to also work with Ties and polished the file to 
  export the three functions
  
  One thing which is still missing is the ability of the function to
  automatically react when a slur is broken / unbroken 
  as a reaction to changed line breaks
  
  At the moment (August 2011) there seems to be a discussion about 
  whether to include this function to the LSR or the docs
  or even to LilyPond
  
%}

\version "2.14.0"


#(define ((alter-slur-curve offsets) grob)
   ;; get default control-points
   (let ((coords (ly:slur::calc-control-points grob)))
     ;; add offsets to default coordinates
     (define (add-offsets coords offsets)
       (if (null? coords)
       '()
       (cons
         (cons (+ (caar coords) (car offsets))
               (+ (cdar coords) (cadr offsets)))
         (add-offsets (cdr coords) (cddr offsets)))))

     (if (null? offsets)
         coords
         (add-offsets coords offsets))))


#(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-slur-curve (list-ref offsets n)) grob)
                       (if (< n total-found)
                           (loop (1+ n))
                           ;; end of list -- none found?!
                           ;; return defaults:
                           ((alter-slur-curve '()) grob))))
         ;;
         ;; shape UNBROKEN
         ((alter-slur-curve offsets) grob))))

% Changed function to shape ties

#(define ((alter-tie-curve offsets) grob)
   ;; get default control-points
   (let ((coords (ly:tie::calc-control-points grob)))
     ;; add offsets to default coordinates
     (define (add-offsets coords offsets)
       (if (null? coords)
       '()
       (cons
         (cons (+ (caar coords) (car offsets))
               (+ (cdar coords) (cadr offsets)))
         (add-offsets (cdr coords) (cddr offsets)))))

     (if (null? offsets)
         coords
         (add-offsets coords offsets))))


#(define ((shape-tie 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-tie-curve (list-ref offsets n)) grob)
                       (if (< n total-found)
                           (loop (1+ n))
                           ;; end of list -- none found?!
                           ;; return defaults:
                           ((alter-tie-curve '()) grob))))
         ;;
         ;; shape UNBROKEN
         ((alter-tie-curve offsets) grob))))


shapePhrasingSlur =
#(define-music-function (parser location offsets)
                        (list?)
  #{
    \once \override PhrasingSlur #'control-points = #(shape-slur offsets)
  #})


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

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


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