Am So., 22. März 2020 um 17:38 Uhr schrieb Leo Correia de Verdier
<[email protected]>:
>
> Second attempt:
[...]
Hi,
please find attached my own take on it.
The tremolo-beam now avoids left-note-column's dots and
right-note-column accidentals automagically and is
centered around the thought line between the vertical center of the
note-heads staff-positions of left and right note-column.
Furthermore, I introduced some subproperties of Beam.details:
(1)
Beam.details.tremolo-positions, expecting a pair, defaulting to '(0 . 0)
for fine-tuning
NB Introducing details.tremolo-positions is part of the workaround. A
user set 'positions would disturb the stencil-examination. If you use
Beam.positions, you will need to figure out all the needed values.
Then the function assumes you want to Y-position the Beam yourself and
restricts it's behaviour to left/right gaps.
(2)
Beam.details.whole-note-tremolo-gaps, expecting a pair, defaulting to
'(0.5 . 0.5)
for fine-tuning the gaps
Note:
because of
https://sourceforge.net/p/testlilyissues/issues/5868/
an additional function 'correct-whole-note-tremolo-gap' is added.
In general, the function examines the default-stencil and returns a
modified one.
The first ~90 lines are debugging helpers. They may be activated
setting the boolean in line 369 to #f
Ofcourse it would be better the default would do the right thing right
from the begining...
Thus, it's a workaround, nothing more, but demonstrating how tremolo
for whole notes should come out per default imho.
Cheers,
Harm
\version "2.20.0"
%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% debugging helpers
%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define* (make-cross-stencil coords #:optional (thick 0.2) (sz 0.3))
(ly:stencil-add
(make-line-stencil
thick
(- (car coords) sz)
(- (cdr coords) sz)
(+ (car coords) sz)
(+ (cdr coords) sz))
(make-line-stencil
thick
(- (car coords) sz)
(+ (cdr coords) sz)
(+ (car coords) sz)
(- (cdr coords) sz))))
#(define (beam-stencil stil)
"Add some visual debugging-aid to the given @var{stil}, which is supposed to be
a beam-stencil."
(lambda (grob)
(let* ((sys (ly:grob-system grob))
(left-stem (ly:spanner-bound grob LEFT))
(right-stem (ly:spanner-bound grob RIGHT))
(left-stem-x (ly:grob-relative-coordinate left-stem sys X))
(right-stem-x (ly:grob-relative-coordinate right-stem sys X))
;; left/right NoteColumn
(left-nc (ly:grob-parent left-stem X))
(right-nc (ly:grob-parent right-stem X))
;; left NoteHeads average staff-positions
(left-y-average
(get-average-staff-positions-of-note-heads left-nc))
;; right NoteHeads average staff-positions
(right-y-average
(get-average-staff-positions-of-note-heads right-nc))
;(stil (ly:beam::print grob))
(details (ly:grob-property grob 'details))
(tremolo-positions
(assoc-get 'tremolo-positions details '(0 . 0)))
(beam-dir
(if (> (ly:grob-property grob 'direction) 0)
"UP"
"DOWN"))
(stil-x-ext (ly:stencil-extent stil X))
(stil-start (car stil-x-ext))
(stil-end (cdr stil-x-ext))
(stil-y-ext (ly:stencil-extent stil Y))
(stil-y-center (interval-center stil-y-ext)))
(ly:stencil-add
stil
;; Print the Beam.direction
(ly:stencil-translate-axis (grob-interpret-markup grob beam-dir) 4 Y)
;; Print a cross at point (left-stem-x-coord left-y-average-coord)
;; division by 2 to reflect half-staff-space unit, below as well
(make-cross-stencil
(cons 0 (+ (/ left-y-average 2))))
;; Print a cross at point (right-stem-x-coord right-y-average-coord)
(make-cross-stencil
(cons (- right-stem-x left-stem-x) (+ (/ right-y-average 2))))
;; print a blue line connecting left/right-y-average
(stencil-with-color
(make-line-stencil
0.1
0 (/ left-y-average 2)
(- right-stem-x left-stem-x) (/ right-y-average 2))
blue)
;; print two vertical lines at left/right edge of the given stil
(make-line-stencil
0.1
stil-start (- stil-y-center 5)
stil-start (+ stil-y-center 5))
(make-line-stencil
0.1
stil-end (- stil-y-center 5)
stil-end (+ stil-y-center 5))))))
#(define whole-note-stem-stencil
(lambda (grob)
"Debugging-aid, print a simple vertical line for whole-note stems."
(if (zero? (ly:grob-property grob 'duration-log))
(make-line-stencil 0.1 0 -5 0 5)
ly:stem::print)))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% the code
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define (lists-map function ls)
"Apply @var{function} to @var{ls} and all of it sublists.
First it recurses over the children, then the function is applied to
@var{ls}."
(if (list? ls)
(set! ls (map (lambda (y) (lists-map function y)) ls))
ls)
(function ls))
#(define (get-average-staff-positions-of-note-heads note-column)
;; The names says it all
(let* ((note-heads-array (ly:grob-object note-column 'note-heads)))
(if (ly:grob-array? note-heads-array)
(let* ((note-heads-list (ly:grob-array->list note-heads-array))
(note-heads-staff-positions
(map
(lambda (nh) (ly:grob-property nh 'staff-position nh))
note-heads-list)))
(/ (apply + note-heads-staff-positions)
(length note-heads-staff-positions)))
#f)))
#(define (reset-polygon vals blot)
(lambda (l)
"If @var{l} is a list defining a polygon-stencil, return a new list defining
a polygon-stencil with modified coords, relying on the given @var{vals}.
Take @var{blot} into account."
(if (and (list? l) (eq? (car l) 'polygon))
(let* ((coords (primitive-eval (cadr l)))
(x-right (assoc-get 'x-right vals))
(x-left (assoc-get 'x-left vals))
(y-left (assoc-get 'y-left vals))
(y-right (assoc-get 'y-right vals))
(new-lst
(list
(- (car coords) x-right) (+ y-right (second coords))
(- (third coords) x-right) (+ y-right (fourth coords))
(+ (fifth coords) x-left) (+ y-left (sixth coords))
(+ (seventh coords) x-left) (+ y-left (eighth coords)))))
`(polygon ',new-lst ,blot #t))
l)))
#(define whole-note-tremolo-beam?
(lambda (grob)
"Predicate: Is current beam applied to whole notes as a tremolo-beam?"
(let* ((stems
(map (lambda (dir) (ly:spanner-bound grob dir)) '(-1 1)))
(stem-durs
(map (lambda (stem) (ly:grob-property stem 'duration-log)) stems))
(beam-cause (ly:grob-property grob 'cause))
(tremolo?
(and (ly:prob? beam-cause)
(member
'tremolo-span-event
(ly:prob-property beam-cause 'class)))))
(and tremolo? (any zero? stem-durs)))))
%% The function tries to improve whole-note tremolo
%%
%% Current situation:
%% - Whole-note tremolo-beams are always horizontal
%% - Dots and accidentals are not avoided
%% - 'gap is buggy, see issue 5868
%% https://sourceforge.net/p/testlilyissues/issues/5868/
%%
%% Correction
%% - Let the beam point from the average staff-position of left note-columns
%% note-heads to the average staff-position of right note-columns
%% note-heads.
%% Customizable by override for Beam.details.tremolo-positions
%% defaulting to '(0 . 0)
%% - Avoid dots and accidentals per default, by calculating accurate gaps.
%% Customizable by override for Beam.details.whole-note-tremolo-gaps
%% defaulting to '(0.5 . 0.5)
%% - Relies on zero-gap. To give the user the possibility to set Beam.gap
%% for non-whole notes, a separate procedure is given, see below.
#(define whole-note-tremolo-correction
(lambda (grob)
(if (whole-note-tremolo-beam? grob)
(let* ((details (ly:grob-property grob 'details))
(whole-note-tremolo-gaps
(assoc-get 'whole-note-tremolo-gaps details '(0.5 . 0.5)))
(left-gap (car whole-note-tremolo-gaps))
(right-gap (cdr whole-note-tremolo-gaps))
(sys (ly:grob-system grob))
(grob-layout (ly:grob-layout grob))
;; Beam
;; TODO where does this magic number, 0.81, comes from?
(length-fraction (ly:grob-property grob 'length-fraction 0.81))
(beam-dir (ly:grob-property grob 'direction))
;; 0.48 taken from IR
(beam-thick (ly:grob-property grob 'beam-thickness 0.48))
(beam-count (length (ly:grob-property grob 'beam-segments)))
;; beam-height at arbitrary x
(beam-y (+ beam-thick (* (1- beam-count) length-fraction)))
(stil (ly:beam::print grob))
(stil-expr (ly:stencil-expr stil))
(stil-x (ly:stencil-extent stil X))
(stil-x-length (interval-length stil-x))
(stil-y (ly:stencil-extent stil Y))
(blot (ly:output-def-lookup grob-layout 'blot-diameter 0))
(line-thick
(ly:output-def-lookup grob-layout 'line-thickness 0.1))
;;;;;;;;;;;;;;;;;
;;;; left side
;;;;;;;;;;;;;;;;;
;; Stem
(left-stem (ly:spanner-bound grob LEFT))
(left-stem-x (ly:grob-relative-coordinate left-stem sys X))
;; NoteColumn
(left-nc (ly:grob-parent left-stem X))
(left-nc-x-ext::right (cdr (ly:grob-extent left-nc sys X)))
;; left NoteHeads average staff-positions
(left-y-average
(get-average-staff-positions-of-note-heads left-nc))
;; DotColumn
(left-dot-column (ly:note-column-dot-column left-nc))
(left-dot-column-x-ext
(if (ly:grob? left-dot-column)
(ly:grob-extent left-dot-column sys X)
#f))
(left-dot-column-right-x::right
(if (and left-dot-column-x-ext
(interval-sane? left-dot-column-x-ext))
(cdr left-dot-column-x-ext)
;; if no dots present, fall back to left-nc-x-ext::right
left-nc-x-ext::right))
;;;;;;;;;;;;;;;;;
;;;; right side
;;;;;;;;;;;;;;;;;
;; Stem
(right-stem (ly:spanner-bound grob RIGHT))
(right-stem-x (ly:grob-relative-coordinate right-stem sys X))
;; NoteColumn
(right-nc (ly:grob-parent right-stem X))
(right-nc-x-ext::left (car (ly:grob-extent right-nc sys X)))
;; right NoteHeads average staff-positions
(right-y-average
(get-average-staff-positions-of-note-heads right-nc))
;; AccidentalPlacement
(right-acc-placement (ly:note-column-accidentals right-nc))
(right-acc-placement-x-ext
(if (ly:grob? right-acc-placement)
(ly:grob-extent right-acc-placement sys X)
#f))
(right-acc-x-ext::left
(if (and right-acc-placement-x-ext
(interval-sane? right-acc-placement-x-ext))
(car right-acc-placement-x-ext)
;; if no accidentals present, fall back to
;; right-nc-x-ext::left
right-nc-x-ext::left))
;; calculate left/right gaps
(calculated-left-gap
(- left-dot-column-right-x::right left-nc-x-ext::right))
(calculated-right-gap
(- right-nc-x-ext::left right-acc-x-ext::left))
(raw-calculated-stil-width
(- stil-x-length
calculated-left-gap calculated-right-gap))
(added-gaps
(+ left-gap
right-gap
calculated-left-gap
calculated-right-gap))
(compensate-left
(if (> added-gaps stil-x-length)
(begin
(ly:warning
"specified gap exceeds stencil-width by ~a, setting gap zero."
(- (+ left-gap right-gap) raw-calculated-stil-width))
calculated-left-gap)
(+ calculated-left-gap left-gap)))
(compensate-right
(if (> added-gaps stil-x-length)
(begin
(ly:warning
"specified gap exceeds stencil-width by ~a, setting gap zero."
(- (+ left-gap right-gap) raw-calculated-stil-width))
calculated-right-gap)
(+ calculated-right-gap right-gap)))
;; calculate gradient
(gradient
(/
(/ (- right-y-average left-y-average) 2)
(- right-stem-x left-stem-x)))
;; If a user overrides 'positions, we let him do so, i.e. no
;; further vertical adjustment is done.
;; To fine-tune left/right vertical positions of the Beam we look
;; instead at Beam.details.tremolo-positions,
;; defaulting to '(0 . 0).
(positions-default
(beam::place-broken-parts-individually grob))
(positions-prop
(ly:grob-property grob 'positions))
(user-defined-positions?
;; TODO sufficient?
(and (number-pair? positions-default)
(number-pair? positions-prop)
(or (not (= (car positions-default)
(car positions-prop)))
(not (= (cdr positions-default)
(cdr positions-prop))))))
(tremolo-positions
(assoc-get 'tremolo-positions details '(0 . 0)))
(y-start
(if user-defined-positions?
0
(car tremolo-positions)))
(y-end
(if user-defined-positions?
0
(+
(cdr tremolo-positions)
(* gradient
(- stil-x-length
blot
compensate-right
compensate-left)))))
(vals
(list
(cons 'x-right compensate-right)
(cons 'x-left compensate-left)
(cons 'y-left y-start)
(cons 'y-right y-end)))
(new-x-ext
(cons
(+ (car stil-x) compensate-left)
(- (cdr stil-x) compensate-right)))
(new-y-ext
(if user-defined-positions?
stil-y
(cons
(+ (car stil-y) (min y-start y-end))
(+ (cdr stil-y) (max y-start y-end)))))
(y-translation-value
;; If the user sets 'positions, we assume he cares himself
;; about positioning, thus don't move the stencil in
;; Y-direction
(if user-defined-positions?
0
;; We introduce a let here to let the user follow
;; the calculation step-by-step
(let* (;; Move the beam to zero, the outer edge of the
;; main-beam will match the zero-line of StaffSymbol
;; Bext to follow with default beam.
(zero-line-main-beam
(+ (- (car positions-default))
(* -1 beam-dir (/ beam-thick 2))))
;; Move the beam to the calculated left-y-average
(main-beam-at-left-average
(+ zero-line-main-beam
(/ left-y-average 2)))
;; Move the beam to the (thought) line connecting
;; left- and right-y-average
;; Bext to follow with the new beam
(main-beam-at-left-to-right-line
(+ main-beam-at-left-average
(* (+ (car stil-x) compensate-left) gradient)))
;; Move the beam in order to have it centered on
;; said line. Some correction for line-thickness
;; is needed
(beam-centered-at-left-to-right-line
(+ main-beam-at-left-to-right-line
(* (/ line-thick 2) gradient)
(* beam-dir (/ beam-y 2)))))
beam-centered-at-left-to-right-line)))
(new-stencil
(ly:stencil-translate-axis
(ly:make-stencil
(lists-map (reset-polygon vals blot) stil-expr)
new-x-ext
new-y-ext)
y-translation-value
Y)))
;; For #f some debugging output is added
(if #t
new-stencil
;; add and print debugging output
(beam-stencil
;; visualize new-stencil-extents
(box-stencil new-stencil 0 0)
;; commented default, if switched from above to it, usefull for
;; debugging y-translation-value
;stil
)))
;; If beam is not a whole-note-tremolo-beam return default
ly:beam::print)))
#(define* (correct-whole-note-tremolo-gap #:optional (val #f))
" Return zero for whole-note tremolos."
(lambda (grob)
(if (whole-note-tremolo-beam? grob)
0
(or val 0.8))))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% EXAMPLES
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\paper {
ragged-right = ##f
indent = 0
}
\layout {
%\omit Staff.TimeSignature
\context {
\Voice
\override Beam.gap = #(correct-whole-note-tremolo-gap)
\override Beam.stencil = #whole-note-tremolo-correction
%% other debugging-helper
%\override Stem.stencil = #whole-note-stem-stencil
%\override Beam.layer = 500
%\override Beam.color = #red
}
}
\transpose c c
{
%% Some overrides for checking the behaviour:
%\override Beam.gap = #(correct-whole-note-tremolo-gap 5)
%\override Beam.details.whole-note-tremolo-gaps = #'(0.2 . 0.8)
%\override Beam.positions = #'(0 . 0)
%\override Beam.details.tremolo-positions = #'(1 . -1)
\repeat unfold 2 {
\repeat tremolo #8 { a'16 <b''> }
\repeat tremolo 4 { <g' d'' g''>8 \transpose c c'' <bes des' ees'> }
\repeat tremolo 16 {
<g' d'' g''>32
\transpose c c'' { <aes bes ces' ees' ges'> }
}
\repeat tremolo 16 { <g' d''! g''>32 <bes des' ees'> }
\time 6/4
\repeat tremolo #24 { a'32 b }
\break
\time 4/4
}
\time 4/4
\once\override Beam.gap-count = 2
\repeat tremolo 8 { a'32 ais'32 }
b8 8 8 8
4 4 4 4
2 2 1 \breve
}
