\version "2.19.83"


#(define (make-cross-stencil coords)
  (let ((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)))))
     
#(define (line-gradient x-positions y-positions)
  (/
     (- (cdr y-positions) 
        (car y-positions))
     (- (cdr x-positions) 
        (car x-positions))))
        
  
%% Glissando has no pointer to the covered NoteColumns, because in most 
%% traditional music NoteColumns are *not* skipped.
%% Thus reading those NoteColumns is inconvenient.
#(define (glissando-and-stems pad-y)
  (lambda (grob)
    (let* ((layout (ly:grob-layout grob))
           (blot (ly:output-def-lookup layout 'blot-diameter))
           (staff-space (ly:staff-symbol-staff-space grob))
           (half-line-thick (/ (ly:staff-symbol-line-thickness grob) 2))
           (original (ly:grob-original grob))
           (left-bound (ly:spanner-bound original LEFT))
           (right-bound (ly:spanner-bound original RIGHT))
           (left-bound-when (grob::when left-bound))
           (right-bound-when (grob::when right-bound))
           (stil (ly:grob-property grob 'stencil))
           ;(stil (ly:line-spanner::print grob))
           (stil-x-ext (ly:stencil-extent stil X))
           (stil-y-ext (ly:stencil-extent stil Y))
           (left-bound-info (ly:grob-property grob 'left-bound-info))
           (X-left (assoc-get 'X left-bound-info))
           (Y-left (assoc-get 'Y left-bound-info))
           (left-padding (assoc-get 'padding left-bound-info))
           (right-bound-info (ly:grob-property grob 'right-bound-info))
           (X-right (assoc-get 'X right-bound-info))
           (Y-right (assoc-get 'Y right-bound-info))
           (gliss-gradient (/ (- Y-right Y-left) (- X-right X-left)))
           (sys (ly:grob-system grob))
           (sys-elts-array (ly:grob-object sys 'all-elements))
           (ncs 
             (filter
               (lambda (elt)
                 (let (;; Going for `ly:grob-relative-coordinate´ disturbs
                       ;; vertical spacing, thus we sort/filter using
                       ;; `grob::when´
                       (elt-when (grob::when elt)))
                   (and
                     (grob::has-interface elt 'note-column-interface)
                     (ly:grob-property elt 'glissando-skip #f)
                     (ly:grob-array? (ly:grob-object elt 'note-heads))
                     (ly:moment<? left-bound-when elt-when)
                     (not (ly:moment<? right-bound-when elt-when)))))
               (ly:grob-array->list sys-elts-array)))
           ;; Stems from all NoteColumns covered by the Glissando
           (stems
             (map
               (lambda (nc) (ly:grob-object nc 'stem))
               ncs))
           ;; Mmhh, why do we need that?
           (stem-begin-positions
             (map
               (lambda (stem)
                 (ly:grob-property stem 'stem-begin-position))
               stems))
           (stem-x-coord-proc
             (lambda (nc)
               (ly:grob-relative-coordinate (ly:grob-object nc 'stem) sys X)))
           (stems-x-coords
             (map stem-x-coord-proc ncs))
           ;; TODO for broken glissandi this is not exact
           (gliss-stem-intersections
             (map
               (lambda (stem-x-coord)
                 (cons
                   ;; TODO do we need the x-value at all?
                   (+
                      (- stem-x-coord X-left)
                      (- (car stil-x-ext) left-padding)
                      half-line-thick)
                   (+ 
                      (*
                         gliss-gradient
                         (+
                            (- stem-x-coord X-left)
                            (- (car stil-x-ext) left-padding)
                            half-line-thick
                            (- (+ (car stil-x-ext) half-line-thick))))
                      (if (negative? gliss-gradient)
                          (- (cdr stil-y-ext) half-line-thick)
                          (+ (car stil-y-ext) half-line-thick)))))
               stems-x-coords)))
               
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
      ;;
      ;; For conveniance/debugging
      ;;
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
      
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ;; Color left/right bound
      ;;;;;;;;;;;;;;;;;;;;;;
      ;(ly:grob-set-property! left-bound 'color red)
      ;(ly:grob-set-property! right-bound 'color green)
      
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ;; Color passed note-heads
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ;(for-each
      ;  (lambda (nh)
      ;    (ly:grob-set-property! nh 'transparent #f)
      ;    (ly:grob-set-property! nh 'stencil (ly:note-head::print nh))
      ;    (ly:grob-set-property! nh 'color cyan))
      ;  (append-map
      ;    (lambda (nc)
      ;      (ly:grob-array->list (ly:grob-object nc 'note-heads)))
      ;    ncs))
      
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ;; Add cross-stencils where Stem and Glissando intersect
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ;(ly:grob-set-property! grob 'stencil
      ;  (apply ly:stencil-add
      ;    (ly:grob-property grob 'stencil)
      ;      (map make-cross-stencil gliss-stem-intersections)))
      
      
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ;;
      ;;  Recreate Stem.stencil to match the glissando 
      ;;  Move Flag
      ;;  Move Script
      ;;  Recreate Beam.stencil, probably relying on user-specifications
      ;;
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      
      (for-each
        (lambda (gsi stem)
          (let* ((stem-y-ext (ly:grob-extent stem stem Y))
                 (stem-dir (ly:grob-property stem 'direction))
                 (pap-col (ly:item-get-column stem))
                 (pap-col-elts-array (ly:grob-object pap-col 'elements))
                 (scripts
                   (filter
                     (lambda (elt)
                       (grob::has-interface elt 'script-interface))
                     (ly:grob-array->list pap-col-elts-array)))
                 (beam (ly:grob-object stem 'beam))
                 (beamed-stems
                   (if (ly:grob? beam)
                       (ly:grob-array->list (ly:grob-object beam 'stems))
                       #f))
                 (beamed-stems-max-dur
                   (if beamed-stems
                       (apply 
                         max
                         (map 
                           (lambda (stem)
                             (ly:grob-property stem 'duration-log))
                           beamed-stems))
                       #f))
                 (beam-details 
                   (if (ly:grob? beam)
                       (ly:grob-property beam 'details)
                       #f))
                 ;; Get a possible user-override for
                 ;; Beam.details.beamed-glissando-stem-positions
                 (beamed-glissando-stem-positions
                   (if beam-details
                       (assoc-get 
                         'beamed-glissando-stem-positions 
                         beam-details 
                         #f)
                       #f))
                 (beam-x-positions 
                   (if (ly:grob? beam)
                       (ly:grob-property beam 'X-positions)
                       #f))
                 ;; Calculate beam-gradient, but only if the user specified
                 ;; an override for Beam.details.beamed-glissando-stem-positions
                 (beam-gradient
                   (if (and beam-x-positions
                            beamed-glissando-stem-positions)
                       (line-gradient 
                         beam-x-positions 
                         beamed-glissando-stem-positions)
                       #f))
                 (beamed-stem-corrs
                   ;; If the user sets details.beamed-glissando-stem-positions,
                   ;; the usual calculation (further below) of the stem's length 
                   ;; will fail.
                   ;; Thus we need to calculate some values to have the beamed 
                   ;; stems fit into that beam. These values are stored together
                   ;; with it's Stem-grob in an alist and referenced below.
                   (if (and (ly:grob? beam) beam-gradient)
                       (let* ((beamed-ncs
                                (map 
                                  (lambda (stem) (ly:grob-parent stem X))
                                  beamed-stems))
                              (x-coords (map stem-x-coord-proc beamed-ncs))
                              (x-coord-diffs
                                (map
                                  (lambda (coord) (- coord (car x-coords)))
                                  x-coords))
                              (corrs
                                (map
                                  (lambda (stem coord)
                                    (cons stem (* coord beam-gradient)))
                                  beamed-stems
                                  x-coord-diffs)))
                         corrs)
                       0))
                 (new-stem-y-ext
                   ;; The numerical numbers here are my choice - Harm
                   (ordered-cons
                     (+ (cdr gsi) (* stem-dir pad-y))
                        (if beamed-glissando-stem-positions
                            ;; Add the relevant values of beamed-stem-corrs
                            ;; if needed.
                            (+ (car beamed-glissando-stem-positions) 
                               (assoc-get stem beamed-stem-corrs))
                            (+ (* stem-dir 3.4 staff-space)
                               (* 0.5 
                                  stem-dir 
                                  staff-space 
                                  (if (and beamed-stems-max-dur 
                                           (member stem beamed-stems))
                                      (- beamed-stems-max-dur 3.5)
                                      (max 
                                        0 
                                        (- (ly:grob-property stem 'duration-log) 
                                           3))))
                               (cdr gsi) 
                               (* stem-dir pad-y)))))
                 (flag (ly:grob-object stem 'flag))
                 (flag-stil
                   (if (ly:grob? flag)
                       (ly:grob-property flag 'stencil #f)
                       #f)))
                       
            ;;;;;;;;;;;
            ;; recreate Beam.stencil 
            ;;;;;;;;;;;
            ;; Relies on new setting of 'positions derived from new-stem-y-ext
            ;; Renewing quantized-positions is needed to get the stencil correct
            ;; The new beam is always parallel to the glissando, unless a
            ;; user-override takes priority
            
            (if (ly:grob? beam)
                (begin
                  (ly:grob-set-property! beam 'positions 
                    (if beamed-glissando-stem-positions
                        beamed-glissando-stem-positions
                        (cons 
                          (if (equal? stem (car beamed-stems))
                              (if (positive? stem-dir)
                                  (cdr new-stem-y-ext)
                                  (car new-stem-y-ext))
                              (car (ly:grob-property beam 'positions)))
                          (if (equal? stem (last beamed-stems))
                              (if (positive? stem-dir)
                                  (cdr new-stem-y-ext)
                                  (car new-stem-y-ext))
                              (cdr (ly:grob-property beam 'positions))))))
                  (ly:grob-set-property! beam 'quantized-positions 
                    (ly:beam::set-stem-lengths beam))
                  (ly:grob-set-property! beam 'stencil (ly:beam::print beam))))
                  
            ;;;;;;;;;;;
            ;; move scripts according to new Stem.stencil below
            ;;;;;;;;;;;
            
            (if (pair? scripts)
                (for-each
                  (lambda (i script)
                    (let* ((script-stil (ly:grob-property script 'stencil))
                           (script-y-off (ly:grob-property script 'Y-offset))
                           (script-padding (ly:grob-property script 'padding)))
                      ;; TODO Scripts should avoid staff-lines!
                      ;;      Special-case some scripts?
                      (ly:grob-set-property! script 'stencil
                        (ly:stencil-translate-axis
                          (ly:grob-property script 'stencil)
                          (+ 
                             ;; move script to zero-line
                             (- script-y-off) 
                             ;; move script to glissando-line
                             (cdr gsi)
                             ;; Apply one staff-space padding for each script.
                             ;; There are probably multiple ones per 
                             ;; NoteColumn
                             (* i staff-space stem-dir -1)
                             (* script-padding stem-dir -1))
                          Y))))
                  (iota (length scripts) 1 1)
                  scripts))
                
            ;;;;;;;;;;;
            ;; move Flag.stencil according to new Stem.stencil below
            ;;;;;;;;;;;
            
            (if flag-stil
                (let ((default-stem-end
                        (if (positive? stem-dir)
                            (cdr stem-y-ext)
                            (car stem-y-ext)))
                      (new-stem-end
                        (if (positive? stem-dir)
                            (cdr new-stem-y-ext)
                            (car new-stem-y-ext))))
                  (ly:grob-set-property! flag 'stencil 
                    (ly:stencil-translate-axis
                      flag-stil
                      (- new-stem-end default-stem-end)
                      Y))))
            
            ;;;;;;;;;;;
            ;; recreate a new Stem.stencil
            ;;;;;;;;;;;
            
            (ly:grob-set-property! stem 'stencil
              (ly:round-filled-box 
                (ly:grob-extent stem stem X) 
                new-stem-y-ext
                blot))))
        gliss-stem-intersections
        stems))))
      
      
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% EXAMPLES
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%% Not essential, only to ease testings
multipleTransposes =
#(define-music-function (parser location m music)(ly:music? ly:music?)
   (music-clone m
    'elements
    (map (lambda (pitch)
	  (ly:music-property #{ \transpose c $pitch $music #} 'element))
         (event-chord-pitches m))))

glissOn = {
  \temporary \override NoteColumn.glissando-skip = ##t
  \temporary \override NoteHead.stem-attachment = #'(0 . 0)
  %% making NoteHeads transparent, rather than outputting point-stencil
  %% makes for better spacing
  %\temporary \override NoteHead.stencil = #point-stencil
  \temporary \override NoteHead.transparent = ##t
  \temporary \override NoteHead.no-ledgers = ##t
  \temporary \override Accidental.stencil = ##f
  %% Do we need the line below?
  %\temporary \override Stem.no-stem-extend = ##t
}

glissOff = {
  \revert NoteColumn.glissando-skip
  \revert NoteHead.stem-attachment
  %\revert NoteHead.stencil
  \revert NoteHead.transparent
  \revert NoteHead.no-ledgers
  \revert Accidental.stencil
  \revert Stem.no-stem-extend
}

\paper { ragged-right = ##f }

\transpose c c'
{
%  \voiceTwo
  \override Glissando.after-line-breaking = #(glissando-and-stems 0)
%  \override Glissando.breakable = ##t
  c''4\glissando
  \glissOn
  %% For automatic Beams, set the values carefully
  \once \override Beam.details.beamed-glissando-stem-positions = #'(-4 . -8)
  b'8-.
  b'->
  \repeat unfold 4 bes'32-.
  %% For manual Beams set the direction accordingly.
  \once \override Beam.details.beamed-glissando-stem-positions = #'(4 . 8)
  bes'8-.^[
  a'64*8-_
  aes']-.---\prall
%  \break
  g'2
  \glissOff
  fis2
}

mus = {
  c''4\glissando
  \glissOn
  b'8-.
  \noBeam
  b'->
  bes'-.
  \noBeam
  bes'8-.[
  a'64*8-_
  aes']-.---\prall
  %\break
  g'2
  \glissOff
  fis'2
}

%{	
\multipleTransposes { 
	c, 
	d, e, f, g, a, b, 
	c d e f 
	g a b 
} 
{
  \override NoteHead.layer = -1000
  \override Glissando.breakable = ##t
  \override Glissando.after-line-breaking = #(glissando-and-stems 0)
  \mus
}
%}