\version "2.19.48"

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%% generalized slanter - David Sumbler
%%%% Adapted from David Nalesik's 'generalized-offsetter' see:
%%%% http://lilypond.1069038.n5.nabble.com/Cross-staff-beam-slope-can-it-be-specified-tt206885.html#a206904
%%%%
%%%% Usage:
%%%%     \once \slant Beam #'positions #'(-1)
%%%% rotates the default beam about its mid-point so that the right-hand
%%%% end of the beam is 1 staff-space lower than the left-hand end.
%%%%     \once \slant Beam #'positions #'(-1 . 1.5)
%%%% slants the beam as above and then raises it by 1.5 staff-spaces
%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

#(define (pair-list? x)
  (and (pair? x)
       (every number-pair? x)))

#(define (calc-offsets arg params)
  (let* ((leftY  (car arg))
	 (rightY (cdr arg))
	 (slope (cond
	      ((number? params) params)
	      ((number-pair? params) (car params))))
	 (offsetY (cond
	      ((number? params) 0)
	      ((number-pair? params) (cdr params)))))
   (cons (/
	  (-
	   (+ rightY offsetY)
	   (+ leftY slope))
	  2)
         (/
          (-
	   (+ leftY offsetY slope)
	   rightY)
	  2))))

#(define (offset-general arg params)
  (let* ((offsets (calc-offsets arg params)))
   (cond
    ((null? offsets) arg)
    ((number? arg) (+ arg offsets))
    ((number-pair? arg) (coord-translate arg offsets))
    ((pair-list? arg)
     (map
      (lambda (x y) (coord-translate x y))
      arg offsets)))))

#(define ((offsetter property params) grob)
  (let* ((immutable (ly:grob-basic-properties grob))
         (target (assoc-get property (reverse immutable)))
         (vals
           (if (procedure? target)
               (if (procedure-name target) ; check for #<procedure #f (grob)>
                   (target grob)
                   '())
               target)))

    (if (or (number? vals)
            (number-pair? vals)
            (pair-list? vals))

        (let* ((orig (ly:grob-original grob))
               (siblings
                 (if (ly:spanner? grob)
                     (ly:spanner-broken-into orig)
                     '()))
               (total-found (length siblings)))

          (define (helper sibs offs)
            (if (pair? offs)
                (if (eq? (car sibs) grob)
                    (offset-general vals (car offs))
                    (helper (cdr sibs) (cdr offs)))
                vals))

          ;; standardize form of params
          (if (or (null? params)
                  (and (number? params) (number? vals))
                  (and (number-pair? params) (number-pair? vals))
                  (and (pair-list? params) (pair-list? vals)))
              (set! params (list params)))

          (if (>= total-found 2)
              (helper siblings params)
              (offset-general vals (car params))))

        vals)))

slant =
#(define-music-function (name property params)
  (string? scheme? scheme?)
  (let* ((name (string-regexp-substitute " " "" name)) ; remove any spaces
         (name-components (string-split name #\.))
         (context-name "Voice")
         (grob-name #f))

    (if (> 2 (length name-components))
        (set! grob-name (car name-components))
        (begin
          (set! grob-name (cadr name-components))
          (set! context-name (car name-components))))
 #{
   \override $context-name . $grob-name $property =
     #(lambda (grob) ((offsetter property params) grob))
 #}))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
up = \change Staff = upper
down = \change Staff = lower

\paper { indent = 0 }

\markup { "Lilypond default beam" }
\new PianoStaff {
  <<
    \new Staff = "upper" {
      << { \voiceOne <c'' g' e'>2 r2 }
	 \new Voice { \voiceTwo c'2
		      c'8 b \down \stemUp a g } >>
      <c'' g'e'c'>1 }
    \new Staff = "lower" {
      \clef "bass" c1^\p c } >> }

\markup { "\slant Beam #'positions #'(-1)" }
\new PianoStaff {
  <<
    \new Staff = "upper" {      
      << { \voiceOne <c'' g' e'>2 r2 }
	 \new Voice { \voiceTwo c'2
		      \once \slant Beam #'positions #'(-1)
		      c'8 b \down \stemUp a g } >>
      <c'' g'e'c'>1 }
    \new Staff = "lower" {
      \clef "bass" c1^\p c } >> }

\markup { \left-align "\slant Beam #'positions #'(-1 . 1.5)" }
\new PianoStaff {
  <<
    \new Staff = "upper" {
      << { \voiceOne <c'' g' e'>2 r2 }
	 \new Voice { \voiceTwo c'2
		      \once \slant Beam #'positions #'(-1 . 1.5)
		      c'8 b \down \stemUp a g } >>
      <c'' g'e'c'>1 }
    \new Staff = "lower" {
      \clef "bass" c1^\p c } >> }