\version "2.19.82"

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%%  GLISSANDI, DEFAULT AND BETWEEN FINGERINGS
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%% Thanks to David Nalesnik

%% See
%% http://lilypond.1069038.n5.nabble.com/Glissando-on-single-note-in-chords-tt34672.html#a34676
%%
%% http://lists.gnu.org/archive/html/lilypond-user/2019-02/msg00109.html

%% Glissandi should be set/selected via 'glissandoMap'
%% which may take additional pairs of string-numbers
%% i.e. a setting like:
%% '((0 . 0) (1 . 1) ("0" . "0") ("1" . "1"))
%% prints Glissadi between the first and the second (typed) note of two chords.
%% This is the default anyway.
%% If the new context-property 'fingerSlide' is set #t, additional Glissandi
%% will be printed between the fingerings of the first and the second (typed) 
%% note of two chords.
%% For missing fingerings the NoteHead is taken instead.
%%
%% Bow-like Glissandi are printed for
%%   \once \override Glissando.stencil = #(finger-gliss-bow-stencil '(4))
%% The optional number-list, here '(4), may serve to further select which bows
%% are done. This happens via glissando-index.
%%
%% The bow is further customizable modifing the newly introduced
%%   Glissando.bound-details.left/right.y-padding 
%%      (a numerical value, default is 1)
%%
%% Glissando-stubs are possible with 'finger-gliss-stub-stencil' taking
%% optional arguments for left and/or right stubs and for further selection 
%% (like finger-gliss-bow-stencil)
%% The length of the stubs is settable, with an override for 
%%   Glissando.bound-details.left/right.left/right-gliss-stub 
%%      (a numerical value, default is 0.6)
%%
%% The other known subproperties of Glissando.bound-details may still be 
%% modified.
%%
%% The provided music-function 'detailedGlissando' may be used to
%% determine which of the various styles should be used for which glissando.


