%{
  shapeXXX.ily
  base include file with typographic tweaks
  modifing the shapes of Bezier curved spanners.
  
  This version works also with line broken curves
  and modifies the shapes of the siblings individually
  
  All functions take a list of lists of 
  eight numbers as argument each (one for each sibling).
  These are four pairs of offsets that are added to the
  four control points of the curve.
  An empt list means that the shape isn't modified.
  
  Exported functions:
  - shapeSlur
  - shapePhrasingSlur
  - shapeTie
  
%}

\version "2.14.0"

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% 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!!

% Functions to alter the shape of slurs and phrasingSlurs

#(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)
  #})


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