\version "2.19.30"

#(define (offset-dir o)
   (cond
    ((and (inf? (car o)) (not (inf? (cdr o))))
     (cons (if (> (car o) 0.0) 1.0 -1.0)
       0.0))
    ((inf? (cdr o))
     (cons 0.0
       (if (> (cdr o) 0.0) 1.0 -1.0)))
    ((and (= (car o) 0.0) (= (cdr o) 0.0))
     o)
    (else
     (let ((len (sqrt (+ (* (car o)(car o)) (* (cdr o)(cdr o))))))
       (cons (/ (car o) len) (/ (cdr o) len))))))


#(define (offset-subtract a b)
   (cons (- (car b) (car a))
     (- (cdr b) (cdr a))))

#(define (offset-mul a b)
   (cons (* (car a) (car b))
     (* (cdr a) (cdr b))))

#(define line-interface::make-arrow
   (lambda (beg end thick len width)
     (let* ((dir (offset-dir (offset-subtract beg end)))
            (points (list (cons 0 0)
                      (cons (* -1 len) width)
                      (cons (* -1 len) (* -1 width))))
            (points (map (lambda (p)
                           (offset-add (offset-mul p dir) end)) points)))
       (ly:round-filled-polygon points thick))))

#(define line-interface::arrows
   (lambda (grob from to from-arrow? to-arrow?)
     (let ((stil empty-stencil))
       (if (or from-arrow? to-arrow?)
           (let* ((thick (* (ly:staff-symbol-line-thickness grob)
                           (ly:grob-property grob 'thickness 1.0)))
                  (ss (ly:staff-symbol-staff-space grob))
                  (len (* (ly:grob-property grob 'arrow-length 1.3) ss))
                  (wid (* (ly:grob-property grob 'arrow-width 0.5) ss))
                  (stil empty-stencil)
                  (stil (if to-arrow?
                            (ly:stencil-add stil (line-interface::make-arrow from to thick len wid))
                            stil))
                  (stil (if from-arrow?
                            (ly:stencil-add stil (line-interface::make-arrow to from thick len wid))
                            stil)))
             stil)
           stil))))


#(define lyric-extender::print-with-arrow
   (lambda (grob)
     (let ((heads (ly:grob-object grob 'heads)))
       (if (> (ly:grob-array-length heads) 0)
           (let* ((left-edge (ly:spanner-bound grob LEFT))
                  (right-bound (ly:spanner-bound grob RIGHT))
                  (right-text (ly:grob-object grob 'next))
                  (common left-edge)
                  (common (if (ly:grob? right-text)
                              (ly:grob-common-refpoint common right-text X)
                              common))
                  (common (ly:grob-common-refpoint common right-bound X))
                  (common (ly:grob-common-refpoint common (ly:grob-system grob) X))
                  (sl (ly:output-def-lookup (ly:grob-layout grob) 'line-thickness))
                  (common (ly:grob-common-refpoint-of-array common heads X))
                  (left-point
                   (cond
                    ((grob::has-interface left-edge 'lyric-syllable-interface)
                     (cdr (ly:grob-extent left-edge common X)))
                    ((> (ly:grob-array-length heads) 0)
                     (car (ly:grob-extent (ly:grob-array-ref heads 0) common X)))
                    (else (cdr (ly:grob-extent left-edge common X))))))
             (if (not (inf? left-point))
                 (let* ((minlen (ly:grob-property grob 'minimum-length 0.0))
                        (right-point (+ left-point minlen))
                        (right-point
                         (min right-point
                           (ly:grob-relative-coordinate
                            (ly:spanner-bound (ly:grob-system grob) RIGHT)
                            common X)))
                        (right-point
                         (if (> (ly:grob-array-length heads) 0)
                             (max right-point
                               (cdr (ly:grob-extent
                                     (ly:grob-array-ref heads (1- (ly:grob-array-length heads)))
                                     common X)))
                             right-point))
                        (h (* sl (ly:grob-property grob 'thickness 0.0)))
                        (padding-L (ly:grob-property grob 'left-padding h))
                        (padding-R (ly:grob-property grob 'right-padding h))
                        (right-point
                         (if (ly:grob? right-text)
                             (min right-point
                               (- (car (ly:grob-robust-relative-extent right-text common X))
                                 padding-R))
                             right-point))
                        (right-point
                         (if (= 1 (ly:item-break-dir right-bound))
                             (max right-point
                               (- (car (ly:grob-robust-relative-extent right-bound common X))
                                 padding-R))
                             right-point))
                        (left-point (+ left-point padding-L))
                        (w (- right-point left-point)))
                   (if (>= w (* 1.5 h))
                       (let* ((stil (ly:round-filled-box
                                     (cons 0.0 w) (cons 0.0 h) (* 0.8 h)))
                              (arrow (line-interface::arrows
                                      grob (cons 0 w) (cons w 0) #f #t)) ;; I don't get this.
                              (stil (ly:stencil-add stil arrow)))
                         (ly:stencil-translate-axis stil
                           (- left-point (ly:grob-relative-coordinate grob common X))
                           X))))))))))

\score {
  <<
    \new Voice = "melody" {
      \time 3/4
      f4 g2 ~ |
      g4 e2 ~ |
      e8
    }
    \new Lyrics \lyricsto "melody" {
      %\override LyricExtender.arrow-length = 3
      %\override LyricExtender.arrow-width = 1
      Ky -- ri -- e __
    }
  >>

  \layout {
    \context {
      \Lyrics
      \override LyricExtender.stencil = #lyric-extender::print-with-arrow
    }
  }
}