#(define (define-translator-property symbol type? description)
  (if (not (and (symbol? symbol)
	            (procedure? type?)
	            (string? description)))
      (ly:error "error in call of define-translator-property"))
  (if (not (equal? (object-property symbol 'translation-doc) #f))
      (ly:error (_ "symbol ~S redefined") symbol))

  (set-object-property! symbol 'translation-type? type?)
  (set-object-property! symbol 'translation-doc description)
  symbol)

#(for-each
  (lambda (x)
    (apply define-translator-property x))
    `((fingerSlide
       ,boolean?
       "Should printing Glissandi between Fingerings be possible?")))
       
%% TODO
%% Join the two stencil-procedures below.
%% Make them available not only for Fingering-Glissando, but for every Glissando

#(define* 
  (finger-gliss-bow-stencil #:optional (which '()))
  (lambda (grob)
  "Prints a bow-like Glissando, instead of a line. 
  Available for Fingerings only.
  If applied as a general Glissando-override, the optional @var{which} may be
  used to do further selection."
    (let* ((gliss-count (ly:grob-property grob 'glissando-index))
           (left-bound (ly:spanner-bound grob LEFT))
           (right-bound (ly:spanner-bound grob right)))
      ;; Print bows only if left or right bound is a Fingering
      ;;   limited to Glissando with one line-break, ofcourse
      ;; To further select look at 'which':
      ;;   If empty print allways bows
      ;;   Otherwise compare with glissando-index: print if matching
      (if (and (or (grob::has-interface left-bound 'finger-interface)
                   (grob::has-interface right-bound 'finger-interface))
               (or (member gliss-count which)
                   (null? which)))
          (let* ((sign 
                   (lambda (x)
                     (if (= x 0)
                         0
                         (if (< x 0) -1 1))))
                 (sys (ly:grob-system grob))
                 (left-coord (ly:grob-relative-coordinate left-bound sys X))
                 (right-coord (ly:grob-relative-coordinate right-bound sys X))
                 (left-bound-info (ly:grob-property grob 'left-bound-info))
                 (left-padding (assoc-get 'padding left-bound-info))
                 (Y-left (assoc-get 'Y left-bound-info))
                 (X-left (assoc-get 'X left-bound-info))
                 (y-left-padding (assoc-get 'y-padding left-bound-info 1))
                 (right-bound-info (ly:grob-property grob 'right-bound-info))
                 (Y-right (assoc-get 'Y right-bound-info))
                 (right-padding (assoc-get 'padding right-bound-info))
                 (X-right (assoc-get 'X right-bound-info))
                 (y-right-padding (assoc-get 'y-padding right-bound-info 1))
                 (thick (ly:grob-property grob 'thickness 0.12)))
            (make-tie-stencil 
              (cons (- X-left left-coord left-padding) 
                    (+ Y-left (* y-left-padding (sign Y-left))))
              (cons (- X-right left-coord (- right-padding)) 
                    (+ Y-right (* y-right-padding (sign Y-left))))
              thick
              ;; TODO this condition is not always sufficient to correctly
              ;; set the bow's direction.
              (if (negative? Y-left) DOWN UP)))
          (ly:line-spanner::print grob)))))
          
#(define* 
  (finger-gliss-stub-stencil #:optional (what '(left right)) (which '()))
  (lambda (grob)
  "Prints Glissando-stubs, instead of a line. The length of the stubs can be
  modified by an override for bound-details.left/right.left/right-gliss-stub,
  default is 0.6.
  The optional @var{what} determines whether stubs are printed left/right or
  on both sides. Default is '(left right), i.e. printing both sides.
  Available for Fingerings only.
  If applied as a general Glissando-override, the optional @var{which} may be
  used to do further selection."
    (let* ((gliss-count (ly:grob-property grob 'glissando-index))
           (left-bound (ly:spanner-bound grob LEFT))
           (right-bound (ly:spanner-bound grob right)))
      ;; Print bows only if left or right bound is a Fingering
      ;;   limited to Glissando with one line-break, ofcourse
      ;; To further select, look at 'which':
      ;;   If empty print allways bows
      ;;   Otherwise compare with glissando-index: print if matching
      (if (and (or (grob::has-interface left-bound 'finger-interface)
                   (grob::has-interface right-bound 'finger-interface))
               (or (member gliss-count which)
                   (null? which)))
          (let* ((sign 
                   (lambda (x)
                     (if (= x 0)
                         0
                         (if (< x 0) -1 1))))
                 (sys (ly:grob-system grob))
                 (left-coord (ly:grob-relative-coordinate left-bound sys X))
                 (right-coord (ly:grob-relative-coordinate right-bound sys X))
                 
                 (left-bound-info (ly:grob-property grob 'left-bound-info))
                 (left-padding (assoc-get 'padding left-bound-info))
                 (Y-left (assoc-get 'Y left-bound-info))
                 (X-left (assoc-get 'X left-bound-info))
                 (y-left-padding (assoc-get 'y-padding left-bound-info 0))
                 (left-gliss-stub
                   (assoc-get 'left-gliss-stub left-bound-info 0.6))
                 
                 (right-bound-info (ly:grob-property grob 'right-bound-info))
                 (Y-right (assoc-get 'Y right-bound-info))
                 (right-padding (assoc-get 'padding right-bound-info))
                 (X-right (assoc-get 'X right-bound-info))
                 (y-right-padding (assoc-get 'y-padding right-bound-info 0))
                 (right-gliss-stub
                   (assoc-get 'right-gliss-stub right-bound-info 0.6))
                 
                 (thick (ly:grob-property grob 'thickness 0.12))
                 (x-gliss-start 
                   (- X-left left-coord (- 0.2 left-padding)))
                 (x-gliss-end
                   (- X-right left-coord (- 0.8 right-padding)))
                 (y-gliss-start
                   (+ Y-left (* y-left-padding (sign Y-left))))
                 (y-gliss-end
                   (+ Y-right (* y-right-padding (sign Y-left))))
                 (glissando-x-length
                   (-
                     x-gliss-end
                     x-gliss-start))
                 (glissando-y-height
                   (-
                     y-gliss-end
                     y-gliss-start))
                 (gliss-hint 1)
                 (gradient
                   (/ 
                      glissando-y-height
                      glissando-x-length))
                 (left-stub-stil
                   (if (and (grob::has-interface left-bound 'finger-interface)
                            (member 'left what))
                       (make-line-stencil 
                         thick 
                         x-gliss-start
                         y-gliss-start
                         (+ x-gliss-start left-gliss-stub)
                         (+ y-gliss-start (* left-gliss-stub gradient)))
                         empty-stencil))
                 (right-stub-stil
                   (if (and (grob::has-interface right-bound 'finger-interface)
                            (member 'right what))
                       (make-line-stencil 
                         thick 
                         (- x-gliss-end right-gliss-stub)
                         (- y-gliss-end (* right-gliss-stub gradient))
                         x-gliss-end
                         y-gliss-end)
                       empty-stencil)))
 
            (ly:stencil-add
              ;; colored entire line-stencil, for debugging purpose
              ;(stencil-with-color
              ;  (make-line-stencil 
              ;    thick 
              ;    x-gliss-start
              ;    y-gliss-start
              ;    x-gliss-end
              ;    y-gliss-end)
              ;  yellow)
              left-stub-stil
              right-stub-stil))
          (ly:line-spanner::print grob)))))
          
detailedGlissando =
#(define-music-function (index-style-alist)(list?)
"Prints Glissandi according to the provided @var{index-style-alist}, which is
supposed to be a list of pairs, each containing the glissando-index and the
style in which the glissando should be printed.
Possible styles are:
The defaults ones: none, line, zigzag, trill, dashed-line, dotted-line
Additional ones: bow, stub-left, stub-right, stub-both
The additional ones work for finger-glissando only.

Example for @var{index-style-alist}:
  '((0 . zigzag)
    (1 . trill)
    (2 . dashed-line)
    (3 . dotted-line)
    (4 . line)
    (5 . none)
    (6 . stub-both)
    (7 . stub-left)
    (8 . stub-right)
    (9 . bow))
"
#{
  \override Glissando.stencil =
  #(lambda (grob)
    (let* ((gliss-index (ly:grob-property grob 'glissando-index))
           (custom-style (assoc-get gliss-index index-style-alist)))
      (case custom-style
       ((stub-both)
         (finger-gliss-stub-stencil))
       ((stub-left)
         (finger-gliss-stub-stencil '(left) '()))
       ((stub-right)
         (finger-gliss-stub-stencil '(right) '()))
       ((bow) ((finger-gliss-bow-stencil)  grob))
       (else 
         (begin
           (ly:grob-set-property! grob 'style (or custom-style 'line))
           (ly:line-spanner::print grob))))))
#})
   
fingeringSlideEngraver =
#(lambda (context)
   (let ((glissandi '())
         (finger-gliss-mappings '())
         (fingerings '()))
     (make-engraver
       (listeners 
         ((glissando-event engraver event)
           (let* ((gliss-map (ly:context-property context 'glissandoMap))
                  (finger-slide? (ly:context-property context 'fingerSlide #f))
                  (divided-gliss
                    (call-with-values
                      (lambda () (partition number-pair? gliss-map))
                      (lambda (x y) (list x y))))
                  (additional-gliss-mappings
                    (map
                      (lambda (p)
                        (cons
                          (string->number (car p))
                          (string->number (cdr p))))
                    (cadr divided-gliss))))
             (if finger-slide?
                 (begin
                   (set! finger-gliss-mappings 
                         (cons additional-gliss-mappings finger-gliss-mappings))
                   (ly:context-set-property! context 'glissandoMap
                     (append (car divided-gliss) additional-gliss-mappings)))
                 (ly:context-set-property! context 'glissandoMap 
                   (car divided-gliss))))))
       (acknowledgers
         ((glissando-interface engraver grob source-engraver)
           (let* ((details (ly:grob-property grob 'details))
                  (finger-slide? (ly:context-property context 'fingerSlide #f)))
             (if finger-slide?
                 (set! glissandi (cons grob glissandi)))))
         ((finger-interface engraver grob source-engraver)
           (set! fingerings (cons grob fingerings))))
       ((stop-translation-timestep translator)
         (if (and (pair? finger-gliss-mappings) (pair? glissandi))
             (for-each 
               (lambda (gliss)
                 (for-each 
                   (lambda (finger)
                     (if (eq? (ly:spanner-bound gliss LEFT)
                              (ly:grob-parent finger X))
                         (ly:spanner-set-bound! gliss LEFT finger))
                     (if (eq? (ly:spanner-bound gliss RIGHT)
                              (ly:grob-parent finger X))
                         (ly:spanner-set-bound! gliss RIGHT finger)))
                   fingerings))
               (take glissandi (length (car finger-gliss-mappings)))))
         (set! fingerings '()))
     ((finalize translator)
      (set! glissandi '())
      (set! finger-gliss-mappings '())))))
         
\layout {
  \context {
    \Voice
    \consists \fingeringSlideEngraver
    \override Glissando.springs-and-rods = #ly:spanner::set-spacing-rods
    \override Glissando.minimum-length = 5 %% adjust  to taste.
    
    %% Uncommenting this line triggers the TODO in finger-gliss-bow-stencil
    %\override Fingering #'staff-padding = #'()
  }
}

selectionHelper =
\override Glissando.after-line-breaking =
  #(lambda (grob)
     (let* ((gliss-idx (ly:grob-property grob 'glissando-index))
            (clr-ls (circular-list 'red 'yellow 'green 'blue 'cyan))
            (clr (list-ref clr-ls gliss-idx)))
       (ly:grob-set-property! grob 'color (x11-color clr))
       (format #t "\ncolor is: ~a,   \tglissando-index is: ~a" clr gliss-idx)))
       
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% EXAMPLES
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

#(set-global-staff-size 18)

%#(ly:set-option 'debug-skylines #t)

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

\layout {
  \context {
    \Score
    \override RehearsalMark.self-alignment-X = #LEFT
  }
}

m = \relative c'' {
  \set glissandoMap = 
     #'((0 . 0) (1 . 1) ("0" . "0") ("1" . "1" ) ("1" . "2" ))

  <fis-2 d'-4>4\glissando
  <g,-2 d'-4 f'-3>
  
  \set glissandoMap = #'(("0" . "0"))
  fis4-2\glissando d'-4
  
  \set glissandoMap = #'((1 . 1) ("0" . "0"))
  % \once \override Glissando.bound-details.left.y-padding = 1.5
  % \once \override Glissando.bound-details.right.y-padding = 1.5
  <fis-1 d'-3>4\glissando
  <g'-1 d'-3>
  r2
  \bar "||"
  \break
}

{
  \mark "Default (with settings for glissandoMap)"
  \m
  
  \mark "Slides for fingerings activated"
  \set fingerSlide = ##t
  \m
  
  
  \mark "Slides for fingerings activated, print them as bows"
  %% for completeness (actually not needed, it is #t from before)
  \set fingerSlide = ##t 
  \override Glissando.stencil = #(finger-gliss-bow-stencil)
  \m
  
  \mark "Bow-selection, revert bows, unset fingerSlide"
  %% TODO
  %% Bow selection is not convenient. It works via 'glissando-index:
  %% first glissando-indices are for the default glissandi, then the 
  %% finger-glissandi are counted, i.e. in chords with two printed default
  %% glissandi, their glissando-indeces are 0 and 1, the first finger-glissando
  %% is then 2, obviously this will change if three default glissandi are 
  %% printed.
  %% For now 'selectionHelper' may be used to facilitate selection.
  %%
  %% Remark: the simultaneous music in this example is not needed, less typing
  %% then spelling it all out, though
  
  <<
  	%\once \selectionHelper
  	\m
  	{
  	  \once \override Glissando.stencil = #(finger-gliss-bow-stencil '(4))
  	  s2
  	  \revert Glissando.stencil
  	  s2
  	  \unset fingerSlide
  	  s1
  	}
  >>
  
  \mark "Line-breaks and skipping NoteColumns, with bows"
  \set fingerSlide = ##t
  
  \set glissandoMap = #'((1 . 1) ("1" . "1"))
  \override Glissando.stencil = #(finger-gliss-bow-stencil)
  %\revert Glissando.stencil
  \override Glissando.breakable = ##t
  \override Glissando.after-line-breaking = ##f
  <fis''-2 d'''-4>1\glissando
  \once \override NoteColumn.glissando-skip = ##t
  <g'-2 d''-4>
  \break
  s2 <gis''-1 e'''-3>2
  \bar "||"
  \break
  
  \mark "Line-breaks and skipping NoteColumns, with Glissando-stubs"
  \set fingerSlide = ##t
  \override Glissando.breakable = ##t
  \override Glissando.after-line-breaking = ##f
  \detailedGlissando #'((1 . stub-both))
  \set glissandoMap = #'((1 . 1) ("1" . "1"))
  
  <fis''-2 d'''-4>1\glissando
  \once \override NoteColumn.glissando-skip = ##t
  <g'-2 d''-4>
  \break
  s2 <gis''-1 e'''-3>2
  \bar "||"
  
  \break
  
  \mark "Back to default"
  \break
  \unset fingerSlide
  \revert Glissando.stencil
  \m
  \break
  
  \mark "All in one"
  	  
  \set fingerSlide = ##t
  \override Glissando.minimum-length = 10 %% adjust  to taste.
  \override Glissando.dash-period = #0.5
  \once
    \detailedGlissando
      #'(
         ;; styles for glissandi beetween NoteHeads, from bottom to top
         ;; N.B. NoteHead-Glissando only!
         (0 . zigzag)
         (1 . trill)
         (2 . dashed-line)
         (3 . dotted-line)
         (4 . line)
         (5 . line)
         ;; styles for glissandi beetween Fingerings, from bottom to top
         ;; N.B. Finger-Glissando only!
         (6 . line)
         (7 . stub-both)
         (8 . stub-left)
         (9 . stub-right)
         (10 . zigzag)
         (11 . bow))
    
  %\once \selectionHelper
  \set glissandoMap = 
     #'((0 . 0) (1 . 1) (2 . 2) (3 . 3)(4 . 4) (5 . 5)
        ("0" . "0") ("1" . "1" ) ("2" . "2") ("3" . "3")("4" . "4")("5" . "5"))
  <a-1 d'-2 fis'-3 d''-4 fis''-5 a''-6>2\glissando
  <g-1 d'-2 g'-3  fis''-4 a''-5 d'''-6>
}

%% The original example
{
  \revert Glissando.minimum-length
  \voiceOne
  \override Fingering.add-stem-support = ##t
  \acciaccatura {
    e''16 
    %% some custom-tweakings
    \once \override Glissando.bound-details.left.padding = 0.3
    \once \override Glissando.bound-details.left.y-padding = 0.7
    \once \override Glissando.bound-details.right.y-padding = 0.8
    %% Activate the possibility to draw "Finger-Glissandi"
    \set fingerSlide = ##t
    %% Add a Glissando (which is supposed to be printed between Fingerings)
    %% to the default ones (here the defaults are excluded)
    \set glissandoMap = #'(("0" . "0"))
    %% Set the Glissando-style for it
    \detailedGlissando #'((0 . bow))
    <f''-1>\glissando
  }
  <e''-1>8
}