\version "2.19.22"

%% https://code.google.com/p/lilypond/issues/detail?id=3088
%% Thanks Jan Nieuwenhuizen

%% FIXME: c&p from stencil.scm -- define-public and remove copy
#(define (make-bezier-sandwich-stencil coords thick xext yext)
  (let* ((command-list `(moveto
                        ,(car (list-ref coords 3))
                        ,(cdr (list-ref coords 3))
                        curveto
                        ,(car (list-ref coords 0))
                        ,(cdr (list-ref coords 0))
                        ,(car (list-ref coords 1))
                        ,(cdr (list-ref coords 1))
                        ,(car (list-ref coords 2))
                        ,(cdr (list-ref coords 2))
                        curveto
                        ,(car (list-ref coords 4))
                        ,(cdr (list-ref coords 4))
                        ,(car (list-ref coords 5))
                        ,(cdr (list-ref coords 5))
                        ,(car (list-ref coords 6))
                        ,(cdr (list-ref coords 6))
                        closepath)))
  (ly:make-stencil
    `(path ,thick `(,@' ,command-list) 'round 'round #t)
    xext
    yext)))

%% FIXME: rewrite generic wrt axes and replace make-parenthesis-stencil
#(define (make-bow-stencil width height thickness angularity)
 "Create a bow stencil.
 @var{width} is the width of the bow markup.
 @var{thickness} is the thickness of the bow.
 @var{height} is the heigth of the bow.
 The higher the value of number @var{angularity},
 the more angular the shape of the bow."
   (let* ((line-width 0.1)
          (base-x (if (< width 0) (- width) 0))
          (base-y (if (< height 0) (- height) 0))
          (x-extent (ordered-cons 0 width))
          (y-extent (ordered-cons 0 height))
          (left-x (interval-start x-extent))
          (right-x (interval-end x-extent))
          (inner-y 0)
          (outer-y height)
          (left-end-point (cons left-x inner-y))
          (right-end-point (cons right-x inner-y))
          (outer-control-y (+ inner-y (* 4/3 outer-y)))
          (inner-control-y (+ outer-control-y
                             (if (< height 0) thickness (- thickness))))
          ;; keeping angularity allows for refactoring and
          ;; merging with make-parenthesis-stencil
          (offset-index (- (* 0.6 angularity) 0.8))
          (left-control-x (interval-index x-extent offset-index))
          (right-control-x (interval-index x-extent (- offset-index)))
          (left-outer-control-point
             (cons left-control-x outer-control-y))
          (right-outer-control-point
             (cons right-control-x outer-control-y))
          (right-inner-control-point
             (cons right-control-x inner-control-y))
          (left-inner-control-point
             (cons left-control-x inner-control-y)))

   (make-bezier-sandwich-stencil
     (list right-inner-control-point
           left-inner-control-point
           left-end-point
           right-end-point
           left-outer-control-point
           right-outer-control-point
           right-end-point
           left-end-point)
     line-width
     x-extent
     y-extent)))

%% FIXME: replace make-parenthesis-stencil by this:
#(define (make-parenthesis-stencil height width thick angularity)
  (ly:stencil-rotate-absolute
    (make-bow-stencil height width thick angularity)
    -90 0 0))

%% FIXME: c&p from bezier-bow.cc
#(define (F0_1 x) (* (/ 2 PI) (atan (* PI x 0.5))))
#(define (slur-height w h_inf r_0)
   (F0_1 (* (/ (* w r_0) h_inf) h_inf)))

#(define (make-tie-stencil width thickness direction)
  (let* ((height-limit 1)
         (ratio 0.25)
         (angularity 0.5)
         (height (slur-height width height-limit ratio)))
  (make-bow-stencil width (* direction height) thickness angularity)))

#(define-markup-command (undertie layout props arg)
  (markup?)
#:category font
#:properties ((thickness 1) 
              (offset 2)
              (direction DOWN)
              (adjust-length 0)
              (adjust-x-pos 0))
"
@cindex undertie-ing text

Undertie @var{arg}. Looks at @code{thickness} to determine line
thickness, and @code{offset} to determine line y-offset.

@lilypond[verbatim,quote]
\\markup \\line {
\\undertie \"undertied\"
\\override #'(offset . 5)
\\override #'(thickness . 1)
\\undertie \"undertied\"
\\override #'(offset . 1)
\\override #'(thickness . 5)
\\undertie \"undertied\"
}
@end lilypond"
  (let* ((line-thickness (ly:output-def-lookup layout 'line-thickness))
         (thick (* thickness line-thickness))
         (markup (interpret-markup layout props arg))
         (x1 (car (ly:stencil-extent markup X)))
         (x2 (cdr (ly:stencil-extent markup X)))
         (y2 (cdr (ly:stencil-extent markup Y)))
         (w (- x2 x1 adjust-length (* 2 line-thickness)))
         (y (if (positive? direction)
                (+ line-thickness offset -2 y2)
                (* line-thickness (- offset))))
         (tie (ly:stencil-translate
                (make-tie-stencil w thick direction)
                (cons (+ line-thickness adjust-x-pos) y))))
  (ly:stencil-add markup tie)))
  
%% taken from
%% http://lsr.di.unimi.it/LSR/Item?id=772
%% and rewritten, due to newer syntax possibilities
#(define ((multiple-arts arts) grob)
   (let ((stil (ly:script-interface::print grob)))
     (let loop ((count (1- arts)) (new-stil stil))
       (if (> count 0)
           (loop (1- count)
                 (ly:stencil-combine-at-edge new-stil X RIGHT stil 0.2))
           (ly:stencil-aligned-to new-stil X CENTER)))))

tongue =
#(define-event-function (parser location arts music) (integer? ly:music?)
"Return a @var{arts} articulations."
  #{
    \tweak #'stencil
     #(multiple-arts arts)
    $music
  #})
  
%% a slurred version
slurred-arts =
#(define-event-function (parser location overshoot arts music) 
  ((string? "0.3") integer? ly:music?)
"Return a @var{arts} articulations.
A bow will be printed above (or below) those articulations.
@var{overshoot} determines the horizontal alignment of dots and bow.
Needs to be string, otherwise it can't be made optional.
"
#{
  \tweak #'stencil
  #(lambda (grob)
    (let* ((stil ((multiple-arts arts) grob))
           (stil-x-length (interval-length (ly:stencil-extent stil X)))
           (dir (ly:grob-property grob 'direction))
           (over-shoot (string->number overshoot)))

      (grob-interpret-markup grob 
        #{ 
          \markup 
          %% TODO
          %% the following override should work automagically
          \override #`(offset . ,(if (= dir DOWN) 11.2 2.5))
          \override #`(adjust-x-pos . ,(+ (- over-shoot)(* -0.5 stil-x-length)))
          \undertie
          \pad-x #over-shoot
          \stencil $(centered-stencil stil)
        #})))
    $music
#})

%%%%%%%%%%%%%%%%%%%
%% Example
%%%%%%%%%%%%%%%%%%%

{
  \time 3/4
  \clef "bass" 
  \voiceOne
  \override Script.toward-stem-shift-in-column = 1.0
  \override Script.toward-stem-shift = 1.0
  \repeat tremolo 6 g8\slurred-arts "0.8" #3 -!
  \repeat tremolo 6 f8\slurred-arts #2 -. _\3 
  \repeat tremolo 6 <e g>8\slurred-arts #3 --
  \repeat tremolo 6 dis8\slurred-arts #4 -. \fermata
  \repeat tremolo 6 cis8\slurred-arts #5 -. -"xy"
  \repeat tremolo 6 b,8\slurred-arts #6 -. _2
  \repeat tremolo 6 a,8\slurred-arts #5 -. _\4
  \repeat tremolo 6 ges,8\slurred-arts #4 -. _\fermata
  \repeat tremolo 6 fes,8\slurred-arts #3 -.  _"foo"
  \repeat tremolo 6 e,8\slurred-arts #3 -. -"foo"
  \repeat tremolo 6 e,8\slurred-arts #3 -.
}

{
	%\voiceOne
	\time 2/4
	g16( g')
	g' (-! g')-! 
	%% sometimes needed:
	\override Script.padding = 1
	g'4:16 \slurred-arts #4 -!
	g'2:16 \slurred-arts #8 -!
	g'2:16 
}