\version "2.17.26"

%% code by Piaras Hoban
%% http://lists.gnu.org/archive/html/lilypond-user/2013-11/msg00757.html
 
\language "english"

clusterps = "
    /botleftx ~4f def /botlefty ~4f def /topleftx ~4f def /toplefty ~4f def
    /botrightx ~4f def /botrighty ~4f def /toprightx ~4f def /toprighty ~4f def
    /notewidth ~4f def /noteheight ~4f def
    /length toprightx topleftx sub def /height 100 def
    /stepsize 0.325 def
    /boxpath {
        botleftx botlefty moveto
        topleftx toplefty lineto
        toprightx toprighty lineto
        botrightx botrighty lineto
        closepath
    } def
    gsave
    currentpoint translate
    newpath
    0.5 setlinewidth
    botleftx notewidth 2 div sub botlefty noteheight 0.325 mul add moveto
    topleftx notewidth 2 div sub toplefty noteheight 0.325 mul sub lineto
    stroke
    newpath
    0.5 setlinewidth
    botrightx notewidth 2 div add botrighty noteheight 0.275 mul add moveto
    toprightx notewidth 2 div add toprighty noteheight 0.275 mul sub lineto
    stroke
    newpath
    0.125 setlinewidth
    newpath
    boxpath stroke
    boxpath clip
        gsave
        0.1 setlinewidth
        %draw vertival lines (huge default length is used... probably bit hackish but sure...)
        0 stepsize length stepsize div 1 sub {
            stepsize 2 mul -50 moveto
            stepsize 0 translate
            stepsize 0.1 add height lineto
            stroke
        } for
        grestore
    grestore
"

#(define (roundx x base)
    (* base (round (/ x base)))
)

#(define (real-stencil-extent extent left-bound)
    (if (= (roundx (car extent) 0.5) (roundx left-bound 0.5))
            (cons (car extent) (cdr extent))
            (cons (cdr extent) (car extent))
    )
)

#(define (cluster-gliss function grob)
    (let* (
        (notecol (ly:grob-parent (ly:grob-parent grob X) X))
        (notehead-height (interval-length (ly:grob-extent (ly:grob-parent grob X) notecol Y)))
        (notehead-width (interval-length (ly:grob-extent (ly:grob-parent grob X) notecol Y)))
        (hnh (* notehead-height 0))
        (hnw (* notehead-width 0))
        (stencil (function grob))
        (x-extent (ly:stencil-extent stencil X))
        (y-extent (ly:stencil-extent stencil Y))
        (left-bound (ly:grob-property grob 'left-bound-info))
        (left-y (cdr (assoc 'Y left-bound)))
        (real-y-extent (real-stencil-extent y-extent left-y))
        (ps-stencil
            (if (not (assoc 'other-bound (ly:grob-property notecol 'meta)))
                (begin
                    (set! (ly:grob-property notecol 'meta) (append (ly:grob-property notecol 'meta)
                                (list (cons 'other-bound (cons x-extent real-y-extent)))))
                    empty-stencil
                )
                (let* (
                    (other-bound (cdr (assoc 'other-bound (ly:grob-property notecol 'meta))))
                    (other-x (car other-bound))
                    (other-y (cdr other-bound))
                    (gliss-direction (if (< (car real-y-extent) (car other-y))
                                            1 -1
                        ))
                    (point-a (cons (car x-extent) (car real-y-extent)))
                    (point-b (cons (cdr x-extent) (cdr real-y-extent)))
                    (point-c (cons (car other-x) (car other-y)))
                    (point-d (cons (cdr other-x) (cdr other-y)))
                    (point-list (list point-a point-b point-c point-d))
                    (sorted-point-list (sort point-list
                            (lambda (x y)
                                (if (= (car x) (car y))
                                        (< (cdr x) (cdr y))
                                        (< (car x) (car y))
                                )
                            )
                    ))
                    (point-a (first sorted-point-list))
                    (point-b (second sorted-point-list))
                    (point-c (third sorted-point-list))
                    (point-d (fourth sorted-point-list))

                )
                (ly:make-stencil (list 'embedded-ps
                        (ly:format clusterps
                                ;;bottom-left
                                (- (car point-a) hnw) (- (cdr point-a) hnh)
                                ;;top-left
                                (- (car point-b) hnw) (+ (cdr point-b) hnh)
                                ;;bottom-right
                                (+ (car point-c) hnw) (- (cdr point-c) hnh)
                                ;;top-right
                                (+ (car point-d) hnw) (+ (cdr point-d) hnh)

                                notehead-width notehead-height

                            ))
                (cons 0 0) (cons 0 0)))
            ))
        )
    ps-stencil
))

#(define-public ((glissando::cluster-gliss-wrapper function) grob)
    (begin
        (cluster-gliss function grob)
    )
)

clusterGliss = {
    \once \override Glissando.bound-details.left.padding = #0
    \once \override Glissando.bound-details.right.padding = #0
    \once \override Glissando.stencil = #(glissando::cluster-gliss-wrapper ly:line-spanner::print)
}

\score {
    \new Score \with {
        proportionalNotationDuration = #(ly:make-moment 1/25)
        \override NoteHead.stem-attachment = #'(0 . 0)
    }{
        \new PianoStaff <<
            \new Staff ="right" {
                \clusterGliss
                <c' g''>2 \glissando
                \change Staff = "left"
                \clusterGliss <a,, c,>4
                \glissando
                \change Staff = "right"
                \clusterGliss
                <g'' g'''>8. \glissando <e' a'>16
            }
            \new Staff ="left" {
                \clef bass
                s1
            }
        >>
    }
}

\paper {
  ragged-right = ##t
}
#(set-global-staff-size 42)
#(set-default-paper-size "a4" 'landscape)