\version "2.15.37"

#(define ((offset-control-points offsets function) grob)
  (let ((coords (function grob)))
    (if (null? offsets)
        coords
        (map
          (lambda (x y)
            (coord-translate x y))
          coords offsets))))

#(define ((shape-curve offsets function location) grob)
   (let* ((orig (ly:grob-original grob))
          (siblings (if (ly:grob? orig)
                        (ly:spanner-broken-into orig) '() ))
          (total-found (length siblings))
          (grob-name
            (assoc-get 'name
              (assoc-get 'meta
                (ly:grob-basic-properties grob)))))

     (define (helper sibs offs)
       (if (and (eq? (car sibs) grob)
                (pair? offs))
           ((offset-control-points (car offs) function) grob)
           (if (pair? offs)
               (helper (cdr sibs) (cdr offs))
               ((offset-control-points '() function) grob))))

     ; standardize input so #'((dx1 . dy1) . . . )
     ; and #'( ((dx1 . dy1) . . . ) ) possible
     (if (not (list? (car offsets)))
         (set! offsets (list offsets)))
         
     ; warnings
     (if (not (= (length offsets) total-found))
         (if (zero? total-found)
             (if (pair? (cdr offsets))
                 (begin
                   ;(set! (ly:grob-property grob 'color) red)
		   (ly:input-warning location
		     "~a is unbroken, modifications for ~a pieces requested"
		       grob-name (length offsets))))
             (if (eq? (last siblings) grob) ; print warning only once
                 (begin
                   ;(for-each
                     ;(lambda (piece) (set! (ly:grob-property piece 'color) red))
                     ;siblings) 
                 (ly:input-warning location
                   "~a is broken into ~a pieces, modifications for ~a requested"
                     grob-name total-found (length offsets))))))
                     
     (if (>= total-found 2)
         (helper siblings offsets)
         ((offset-control-points (car offsets) function) grob))))

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

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

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

%% SLURS

\markup {
  \underline "Default Slurs"
}

\relative c'' {
  d4( d' b g g,8 f' e d c2)
  \bar "||"
  d4( d' b g
  \break
  g,8 f' e d c2)
}

\markup {
  \underline "Modified"
}

\relative c'' {
  %% UNBROKEN
  %% remove semicolon to see warning
  \shapeSlur #'(
    ((0 . -2.5) (-1 . 3.5) (0 . 0) (0 . -2.5))
    ;()
    )
  d4( d' b g g,8  f' e d c2)
  \bar "||"

  %% BROKEN
  %% warning will show
  \shapeSlur #'(
    ((0 . -2.5) (0 . 1.5) (0 . 1) (0 . -1))
    ()
    ()
    )

  d4(^"(1st half only)" d' b g
  \break
  g,8 f' e d c2)
  \bar "||"

  %% both halves of the slur are modified
  \shapeSlur #'(
    ((0 . -2.5) (0 . 1.5) (0 . 1) (0 . -1))
    ((1 . 2) (0 . 1) (0 . 1) (0 . 0))
    )
  d4(^"(both halves)" d' b g
  \break
  g,8 f' e d c2)
}

%% TIES

\relative c'' {
  cis1~
  cis
  \shapeTie #'((0 . 0) (0 . 1) (0 . 1) (0 . 0))
  cis~
  cis
  \shapeTie #'((0 . 0) (0 . 1) (0 . 1) (0 . 0))
  cis~
  \break
  cis
  \break
  \shapeTie #'(
    ()
    ((-0.25 . 0) (0 . -0.25) (0 . -0.25) (0 . -1))
    )
  cis~
  \break
  cis
}

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