% put together by Harm and Simon Albrecht
% in <http://lists.gnu.org/archive/html/lilypond-user/2016-09/msg00441.html> ff.

#(define (make-cross-stencil coord)
   "Draw a cross-stencil at coord."
   (let ((thick 0.1)
         (sz 0.2))
     (stencil-with-color
      (ly:stencil-add
       (make-line-stencil
        thick
        (- (car coord) sz)
        (- (cdr coord) sz)
        (+ (car coord) sz)
        (+ (cdr coord) sz))
       (make-line-stencil
        thick
        (- (car coord) sz)
        (+ (cdr coord) sz)
        (+ (car coord) sz)
        (- (cdr coord) sz)))

      cyan)
     ))

compoundSlur =
#(define-event-function (contr-pts ann?) (list? boolean?)
   (let ((proc (lambda (grob)
                 (let*  (;; only here for reference:
                          (cps (ly:slur::calc-control-points grob))
                          (cps1 (list
                                 (first contr-pts)
                                 (second contr-pts)
                                 (third contr-pts)
                                 (fourth contr-pts)))
                          (cps2 (list
                                 (fourth contr-pts)
                                 (fifth contr-pts)
                                 (sixth contr-pts)
                                 (seventh contr-pts)))
                          (first-spline-stil
                           (begin
                            (ly:grob-set-property! grob 'control-points cps1)
                            (ly:slur::print grob)))
                          (second-spline-stil
                           (begin
                            (ly:grob-set-property! grob 'control-points cps2)
                            (ly:slur::print grob)))
                          ;; annotates all new control-points
                          (crosses
                           (if ann?
                               (apply
                                ly:stencil-add
                                (map
                                 (lambda (c)
                                   (make-cross-stencil c))
                                 (append cps1 cps2)))
                               empty-stencil))
                          )
                   ;(pretty-print cps)

                   (ly:stencil-add
                    first-spline-stil
                    second-spline-stil
                    crosses)))))
     #{ -\tweak stencil $proc ( #}))

cptsA = #'((0.6 . 5.8)
           (3.6 . 7.8)
           (25.0 . 5.0)
           (32 . 12)
           (39.0 . 17.5)
           (53.1 . 16.0)
           (55.5 . 12.5))


upper = \relative {
  \key d \major
  \clef bass
  s2 r8 d,16 g b d g b
  d8 r s2.
  s4 \voiceTwo b8.(-- c16-- b2--)
}
lower = \relative {
  \key d \major
  \clef bass
  r2
  <d' b g=>~-^-\compoundSlur \cptsA ##t
  <<
    {
      <d b g>4 <c g e> <b g> \voiceOne cis
      \change Staff = upper
      \clef treble \voiceOne d e fis2)
      \fermata
    }
    \new Voice {
      \voiceTwo
      s2. <g,= e>4 \oneVoice
      <fis b,> <g e> <fis dis>2\fermata
    }
  >>
}
\score {
  <<
    \new PianoStaff <<
      \new Staff = upper \upper
      \new Staff = lower \lower
    >>
  >>
}