Hi David,
2011/10/24 David Nalesnik <[email protected]>
> Hi Harm,
> (...)
> I haven't tried to break your function :) but the attached file shows one
> way you could generalize it to remove the code duplication and work with
> more than four beams. (In the example, I've changed the first group to use
> 128th notes.)
>
Many thanks, I knew it could be done.
>
> The examples that Gould shows (pg. 158) have the peak of the feathered
> beams aligned with a stem. I think this would be a useful variation of the
> function. It shouldn't be hard to automate: (ly:grob-object grob 'stems)
> will get you an array of the stem grobs associated with the beam, and you
> could select a particular stem from the array with ly:grob-array-ref.
>
I did as you suggested (perhaps it could be shorter and more elegant, but it
works :)). The argument of the function now aligns the peak with a stem. But
you can also enter non-integer values: (grow-beam-var 3.5) centers the peak
between the third and the fourth stem.
Values like "0" or values greater than the stem-count are faking \override
Beam #'grow-direction = #LEFT (RIGHT). (This is not very elegant: switch on
the color in \layout).
One little problem: With values between 0 and 1 (p.e. 0.5 or 0.8) I retrieve
every time the same output. Well, no one would ever enter such strange
values and perhaps I'm a little bit paranoic, but could it be, that there's
a problem I can't see?
Thanks,
Harm
\version "2.14.2"
\pointAndClickOff
#(set-global-staff-size 18)
\layout {
\context {
\Staff
\override Beam #'layer = #4
%\override Beam #'color = #red
}
}
\markup \column { \bold \fill-line { "EXAMPLES" } \vspace #2 }
xy = \once\override Stem #'french-beaming = ##t
#(define ((grow-beam-var number) grob)
(if (< (length (cdr (ly:grob-property (ly:grob-parent grob X) 'beaming))) 2)
(ly:beam::print grob)
(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))
(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 orig-beam-thickness))
(h-max (- (/ orig-beam-length-at-stem (cos alpha)) (* 1.3 beam-thickness)))
;;;;;
(number-a (if (integer? (abs number))
(abs number)
(inexact->exact (floor (abs number)))))
(number-b (- (abs number) (floor (abs number))))
(stems (ly:grob-object grob 'stems))
(stem-count (ly:grob-array-length stems))
(refp (ly:grob-system grob))
(first-stem (ly:grob-array-ref stems 0))
(target-stem (if (< (abs number-a) stem-count)
(ly:grob-array-ref stems number-a)
(ly:grob-array-ref stems (- stem-count 1 ))))
(next-stem (if (< (+ (abs number-a) 1) stem-count)
(ly:grob-array-ref stems (+ number-a 1))
(ly:grob-array-ref stems (- stem-count 1 ))))
(first-stem-coord (ly:grob-relative-coordinate first-stem refp X))
(target-stem-coord (ly:grob-relative-coordinate target-stem refp X))
(next-stem-coord (ly:grob-relative-coordinate next-stem refp X))
(first-stem-to-target-stem-length (interval-length (cons first-stem-coord target-stem-coord)))
(stem-to-next-stem-length (interval-length (cons target-stem-coord next-stem-coord)))
(factor (if (= first-stem-to-target-stem-length 0)
beam-length-x
(/ beam-length-x first-stem-to-target-stem-length)))
;; markup-a is the longest beam
(markup-a (markup #:beam beam-length-x
orig-slope
beam-thickness))
;; left piece
;; y-length of left piece
(y-L
(lambda (n)
(- (/ (- beam-length-y orig-beam-length-at-stem) factor) (* dir beam-slant (* n (/ h-max (- beam-count 1)))))
))
;; x-length of left piece
(x-L (if (= first-stem-to-target-stem-length 0)
0.001
(+ first-stem-to-target-stem-length (* number-b stem-to-next-stem-length))))
;; slope of left piece
(slope-part-beam-L
(lambda (n)
(cond ((or (and (> dir 0) (> beam-slant 0)) (and (< dir 0) (> beam-slant 0)))
(/ (y-L n) x-L))
((or (and (> dir 0) (< beam-slant 0)) (and (< dir 0) (< beam-slant 0)))
(* -1 (/ (y-L n) x-L))))))
;; construct left piece
(part-beam-L
(lambda (n)
(markup #:beam x-L
(slope-part-beam-L n)
beam-thickness)))
;; markup of left piece
(markup-L (lambda (n) (markup (part-beam-L n))))
;; stencil of left piece
(beam-part-L (lambda (n) (grob-interpret-markup grob (markup-L n))))
;; y-extent of left piece
(beam-part-L-ext-y (lambda (n) (ly:stencil-extent (beam-part-L n) Y)))
;; length of left piece
(length-beam-part-L-y (lambda (n) (interval-length (beam-part-L-ext-y n))))
;; right piece
(y-R (lambda (n) (- (- beam-length-y orig-beam-length-at-stem) (y-L n))))
(x-R (- beam-length-x x-L))
(slope-part-beam-R
(lambda (n)
(cond ((or (and (> dir 0) (> beam-slant 0)) (and (< dir 0) (> beam-slant 0)))
(/ (y-R n) x-R))
((or (and (> dir 0) (< beam-slant 0)) (and (< dir 0) (< beam-slant 0)))
(* -1 (/ (y-R n) x-R))))))
(part-beam-R
(lambda (n)
(markup #:beam (- beam-length-x x-L)
(slope-part-beam-R n)
beam-thickness)))
(markup-R (lambda (n) (markup (part-beam-R n))))
;; parts of feathered beams
(beam-pieces
(map
(lambda (n)
(ly:stencil-combine-at-edge
(ly:stencil-translate-axis
(grob-interpret-markup grob (markup-L n))
-0.025 X)
X RIGHT
(ly:stencil-translate-axis
(grob-interpret-markup grob (markup-R n))
(cond ((and (> dir 0)(> beam-slant 0))
(if (and (>= (slope-part-beam-L n) 0)(>= (slope-part-beam-R n) 0))
(- (length-beam-part-L-y n) beam-thickness)
(* -1 (- (length-beam-part-L-y n) beam-thickness))))
((and (> dir 0)(< beam-slant 0))
(* -1 (- (length-beam-part-L-y n) beam-thickness)))
((and (< dir 0)(> beam-slant 0))
(- (length-beam-part-L-y n) beam-thickness))
((and (< dir 0)(< beam-slant 0))
(if (and (<= (slope-part-beam-L n) 0)(<= (slope-part-beam-R n) 0))
(* -1 (- (length-beam-part-L-y n) beam-thickness))
(- (length-beam-part-L-y n) beam-thickness)))
)
Y)
0))
(cdr (iota beam-count))))
) ;; end of defs in let*
(define (helper beam-pieces)
(ly:stencil-add
(car beam-pieces)
(if (null? (cdr beam-pieces))
(car beam-pieces)
(helper (cdr beam-pieces)))))
(ly:stencil-translate-axis
(ly:stencil-add
;; first (long beam)
(ly:stencil-translate-axis
(grob-interpret-markup grob markup-a)
-0.025 X)
;; other beams
(helper beam-pieces))
(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)
c512[ d e f g a b c] s128
\mark\markup { \with-color #red "B" }
\once \override Beam #'stencil = #(grow-beam-var 5)
c,32[ d e f g a b c]
\mark\markup { \with-color #red "C" }
\once \override Beam #'stencil = #(grow-beam-var 3.5)
a64[ g f e d c b a]
\mark\markup { \with-color #red "D" }
\once\override Beam #'stencil = #(grow-beam-var 5)
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 5)
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 5)
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 5)
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 5)
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 5)
c,,,32[ e g b d f a c]
\mark\markup { \with-color #red "K" }
\once\override Beam #'stencil = #(grow-beam-var 5)
c,,256[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 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 { \vspace #3 \with-color #red "M" } }
\stemDown
\once\override Beam #'stencil = #(grow-beam-var 5)
\override Beam #'concaveness = #0
c,,32 [ g'
\change Staff = RH
d' a' e' b' fis' cis']
\once\override Beam #'stencil = #(grow-beam-var 5)
cis32 [fis, b, e, a, d,
\change Staff = LH
g, c, ]
}
>>
one =
\relative c' {
\once\override Beam #'stencil = #(grow-beam-var 5)
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 5)
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 { \vspace #3 \with-color #red "N" } }
\override Hairpin #'minimum-length = #5
\override Beam #'stencil = #(grow-beam-var 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
}
_______________________________________________
lilypond-user mailing list
[email protected]
https://lists.gnu.org/mailman/listinfo/lilypond-user
