\version "2.19.64"

%% https://raw.githubusercontent.com/mwitmer/LyUtil/master/ly/expressive_markings/vibrato.ly
%% Original author: Mark Witmer
%% Rewritten version by Harm

% Returns the width of a grob
#(define (grob-width grob)
  (let ((x-ext (ly:grob-property grob 'X-extent)))
    (if (interval-sane? x-ext)
        (- (cdr x-ext) (car x-ext))
        0)))
    
#(define (apply-proc-to-leading-two-args proc ls rl)
  (if (null? (cdr ls))
      (reverse rl)
      (apply-proc-to-leading-two-args
        proc
        (cdr ls)
        (cons (proc (car ls) (cadr ls)) rl))))

#(define (make-amplitudes-list amplitudes total-span wavelength)
"Makes a list of amplitudes for the vibrato"
  (let* (
         ;; how many waves for the entire total-span
         (lngth (/ total-span wavelength))
         ;; the total-span is divided into parts:
         (parts (1- (length amplitudes)))
         ;; each part gets that much waves
         (partial-length (/ lngth parts))
         ;; get a list of amplitude-pairs, i.e.:
         ;; '(1 2 3 4) -> '((1 . 2) (2 . 3) (3 . 4))
         (amp-pairs
           (apply-proc-to-leading-two-args
             cons
             amplitudes
             '()))
         ;; calculate the amplitudes
         (amplitudes-list
           (append-map
             (lambda (amp-pair)
               (map
                 (lambda (n)
                   (+ (car amp-pair) 
                       (* (/ n partial-length)
                          (- (cdr amp-pair) (car amp-pair)))))
                 (iota (ceiling partial-length))))
              amp-pairs)))
      ;; don't forget last amplitude
      (append amplitudes-list (list (last amplitudes)))))

#(define (wave-line-stencil left-bound x-span thick amplitude-list wave-length) 
"Creates the wave-line for one system of the vibrato using 
@code{make-path-stencil}.
@var{x-span} is the length of the line to do, @var{thick} the thickness of the
drawn line.
Each wave of the resulting line follows the settings provided by 
@var{amplitude-list} for the extent in y-axis and @var{wave-length} for x-axis.
@var{wave-length} is scaled in order to warrant exact matching extents of the
resulting line and @var{x-span}.
"
;; TODO take thickness of line into account?
  (if (zero? x-span)
      empty-stencil
      (let* (;; get the amount of waves which will be needed
             (waves-amount (length amplitude-list))
             ;; the added waves would result in a line with length
             (raw-line-length (* waves-amount wave-length))
             ;; get the factor to scale the provided wave-length to ensure
             ;; matching lengths
             (corr (/ raw-line-length x-span))
             ;; calculate the scaled wave-length
             (scaled-wave-length (/ wave-length corr)))
         (make-path-stencil
           (append
             `(moveto ,left-bound 0.0)
             (append-map
               (lambda (amp)
                 `(rcurveto
                   ,(/ scaled-wave-length 3.0) ,amp 
                   ,(* 2 (/ scaled-wave-length 3.0)) ,(- amp)
                   ,scaled-wave-length 0.0))
               amplitude-list))
            thick
            1
            1
            #f))))

#(define (make-wavy-vibrato-stencil grob amplitudes wave-length)
"Creates a stencil that draws a wavy line for vibrato based on @var{amplitudes},
a list of vertival lengths, and @var{wave-length} for the horizontal extent.
"
  (let* ((orig (ly:grob-original grob))
         (siblings (if (ly:grob? orig) (ly:spanner-broken-into orig) '()))
         (thick (ly:grob-property grob 'thickness 0.2))
         ;; length of the actual grob
         (xspan (grob-width grob))
         ;; add the length of all siblings
         (total-span
           (if (null? siblings)
               (grob-width grob)
               (reduce + 0 (map (lambda (g) (grob-width g)) siblings))))
         ;; get the x-position for the start
         (left-bound 
           (if (or (null? siblings) (eq? (car siblings) grob)) 
               ;; compensate thickness of the line
               (* thick -2)
               ;; start a little left
               (1- (assoc-get 'X (ly:grob-property grob 'left-bound-info)))))
         ;; get the length of the already done parts of the wavy line
         (span-so-far 
           (if (null? siblings) 
               0
               (-
                 (reduce + 0 
                   (map 
                     (lambda (g) (grob-width g)) 
                     (member grob (reverse siblings))))
                 xspan)))
         ;; get the entire list of amplitudes
         (amplitude-list 
           (make-amplitudes-list amplitudes total-span wave-length))
         ;;;; limit the amplitude-list to the needed values
         ;;;; there may be rounding issues
         ;; delete already done amplitudes from 'amplitude-list'-head
         (amplitude-list-tail
            (drop
              amplitude-list
              (inexact->exact (floor (/ span-so-far wave-length)))))
         ;; limit 'amplitude-list-tail' to the actual needed values    
         (amplitude-todo
           (if (zero? (inexact->exact (floor (/ xspan wave-length))))
               amplitude-list-tail
               (take
                 amplitude-list-tail
                 (inexact->exact (ceiling (/ xspan wave-length))))))
         ;; process the final stencil
         (final-stencil
           (wave-line-stencil
             left-bound
             xspan 
             thick
             (if (null? siblings)
                 amplitude-list
                 amplitude-todo)
             wave-length))
         (bound-details
           (ly:grob-property grob 'bound-details))
         ;; bound-details.left.padding affects both broken and unbroken spanner
         ;; whereas bound-details.left-broken.padding only affects the broken
         ;; spanner part (same for right and right-broken)
         ;; We need to move the stencil along x-axis if padding is inserted to
         ;; the left
         (x-offset
           (cond
             ((or (null? siblings) (equal? grob (car siblings)))
               (assoc-get 'padding (assoc-get 'left bound-details '()) 0))
             ((member grob siblings)
               ;; get at least one working value for the offset
               (or (assoc-get 
                     'padding 
                     (assoc-get 'left-broken bound-details '()) 
                     #f)
                   (assoc-get 'padding (assoc-get 'left bound-details '()) 0)))
             (else 0))))

      (ly:stencil-translate-axis
        final-stencil
        ;; TODO
        ;; there's a little inconsistency here, with the need to add some
        ;; correction, i.e. (* thick 2)
        (if (zero? x-offset)
            0
            (- x-offset (* thick 2)))
        X)))

wavyVibrato = 
#(define-music-function (parser location amplitudes wave-length) (list? number?) 
"Overrides @code{TrillSpanner.after-line-breaking}, setting a new stencil,
drawning a wavy line looking at @var{amplitudes} and @var{wave-length}.
Limitations:
  - @var{wave-length} is a constant, it can't be changed dynamically while
    processing one vibrato.
  - Each part of the vibrato (growing or shrinking) is of equal length.
    Would be nice to have something like:
      go from amplitude 1 to 4 while the underlying music lasts a quarter
"
#{  
  \once \override TrillSpanner.after-line-breaking = 
    #(lambda (grob) 
       (ly:grob-set-property! grob 'stencil 
         (make-wavy-vibrato-stencil grob amplitudes wave-length)))
#})

startVibrato = \startTrillSpan
stopVibrato = \stopTrillSpan

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% EXAMPLE
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

m =
\relative c' {
%  \override TrillSpanner.bound-details.left.padding = 3
%  \override TrillSpanner.bound-details.left-broken.padding = 5
%  \override TrillSpanner.bound-details.right.padding = 4
%  \override TrillSpanner.bound-details.right-broken.padding = 6
  
  \wavyVibrato #'(4 0.2 4 0.2 8) #1.5 
  c4\startVibrato d e d 
  c d e d 
  ces\stopVibrato
  \wavyVibrato #'(1 6 2 1 3 17 4 0) #1
  c\startVibrato d e 
  \repeat unfold 15 { d c d e }
  %\break
  c1\stopVibrato
}

\new Staff \m