Hi David,
2011/10/29 David Nalesnik <[email protected]>
> Hi again,
>
> (...)
> The attached should work with accel./rit. and rit./accel.
>
Wow!! Looks great!!
> There is only one extra argument now, which represents the position of the
> "turnaround". This can't be larger than the number of notes in the group.
>
>
To make it possible to enter the same arguments to both,
featherDurationTest and grow-dir-var, I added some conditions to the
turnaround-argument and the end-multiplier.
> If you notice any problems or think of a way to make this more
> effective/less tangled please let me know!
>
I would have expected that the pattern is displayed every time I use
\featherDurationTest but it only occurs once. Why?
And there is a strange thing I had to notice: If \featherDurationTest is
used a second (or third) time, the second (or third) setting changes and
disturbs the first. Or, if I use a high turnaround-value with the first,
the next settings are changed. I can't explain or fix this behaviour.
Many thanks,
Harm
P.S.: In harm-feathered-beams-align-to-stems-rev_04.ly I forgot to apply
dir-peak to mark-a. I integrated the correction into the attached file.
\version "2.14.2"
\pointAndClickOff
#(set-global-staff-size 18)
\paper { tagline = ##f }
\markup \column { \bold \fill-line { "EXAMPLES" } \vspace #2 }
xy = \once\override Stem #'french-beaming = ##t
% xyOut needs "2.15.13"
#(define ((stem-length y) grob)
(ly:grob-set-property! grob 'length y)
(ly:stem::print grob))
xyOut =
#(define-music-function (parser location y-length)(number?)
#{
\once \override Stem #'stencil = #(stem-length $y-length)
#})
#(define ((grow-beam-var number) grob)
;; Thanks to David Nalesnik
(cond
((< (length (cdr (ly:grob-property (ly:grob-parent grob X) 'beaming))) 2)
(ly:beam::print grob))
((= number 0)
(begin
(ly:grob-set-property! grob 'grow-direction LEFT)
(ly:beam::print grob)))
((>= number (1- (ly:grob-array-length (ly:grob-object grob 'stems))))
(begin
(ly:grob-set-property! grob 'grow-direction RIGHT)
(ly:beam::print grob)))
((ly:stencil? (ly:beam::print grob)) ;; delete this?
(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))))
(space-between-beams (* 0.46 (ly:grob-property grob 'gap)))
(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)))
(dir-peak (if (and (ly:grob-property grob 'knee) (< number 0) (= (car beam-positions) (cdr beam-positions)))
-1
1))
(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 (/ beam-length-x first-stem-to-target-stem-length))
;; markup-a is the longest beam
(markup-a (markup #:beam beam-length-x
(if (and (ly:grob-property grob 'knee) (< number 0)(= (car beam-positions) (cdr beam-positions)))
(* dir-peak orig-slope)
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 (+ 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)))
(if (and (ly:grob-property grob 'knee) (< number 0))
(* dir-peak (/ (y-L n) x-L))
(/ (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 0.86
(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)))
(if (and (ly:grob-property grob 'knee) (< number 0))
(* dir-peak (/ (y-R n) x-R))
(/ (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))
(* dir-peak (- (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*
)
)
)
#(define (moment=? a b)
(not (or (ly:moment<? a b) (ly:moment<? b a))))
#(define (moment>? a b)
(not (or (ly:moment<? a b) (moment=? a b))))
featherDurationsTest=
#(define-music-function (parser location factor turnaround-orig argument)
(ly:moment? number? ly:music?)
(let* ((orig-duration (ly:music-length argument))
(multiplier (ly:make-moment 1 1))
(turnaround (if (and (integer? turnaround-orig) (>= turnaround-orig 0))
turnaround-orig
(inexact->exact (floor (abs turnaround-orig)))))
(elements (ly:music-property argument 'elements))
(dif (- (length elements) turnaround))
(lth (cond ((>= dif 0) dif)
(else (length elements))))
(peak-multiplier
(reduce
(lambda (mom prev) (ly:moment-mul mom prev))
multiplier
(make-list turnaround factor)))
(end-multiplier
(reduce
(lambda (mom prev) (ly:moment-mul mom prev))
peak-multiplier
(append
(list peak-multiplier)
(make-list lth ;;(- (length elements) turnaround)
(ly:moment-div (ly:make-moment 1 1) factor)))))
(comparison
(if (< (ly:moment-main-numerator factor) (ly:moment-main-denominator factor))
(lambda (a b) (ly:moment<? a b))
(lambda (a b) (moment>? a b)))))
(music-map
(lambda (mus)
(if (and (eq? (ly:music-property mus 'name) 'EventChord)
(< 0 (ly:moment-main-denominator (ly:music-length mus))))
(begin
(display multiplier) (newline) ; shows pattern of modification
(ly:music-compress mus multiplier)
(if (comparison peak-multiplier multiplier)
(set! multiplier (ly:moment-mul factor multiplier))
(begin
(set! multiplier (ly:moment-div multiplier factor))
(set! peak-multiplier end-multiplier)))))
mus)
argument)
(ly:music-compress
argument
(ly:moment-div orig-duration (ly:music-length argument)))
argument))
\score {
\relative c'' {
\once \override Beam #'stencil = #(grow-beam-var 7.5)
\featherDurationsTest #(ly:make-moment 1 4) #7.5
{ c,32[ d e f g a b c c, d e f g a b c ] } c2
\break
\featherDurationsTest #(ly:make-moment 1 4) #8
{ c32[ c c c c c c c c c c c c c c c] } c2
% \break
% \featherDurationsTest #(ly:make-moment 4 1) #8
% { c32[ c c c c c c c c c c c c c c c c] } c2
}
}
_______________________________________________
lilypond-user mailing list
[email protected]
https://lists.gnu.org/mailman/listinfo/lilypond-user
