\version "2.22.0" % "2.23.3"

%% rewritten by Aaron Hill, many thanks!
%% https://lists.gnu.org/archive/html/lilypond-user/2021-10/msg00354.html

%% Comments/TODOs/amendments by Harm

\paper {
  indent = 0
  ragged-right = ##f
  line-width = 120
}

\layout {
  \context {
    \Voice
    \override Glissando.layer = 1000
    \override Glissando.bound-details.left.padding =  5
    \override Glissando.bound-details.right.padding = 5
    \override Glissando.breakable = ##t
  }
}

%% cross stencil
#(define*
   (make-cross-stencil coords #:optional (thick 0.1) (sz 0.2))
   (ly:stencil-add
     (make-line-stencil
       thick
       (- (car coords) sz)
       (- (cdr coords) sz)
       (+ (car coords) sz)
       (+ (cdr coords) sz))
     (make-line-stencil
       thick
       (- (car coords) sz)
       (+ (cdr coords) sz)
       (+ (car coords) sz)
       (- (cdr coords) sz))))

%% glissando stencil
#(define glissando-stencil-proc (lambda (grob) (ly:line-spanner::print grob)))

%% get start/end points
#(define gliss-data
  (lambda (grob)
    (let* ((simple-y? (and (ly:grob-property grob 'simple-Y)
                           (not (ly:grob-property grob 'cross-staff))))
           (lbi (ly:grob-property grob 'left-bound-info))
           (rbi (ly:grob-property grob 'right-bound-info))
;;;;;;;;;;;
;; TODO (1)
;;;;;;;;;;;
;;  Common refpoint of the spanner-bounds is already grob System
;;  Why searching again, doesn't it will return grob System again?
;;  Is there any ly-counter-example?
;;  See the test-code below inside `pretty-print'
           (common-x (ly:grob-common-refpoint grob
                      (ly:grob-common-refpoint
                       (ly:spanner-bound grob LEFT)
                       (ly:spanner-bound grob RIGHT) X) X))
           (scaling (magstep (ly:grob-property grob 'font-size 0)))
           (left-padding (ly:assoc-get 'padding lbi 0))
           (left-stencil (ly:assoc-get 'stencil lbi #f))
           (left-common-y (ly:assoc-get 'common-y lbi grob))
           (right-padding (ly:assoc-get 'padding rbi 0))
           (right-stencil (ly:assoc-get 'stencil rbi #f))
           (right-common-y (ly:assoc-get 'common-y rbi grob))
           (common-y (ly:grob-common-refpoint left-common-y right-common-y Y))
           (normalized-endpoints
             (ly:grob-property grob 'normalized-endpoints '(0 . 1)))
           (span-left-x (ly:assoc-get 'X lbi 0))
           (span-left-y (ly:assoc-get 'Y lbi 0))
           (span-right-x (ly:assoc-get 'X rbi 0))
           (span-right-y (ly:assoc-get 'Y rbi 0))
           (original-grob (ly:grob-original grob))
           (siblings (ly:spanner-broken-into original-grob)))

      ;; Take relative coords in X/Y direction into account.
      ;; This needs to come before other modifications of x/y values!
      ;; Especially `dy-right' is important for cross-staff spanners
      (let* ((dx (ly:grob-relative-coordinate grob common-x X))
;;;;;;;;;;;
;; TODO (2)
;;;;;;;;;;;
;;  Do we need to calculate `dy' at all?
;;  Will (ly:grob-relative-coordinate grob common-y Y) ever be not zero, if
;;  grob and common-Y are equal?
;;  Is it possible at all they are ever unequal? ly-counter-example?!
             (dy (if simple-y?
                     0
                     (ly:grob-relative-coordinate grob common-y Y)))
;;;;;;;;;;;
;; TODO (1)
;;;;;;;;;;;
;; Why call (ly:grob-system grob)?
;; Afaict, it's the same as `common-x' form above (and see TODO there and
;; test-code inside of `pretty-print' below)
             (system (ly:grob-system grob))
             ;; Line-breaking cross-staff Glissandi need more complex
             ;; conditions/djustments. 
             ;; TODO Already sufficient?
             (dy-right 
               (cond ((or (equal? grob original-grob)
                          (and (pair? siblings)
                               (equal? grob (last siblings))))
                      (ly:grob-relative-coordinate grob system Y))
                     (else 0))))
;; test-code
;(pretty-print
;  (let* ((bounds-refpt-X
;           (ly:grob-common-refpoint
;             (ly:spanner-bound grob LEFT)
;             (ly:spanner-bound grob RIGHT)
;             X))
;         (common-X
;           (ly:grob-common-refpoint
;             grob
;             bounds-refpt-X
;             X))
;         (sys (ly:grob-system grob))
;         (lst (list bounds-refpt-X common-X sys))
;             )
;    (delete-duplicates lst equal?)
;  )
;)
        (set! span-left-x (- span-left-x dx))
        (set! span-left-y (- span-left-y dy))
        (set! span-right-x (- span-right-x dx))
        (set! span-right-y (- span-right-y dy dy-right)))

;;;;;;;;;;;
;; TODO (3)
;;;;;;;;;;;
;; Is there any need to modify `span-left-y' and `span-right-y' wrt to
;; `simple-y?'
;; In all tested cases `span-left-y' and `span-right-y' keep their value, see:
;;
; (pretty-print
;   (list
;     (ly:grob-relative-coordinate left-common-y common-y Y)
;     (ly:grob-relative-coordinate right-common-y common-y Y)
;   )
; )
;; Is there any counter-example?
      (if (not simple-y?)
          (begin
            (set! span-left-y (+ span-left-y
              (ly:grob-relative-coordinate left-common-y common-y Y)))
            (set! span-right-y (+ span-right-y
              (ly:grob-relative-coordinate right-common-y common-y Y)))))

      ;; For broken Spanner modify `span-left-y' and `span-right-y' with scaled
      ;; parts of `y-length'. The scaling factors are taken from the pair
      ;; `normalized-endpoints', car for left, cdr for right.
      ;; For unbroken Glissandi `normalized-endpoints' defaults to '(0 . 1)
      ;; and `span-left-y' and `span-right-y' stay unchanged then
      (let ((y-length (- span-right-y span-left-y)))
        (set! span-left-y (+ span-left-y
          (* (car normalized-endpoints) y-length)))
        (set! span-right-y (- span-right-y
          (* (- 1 (cdr normalized-endpoints)) y-length))))

      ;; Take into account:
      ;;  - padding vaues
      ;;  - (text-)stencils
      (let* ((span-dx (- span-right-x span-left-x))
             (span-dy (- span-right-y span-left-y))
             ;; Avoid "Pythagorean theorem", use ly:length instead
             (span-length (ly:length span-dx span-dy)))
       (if (> (+ left-padding right-padding) span-length)
           ;; If padding is large enough that the spanner disappears, return '()
           ;; NB needs to be checked by the caller of this procedure
           '()
           (let* (;; the cosinus of the enclosed angle
                  (grad-dx (/ span-dx span-length))
                  ;; the sinus of the enclosed angle
                  (grad-dy (/ span-dy span-length)))
             ;; cosinus and sinus of the enclosed angle are constants, where the
             ;; x and y-values are due to radius 1
             ;; To respect left/right-padding values, which are on that radius,
             ;; we need to modify our span-left/right-x/y values:
             ;; Simply multiply the relevant padding with (co)sinus, i.e.
             ;; `grad-dx' resp. `grad-dy' following the "Intercept theorem"
             ;; (Don't forget `scaling' for possible (text-)stencils).
             ;;
             (set! span-left-x
                   (+ span-left-x (* left-padding scaling grad-dx)))
             (set! span-left-y
                   (+ span-left-y (* left-padding scaling grad-dy)))
             (set! span-right-x
                   (- span-right-x (* right-padding scaling grad-dx)))
             (set! span-right-y
                   (- span-right-y (* right-padding scaling grad-dy)))
             ;; If a (text-)stencil is present at start/end of the spanner,
             ;; the relevant x/x values needs to get modified
             (if (and (ly:stencil? left-stencil)
                      (not (ly:stencil-empty? left-stencil)))
                 (let ((factor
                         (/ (cdr (ly:stencil-extent left-stencil X)) grad-dx)))
                   (set! span-left-x (+ span-left-x (* factor grad-dx)))
                   (set! span-left-y (+ span-left-y (* factor grad-dy)))))

             (if (and (ly:stencil? right-stencil)
                      (not (ly:stencil-empty? right-stencil)))
                 (let ((factor
                         (/ (car (ly:stencil-extent right-stencil X)) grad-dx)))
                   (set! span-right-x (+ span-right-x (* factor grad-dx)))
                   (set! span-right-y (+ span-right-y (* factor grad-dy)))))

               (cons (cons span-left-x span-left-y)
                     (cons span-right-x span-right-y))))))))

#(define gliss-stencil-with-crosses
  (lambda (grob)
    (let* ((cross-coords (gliss-data grob)))
      (ly:stencil-add
        ;; left cross
        (stencil-with-color
          (make-cross-stencil (car cross-coords) 0.2 0.2) blue)
        ;; right cross
        (stencil-with-color
          (make-cross-stencil (cdr cross-coords) 0.2 0.2) red)
        ;; glissando
        (stencil-with-color (glissando-stencil-proc grob) magenta)))))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Examples
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%% flat

{
  \set Staff.instrumentName = "flat "
  \override Glissando.stencil = #gliss-stencil-with-crosses
  <e''' gis'''>1\glissando s2 <e''' gis'''>
}


%% Simple

{
  \set Staff.instrumentName = "simlpe "
  \override Glissando.stencil = #gliss-stencil-with-crosses
  e''1.\glissando eis'2
}

%% Padding

{
  \set Staff.instrumentName = "padding "
  \override Glissando.stencil = #gliss-stencil-with-crosses
  \override Glissando.bound-details.left.padding = #3
  \override Glissando.bound-details.right.padding = #5
  e''1.\glissando eis'2
}

%% Stencils

{
  \set Staff.instrumentName = "stencils "
  \override Glissando.stencil = #gliss-stencil-with-crosses
  \override Glissando.font-size = #3
  \override Glissando.bound-details.left.text =
    \markup \vcenter \box \left-align "lorem"
  \override Glissando.bound-details.right.text =
    \markup \vcenter \box \right-align "ipsum"
  e''1.\glissando eis'2
}

%% cross-staff

\new PianoStaff
  \with { instrumentName = "cross-staff " }
  <<
    \new Staff = "top"
      \with {
        \override VerticalAxisGroup.staff-staff-spacing.padding = 10
      }
      \relative c'' {
        \override Glissando.stencil = #gliss-stencil-with-crosses
        c1.\glissando
        \change Staff = "bottom"
        gis,,2
      }

    \new Staff = "bottom" { \clef "bass" s1*2 }
  >>

%% with line break

{
  \set Staff.instrumentName = "line-break "
  \override Glissando.stencil = #gliss-stencil-with-crosses
  e'''1.\glissando s2
  \break
  s2 \once \override NoteColumn.glissando-skip = ##t c''
  \break
  s2 bes
}

%% cross-staff with line breaks
  
\new PianoStaff
  \with { instrumentName = "cross-staff, line breaks " }
  <<
  	\new Staff = "top" 
  	  \relative e'' {
  	    \voiceOne
        \override Glissando.stencil = #gliss-stencil-with-crosses
  	    c1\glissando 
  	    \change Staff = "bottom"
  	    \override NoteColumn.glissando-skip = ##t
  	    c,
  	    \break
  	    s2 g
  	    \break
  	    \revert NoteColumn.glissando-skip
  	    s2 g,2
  	  }
  	  
  	\new Staff = "bottom" { \clef "bass" s1*2 }
  >>