\version "2.12.3"

% This is the version to use with "2.12.3"

#(set-global-staff-size 18)

%\markup \column { \bold \fill-line { "EXAMPLES" } \vspace #2 }

xy = \once\override Stem #'french-beaming = ##t 

#(define ((grow-beam-var top) grob)
 (if (< (length (cdr (ly:grob-property (ly:grob-parent grob X) 'beaming))) 2)
     (ly:beam::print grob)
     (cond ((= top 1) (and (display "\n _______________Use: \\override Beam #'grow-direction = #'RIGHT__________________") 
     	      (ly:beam::print grob)))
           ((= top 0) (and (display "\n _______________Use: \\override Beam #'grow-direction = #'LEFT___________________") 
           	      (ly:beam::print grob)))
           ((or (< top 0)(> top 1))(and (display "\n _______________No reachable top__________________") 
           	      (ly:beam::print grob)))
           ((and (> top 0) (< top 1))
      (if (ly:stencil? (ly:beam::print grob)) ;; delete this?
           ;; Thanks to David Nalesnik
         (let* ((beam (ly:beam::print grob))
                (dir (ly:beam::calc-direction grob))
                (b-d (ly:output-def-lookup (ly:grob-layout grob) 'blot-diameter))
                (beam-extent-X (ly:stencil-extent beam X))
                (beam-length-x-orig (interval-length beam-extent-X))
                (beam-length-x (- beam-length-x-orig b-d))
                (beam-extent-Y (ly:stencil-extent beam Y))
                (beam-length-y (interval-length beam-extent-Y))
                ;;(orig-beam-thickness (ly:grob-property grob 'beam-thickness))
                (orig-beam-thickness (ly:grob-property grob 'thickness))	;; v"2.12.3"
                (beam-count (length (cdr (ly:grob-property (ly:grob-parent grob X) 'beaming))))  ;; the number of beams
                (space-between-beams (* 0.46 (ly:grob-property grob 'gap)))	             	 ;; the space between the beams
                (orig-beam-length-at-stem (+ (* beam-count orig-beam-thickness)(* (- beam-count 1) space-between-beams)))
                (beam-positions (ly:grob-property grob 'positions))
                
                (beam-slant (cond ((<= (car beam-positions) (cdr beam-positions)) 1)
                	              ;;((= (car beam-positions) (cdr beam-positions)) 0)
                	              ((> (car beam-positions) (cdr beam-positions)) -1)))
                (orig-slope (* beam-slant (/ (- beam-length-y orig-beam-length-at-stem) beam-length-x)))
                (alpha (atan orig-slope))
                ;;(beam-thickness (* 0.8 (ly:grob-property grob 'beam-thickness)))
                (beam-thickness (* 0.8 (ly:grob-property grob 'thickness)))	;; v"2.12.3"
                (h-max (- (/ orig-beam-length-at-stem (cos alpha)) (* 1.3 beam-thickness)))
                
     ; markup-a is the longest beam

                (markup-a (markup #:beam beam-length-x
                	         orig-slope
                	         beam-thickness))		
                	
     ; markup-b is begin of the first additional beam
     
                (y1 (- (* (- beam-length-y orig-beam-length-at-stem) top) (* dir beam-slant (* 1 (/ h-max (- beam-count 1))))))
                (x1 (* beam-length-x top))
                (slope-part-beam-1 (cond ((and (> dir 0) (>= beam-slant 0))
                    	        (/ y1 x1))
                    	      ((and (> dir 0) (< beam-slant 0))
                    	        (* -1 (/ y1 x1)))
                    	      ((and (< dir 0) (> beam-slant 0))
                    	        (/ y1 x1))
                    	      ((and (< dir 0) (<= beam-slant 0))
                    	        (* -1 (/ y1 x1)))))
     
                (part-beam-1
                    (markup #:beam (* beam-length-x top) 
                    	   slope-part-beam-1			
                    	   beam-thickness))			
                (markup-b (markup part-beam-1))
                
                (first-part-beam-1 (grob-interpret-markup grob markup-b))
                (first-part-beam-1-ext-y (ly:stencil-extent first-part-beam-1 Y))
                (length-first-part-beam-1-y (interval-length first-part-beam-1-ext-y))
     
     ; markup-bb is the end of the first additional beam
                (y11 (- (- beam-length-y orig-beam-length-at-stem) y1 ))
                (x11 (- beam-length-x x1))
                (slope-part-beam-11 (cond ((and (> dir 0) (>= beam-slant 0))
                	             (/ y11 x11))
                	          ((and (> dir 0) (< beam-slant 0))
                	             (* -1 (/ y11 x11)))         
                	          ((and (< dir 0) (> beam-slant 0))
                	             (/ y11 x11))
                	          ((and (< dir 0) (<= beam-slant 0))
                	             (* -1  (/ y11 x11)))))
                
                (part-beam-11
                    (markup #:beam (- beam-length-x (* beam-length-x top)) 
                    	   slope-part-beam-11				
                	   beam-thickness))
                (markup-bb (markup part-beam-11))
                
     ; markup-c is the begin of the second additional beam
                (y2 (- (* (- beam-length-y orig-beam-length-at-stem) top) (* dir beam-slant (* 2 (/ h-max (- beam-count 1))))))
                (x2 x1)
                (slope-part-beam-2 (cond ((and (> dir 0) (>= beam-slant 0))
                	   	(/ y2 x2))		
                	         ((and (> dir 0) (< beam-slant 0))
                	   	(* -1 (/ y2 x2)))
                	         ((and (< dir 0) (> beam-slant 0))
                	   	(/ y2 x2))
                	         ((and (< dir 0) (<= beam-slant 0))
                	   	(* -1 (/ y2 x2)))))
                
                (part-beam-2 (if (< beam-count 3)
                	(markup #:null)
                	(markup #:beam (* beam-length-x top)
                		slope-part-beam-2		
                		beam-thickness)
                	))
                (markup-c (markup part-beam-2))
                
                (first-part-beam-2 (grob-interpret-markup grob markup-c))
                (first-part-beam-2-ext-y (ly:stencil-extent first-part-beam-2 Y))
                (length-first-part-beam-2-y (interval-length first-part-beam-2-ext-y))
                
     ; markup-cc is the end of the second additional beam
                (y22 (- (- beam-length-y orig-beam-length-at-stem) y2 ))
                (x22 x11)
                (slope-part-beam-22 (cond ((and (> dir 0) (>= beam-slant 0))  			
                    	          	(/ y22 x22))			
                    	          ((and (> dir 0) (< beam-slant 0))  
                    	          	(* -1 (/ y22 x22)))
                    	          ((and (< dir 0) (> beam-slant 0))  
                    	          	(/ y22 x22))
                    	          ((and (< dir 0) (<= beam-slant 0))  
                    	          	(* -1 (/ y22 x22)))))
                (part-beam-22 (if (< beam-count 3)
                	(markup #:null)
                  	(markup #:beam (- beam-length-x (* beam-length-x top)) 	
                    		slope-part-beam-22				
                  	                beam-thickness)))			 
                (markup-cc (markup part-beam-22))
                
     ; markup-d is the begin of the third additional beam
                (y3 (- (* (- beam-length-y orig-beam-length-at-stem) top) (* dir beam-slant (* 3 (/ h-max (- beam-count 1))))))
                (x3 x1)
                (slope-part-beam-3 (cond ((and (> dir 0) (>= beam-slant 0))
                	   	(/ y3 x3))		
                	         ((and (> dir 0) (< beam-slant 0))
                	   	(* -1 (/ y3 x3)))
                	         ((and (< dir 0) (> beam-slant 0))
                	   	(/ y3 x3))
                	         ((and (< dir 0) (<= beam-slant 0))
                	   	(* -1 (/ y3 x3)))))
                
                (part-beam-3 (if (< beam-count 4)
                	(markup #:null)
                	(markup #:beam (* beam-length-x top)
                		slope-part-beam-3		
                		beam-thickness)))
                (markup-d (markup part-beam-3))
                
                (first-part-beam-3 (grob-interpret-markup grob markup-d))
                (first-part-beam-3-ext-y (ly:stencil-extent first-part-beam-3 Y))
                (length-first-part-beam-3-y (interval-length first-part-beam-3-ext-y))
                
     ; markup-dd is the end of the third additional beam
                (y33 (- (- beam-length-y orig-beam-length-at-stem) y3 ))
                (x33 x11)
                (slope-part-beam-33 (cond ((and (> dir 0) (>= beam-slant 0))  			
                    	          	(/ y33 x33))			
                    	          ((and (> dir 0) (< beam-slant 0))  
                    	          	(* -1 (/ y33 x33)))
                    	          ((and (< dir 0) (> beam-slant 0))  
                    	          	(/ y33 x33))
                    	          ((and (< dir 0) (<= beam-slant 0))  
                    	          	(* -1 (/ y33 x33)))))
                (part-beam-33 (if (< beam-count 4)
                	(markup #:null)
                  	(markup #:beam (- beam-length-x (* beam-length-x top))	
                    		slope-part-beam-33				
                  	                beam-thickness)))			 
                (markup-dd (markup part-beam-33))
                )   ;; end of defs in let*
                
     (if (> beam-count 4)
        (and (display "\n ____________Not defined for this beam-count____________") beam)
        (ly:stencil-translate-axis
          (ly:stencil-add
          ;; first (long beam)
            (ly:stencil-translate-axis
              (grob-interpret-markup grob markup-a)
                -0.025 X)
          ;; parts of second beam 
            (ly:stencil-combine-at-edge
              (ly:stencil-translate-axis
                (grob-interpret-markup grob markup-b)
                -0.025 X)
              X RIGHT
              (ly:stencil-translate-axis
                (grob-interpret-markup grob markup-bb)
                  (cond ((and (> dir 0)(> beam-slant 0))
                 	    (if (and (>= slope-part-beam-1 0)(>= slope-part-beam-11 0))
                 	        (- length-first-part-beam-1-y beam-thickness)
                 	        (* -1 (- length-first-part-beam-1-y beam-thickness))))
                        ((and (> dir 0)(< beam-slant 0))
                           (* -1 (- length-first-part-beam-1-y beam-thickness)))
                           
                        ((and (< dir 0)(> beam-slant 0))
                           (- length-first-part-beam-1-y beam-thickness))
                        ((and (< dir 0)(< beam-slant 0))
                 	    (if (and (<= slope-part-beam-1 0)(<= slope-part-beam-11 0))
                 	        (* -1 (- length-first-part-beam-1-y beam-thickness))
                 	        (- length-first-part-beam-1-y beam-thickness)))
                           )
                  Y)
             0)
          ;; parts of third beam 
            (ly:stencil-combine-at-edge 
              (ly:stencil-translate-axis
                (grob-interpret-markup grob markup-c)
                -0.025 X)
             X RIGHT
             (ly:stencil-translate-axis
               (grob-interpret-markup grob markup-cc)
                 (cond ((and (> dir 0)(> beam-slant 0))
                 	    (if (and (>= slope-part-beam-2 0)(>= slope-part-beam-22 0))
                 	        (- length-first-part-beam-2-y beam-thickness)
                 	        (* -1 (- length-first-part-beam-2-y beam-thickness))))
                       ((and (> dir 0)(< beam-slant 0))
                          (* -1 (- length-first-part-beam-2-y beam-thickness)))

                       ((and (< dir 0)(> beam-slant 0))
                           (- length-first-part-beam-2-y beam-thickness))
                       ((and (< dir 0)(< beam-slant 0))
                 	    (if (and (<= slope-part-beam-2 0)(<= slope-part-beam-22 0))
                 	        (* -1 (- length-first-part-beam-2-y beam-thickness))
                 	        (- length-first-part-beam-2-y beam-thickness)))
                           )
                 Y)
             0)
          ;; parts of fourth beam 
            (ly:stencil-combine-at-edge 
              (ly:stencil-translate-axis
                (grob-interpret-markup grob markup-d)
                -0.025 X)
             X RIGHT
             (ly:stencil-translate-axis
               (grob-interpret-markup grob markup-dd)
                 (cond ((and (> dir 0)(> beam-slant 0))
                 	    (if (and (>= slope-part-beam-3 0)(>= slope-part-beam-33 0))
                 	        (- length-first-part-beam-3-y beam-thickness)
                 	        (* -1 (- length-first-part-beam-3-y beam-thickness))))
                 	((and (> dir 0)(< beam-slant 0))
                 	    (* -1 (- length-first-part-beam-3-y beam-thickness)))
                 	  
                       ((and (< dir 0)(> beam-slant 0))
                           (- length-first-part-beam-3-y beam-thickness))
                       ((and (< dir 0)(< beam-slant 0))
                 	    (if (and (<= slope-part-beam-3 0)(<= slope-part-beam-33 0))
                 	        (* -1 (- length-first-part-beam-3-y beam-thickness))
                 	        (- length-first-part-beam-3-y beam-thickness)))
                           )
                 Y)
             0);; end of parts of fourth beam
             ) ;; end of stencil-add
          (car beam-positions)
          Y)
       )
           ) ;; end of let*
           #f)
           )
           ))
)
       
%--------------------- Test ----------------------------------------------------

\relative c' {
        
\mark\markup { \with-color #red "A" }

  \once \override Beam #'stencil = #(grow-beam-var 0.5)

  c32[ d e f g a b c]

 \mark\markup {  \with-color #red  "B" }
 
   \once \override Beam #'stencil = #(grow-beam-var 0.71)
   c,32[ d e f g a b c]
   
 \mark\markup { \with-color #red "C" }
 
 \once \override Beam #'stencil = #(grow-beam-var 0.5)
 a64[ g f e d c b a]
 
 \mark\markup {  \with-color #red  "D" } 
   
   \once\override Beam #'stencil = #(grow-beam-var 0.265)
   c,32 [c c c c c c c c c c c c c c c
   ]
 
 \bar "" \break
 
 \mark\markup { \with-color #red "E" }    
        
          \once \override Beam #'stencil = #(grow-beam-var 0.333)
   c''32 [d' e, f g a b, c d'' e f g, a b c d 
   ]
   
 \mark\markup {  \with-color #red  "F" } 
   
   \once \override Beam #'stencil = #(grow-beam-var 0.335)
   c,,32 [d e f g a b c d e f g a b c d 
   ]
 \bar ""\break  
 
 \mark\markup {  \with-color #red  "G" }
 
   \once \override Beam #'stencil = #(grow-beam-var 0.3333)
   c32 [b a g f e d c b a g f e d c b
   ]
 
 \mark\markup {  \with-color #red  "H" } 
   
   \once\override Beam #'stencil = #(grow-beam-var 0.735)
   c,32 [c' c' c,, c d e f g c e b' c'
   ]
 
 \bar ""\break  
  
   \mark\markup { \with-color #red "J" }
 
   \once \override Beam #'stencil = #(grow-beam-var 0.59)
 
   c,,,32[ e g b d f a c]
  
   \mark\markup { \with-color #red "K" }
  
 \once\override Beam #'stencil = #(grow-beam-var 0.5)
 c,,32 [c' c' c' c']
 
 \bar "" \break
   \mark\markup { \with-color #red "L" }
   
   
 
         \once \override Beam #'positions = #'(1 . 1)
         %\once
         \override Beam #'stencil = #(grow-beam-var 0.5)
 
 	
  f,,,,,32 [ \xy f''' f,,, \xy f''' f,,, \xy f''' f,,, \xy f''' f,,, \xy f''' f,,,]
   \override Beam #'auto-knee-gap = #6
   f [f'' f,, f'' f,, f'' f,, f'']
 
 }
 
 % --> http://lsr.dsi.unimi.it/LSR/Item?id=508
 
 \new PianoStaff <<
  \new Staff = "RH" { \clef treble \time 3/4 s2 }
  \new Staff = "LH" { \clef bass   \time 3/4 s2 }
  \context Staff = LH
   \relative {
   \mark\markup { \column { \with-color #red "M" } }
    \stemDown
    \once\override Beam #'stencil = #(grow-beam-var 0.53)
    \override Beam #'concaveness = #0
    c,,32 [ g'
    \change Staff = RH
    d' a' e' b' fis' cis']
    \once\override Beam #'stencil = #(grow-beam-var 0.42)
    
    cis32 [fis, b,  e, a, d,
    \change Staff = LH
    g, c, ] 
  }
 >>
 
 one = 
 \relative c' {
           \once\override Beam #'stencil = #(grow-beam-var 0.8)
           c'32 [c c c  c c c c  c c c c  c c c c] c2
 }
 
 two =
 \relative c' {
           \once\override Beam #'stencil = #(grow-beam-var 0.305)
           c,16 [c c c  c c c c  c c c c  c c c c] 
 }
 
 <<{ \one } \\ {\two }>>
 
 expr = { a1*1/8\< s4.\! s8\> s s s8\! }
 
 \relative c'' {
         
   \mark\markup { \column { \with-color #red "N" } }
   
         \override Hairpin #'minimum-length = #5
         \override Beam #'stencil = #(grow-beam-var 0.5)
         
         a1*1/8\< s4.\! s8\> s s s8\!
         a16 [a a a a a a a a a a a a a a a] 
         a32 [a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a]
         a64 [a a a 
         a a a a 
         
         a a a a 
         a a a a 
         
         a a a a 
         a a a a 
         
         a a a a 
         a a a a]
         a2
}