Am Mo., 15. Apr. 2019 um 19:26 Uhr schrieb Lukas-Fabian Moser <l...@gmx.de>: > > Folks, > > in https://archiv.lilypondforum.de/index.php?topic=1744.msg9669#msg9669, > Harm invented a truly wonderful new feature allowing to add an arrow > head to the right end of a Slur (or, for that matter, a Tie, > PhrasingSlur etc.). I reproduce it here with only trivial changes > (mainly omitting parser/location). > > Now I also need slurs with arrows pointing to the left (and ideally, > also the option to have an arrow tip at both ends of the Slur). At first > glance the asymmetry favoring the right hand side of a Slur seems to be > hard-coded pretty deeply in Harm's code. Is there a cheap way to add a > choice of "left or right end" (if not even the "or/and" possibility)? > > Best > Lukas
Hi Lukas,
I started to implement the functionality, finally I more or less
rewrote anything.
As David K once said: rewriting all means at least knowing where the bugs are...
I dropped any functionality for the outside-staff-thingy, it was a
very special request in the thread you linked to.
Do you need it? - could probably be reimplemented.
You now can switch on/off arrows independently at left/right doing
\override GrobName.details.arrow-left = #LEFT
\override GrobName.details.arrow-right = #RIGHT
The function `pointing-curve´ (revertable by `revert-pointing-curve´)
sets the 'after-line-breaking property of GrobName to set the 'stencil
to
`add-arrow-head-to-curve´. This procedure reads the
'details,arrow-left/right and will act accordingly.
Using 'after-line-breaking keeps the possibility to use \shape for the curves.
For one thing I'm undecided:
should a broken (Phrasing)Slur/Tie have arrows at all parts or the
left arrow only at the left of the first part and the right arrow at
thr right of last part?
Furthermore I'm not sure what you mean with
> ideally, also the option to have an arrow tip at both ends of the Slur
Do you have an image?
ly-file/pdf attached.
Cheers,
Harm
\version "2.19.82"
%% Does not work for 2.18.2 because of
%% - grob::name (could be replaced by grob-name, see p.e. LSR)
%% - minimum-length-after-break (no replacement possible, only used in
%% the examples, though)
#(define (note-column-bounded? dir grob)
"Checks wether @var{grob} is a spanner and whether the spanner is bounded in
@var{dir}-direction by a note-column."
(if (ly:spanner? grob)
(grob::has-interface (ly:spanner-bound grob dir) 'note-column-interface)
#f))
#(define (offset-number-pair-list l1 l2)
"Offset the number-pairs of @var{l1} by the matching number-pairs of @var{l2}"
;; NB no type-checking or checking for equal lengths is done here
(map (lambda (p1 p2) (offset-add p1 p2)) l1 l2))
#(define (curve-adjusted-arrow-head dir control-points)
(lambda (curve)
"Returns a stencil build from an arrowhead-glyph, adjusted to fit at start/end
of a curve looking at the curve's @var{control-points}.
Relying on @var{dir} for looking at left or right side of the curve."
(if (not dir)
empty-stencil
(let* ((frst (car control-points))
(scnd (cadr control-points))
(thrd (caddr control-points))
(frth (cadddr control-points))
;; Get the angle of the triangle at third/fourth or first/second
;; control-point to the base
;; 2.cp--> x x <-- 3. cp
;; /. .\
;; / . . \
;; 1.cp--> x... ...x <-- 4.cp
;; ↑ ↑
;; angle angle
(raw-angle
(if (positive? dir)
(ly:angle
(- (car frth) (car thrd))
(- (cdr frth) (cdr thrd)))
(ly:angle
(- (car scnd) (car frst))
(- (cdr scnd) (cdr frst)))))
;; Ties seem to need an increased angle
(angle
(if (or (grob::has-interface curve 'tie-interface)
(grob::has-interface curve 'semi-tie-interface))
(* raw-angle 0.75)
raw-angle))
(grob-font (ly:grob-default-font curve))
(arrowhead-stil
(ly:font-get-glyph grob-font
(format #f "arrowheads.open.0~a1"
(if (positive? dir) "" "M"))))
;; Tie has font-size -6, thus scale the arrowhead a bit
;; TODO find better method!
(scaled-arrowhead
(if (grob::has-interface curve 'tie-interface)
(ly:stencil-scale arrowhead-stil 1.7 1.7)
arrowhead-stil)))
(ly:stencil-rotate scaled-arrowhead angle 0 0)))))
#(define modify-control-points-for-arrows
(lambda (grob)
"Returns a number-pair-list suitable for setting @code{control-points}-property.
The values are modified with respect to a probably printed arrowhead, which
is done by looking at the subproperties of @code{details}:
@code{arrow-left} and @code{arrow-right}."
(let* ((curve-dir (ly:grob-property grob 'direction))
(details (ly:grob-property grob 'details))
(arrow-left (assoc-get 'arrow-left details #f))
(arrow-right (assoc-get 'arrow-right details #f))
(nc-right-bound?
(note-column-bounded? RIGHT grob))
(nc-left-bound?
(note-column-bounded? LEFT grob))
(c-ps (ly:grob-property grob 'control-points)))
(cond ((and (not arrow-left) (not arrow-right))
c-ps)
((eq? (grob::name grob) 'LaissezVibrerTie)
(if arrow-left ;; move a little to right
(offset-number-pair-list
c-ps
'((0.3 . 0) (0.3 . 0) (0.3 . 0) (0.3 . 0)))
c-ps))
((eq? (grob::name grob) 'RepeatTie)
(if arrow-right ;; move a little to left
(offset-number-pair-list
c-ps
'((-0.3 . 0) (-0.3 . 0) (-0.3 . 0) (-0.3 . 0)))
c-ps))
(else ;; Tie, Slur, PhrasingSlur
(let ((move-this-to-left
(if arrow-left
(if nc-left-bound? 0.4 0.5)
0))
(move-this-to-right
(if arrow-right
(if nc-right-bound? -0.4 -0.5)
0))
;; For Ties we want to keep a horizontal look
(move-Y-at-left
(if (or arrow-left
(grob::has-interface grob 'tie-interface))
(* 0.2 curve-dir)
0))
(move-Y-at-right
(if (or arrow-right
(grob::has-interface grob 'tie-interface))
(* 0.2 curve-dir)
0)))
(offset-number-pair-list
c-ps
(list
(cons move-this-to-left move-Y-at-left)
(cons move-this-to-left move-Y-at-left)
(cons move-this-to-right move-Y-at-right)
(cons move-this-to-right move-Y-at-right)))))))))
#(define add-arrow-head-to-curve
(lambda (grob)
"Returns a curve stencil with optional arrowheads at start/end.
Whether to print arrowheads is decided by looking at the subproperties of
@code{details}: @code{arrow-left} and @code{arrow-right}."
(let* ((orig (if (ly:spanner? grob)
(ly:grob-original grob)
#f))
(siblings (if (ly:grob? orig)
(ly:spanner-broken-into orig)
'()))
(control-points (modify-control-points-for-arrows grob))
(details (ly:grob-property grob 'details))
(arrow-left (assoc-get 'arrow-left details #f))
(arrow-right (assoc-get 'arrow-right details #f))
(function
(assoc-get 'stencil (reverse (ly:grob-basic-properties grob))))
(stil ;; Ugh, is there no better way to test that a grob has no
;; 'stencil and that no other previous procedure assigned
;; a stencil-value to said grob?
(if (and (procedure? function)
(not (eq? (procedure-name function)
'add-arrow-head-to-curve)))
(begin
(ly:grob-set-property! grob 'control-points control-points)
(function grob))
(begin
(ly:warning "~a has no stencil. Ignoring." grob)
#f))))
(cond ((and (not arrow-left) (not arrow-right))
stil)
(#t
;; TODO
;; For now arrowheads are printed as specified even for each
;; broken curve, should possibilities to limit behaviour at
;; line-break be implemented?
;(or (null? siblings)
; #t
; (equal? grob (car (last-pair siblings))))
(let* (;(control-points (modify-control-points-for-arrows grob))
(frst (car control-points))
(frth (cadddr control-points))
(arrow-right
((curve-adjusted-arrow-head arrow-right control-points)
grob))
(arrowhead-lngth-right
(interval-length (ly:stencil-extent arrow-right X)))
(arrow-left
((curve-adjusted-arrow-head arrow-left control-points)
grob))
(arrowhead-lngth-left
(interval-length (ly:stencil-extent arrow-left X))))
(ly:stencil-add
(ly:stencil-translate
arrow-left
(cons
(- (car frst) (* arrowhead-lngth-left 0.3))
(cdr frst)
))
(ly:stencil-translate
arrow-right
(cons
(+ (car frth) (* arrowhead-lngth-right 0.3))
(cdr frth)))
stil)))))))
pointing-curve =
#(define-music-function (p l curve) (string?)
"Set property @code{after-line-breaking} for grob @code{curve}. Finally setting
the @code{stencil} to @code{arrowed-curve}.
It's needed to go for @code{after-line-breaking}, otherwise changes to
@code{control-points} done by @code{shape} wouldn't be respected.
Whether or not arrows are printed should done by applying, p.e.
@lilypond[verbatim,quote]
\\override Tie.details.arrow-left = #LEFT
\\override Slur.details.arrow-left = #LEFT
@end lilypond
separately."
#{
\temporary \override $curve . after-line-breaking =
#(lambda (grob)
(ly:grob-set-property! grob 'stencil (add-arrow-head-to-curve grob)))
#})
revert-pointing-curve =
#(define-music-function (p l curve) (string?)
"Revert the setting for @code{after-line-breaking} of grob @var{curve}."
#{
\revert $curve . after-line-breaking
#})
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% EXAMPLES
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\layout {
\override Tie.details.arrow-left = #LEFT
\override Slur.details.arrow-left = #LEFT
\override PhrasingSlur.details.arrow-left = #LEFT
\override RepeatTie.details.arrow-left = #LEFT
\override LaissezVibrerTie.details.arrow-left = #LEFT
\override Tie.details.arrow-right = #RIGHT
\override Slur.details.arrow-right = #RIGHT
\override PhrasingSlur.details.arrow-right = #RIGHT
\override RepeatTie.details.arrow-right = #RIGHT
\override LaissezVibrerTie.details.arrow-right = #RIGHT
}
% {
\new Staff \with { instrumentName = "Slurs" }
\relative c'' {
\pointing-curve Slur
c'( c \bar "" \break c c)
\slurDown
c( c c c)
\voiceOne
c,,4( c c c'')
<>^"default"
\revert-pointing-curve Slur
\oneVoice
c( c c c)
}
%}
% {
m = { c4( d e f e d des c) }
testI = {
\relative c \m
\relative c' \m
\relative c'' \m
\relative c''' \m
}
\new Staff \with { instrumentName = "Slurs" }
{
\pointing-curve Slur
<>^"no Slur-Stem-direction"
\testI
\break
<>^"Slur down, Stem up"
\slurDown
\stemUp
\testI
\break
<>^"Slur up, Stem down"
\slurUp
\stemDown
\testI
\break
<>^"Slur up, Stem up"
\slurUp
\stemUp
\testI
\break
<>^"Slur down, Stem down"
\slurDown
\stemDown
\testI
\break
<>^"default"
\stemNeutral
\slurNeutral
\revert-pointing-curve Slur
\testI
\break
}
%}
% {
\new Staff \with { instrumentName = "Ties" }
\relative c' {
\pointing-curve Tie
%% overriding TieColumn.tie-configuration works
<c e g c>1~
\once \override TieColumn.tie-configuration =
#'((3.0 . 1) (-1.0 . 1) (-5.0 . -1) (-8.0 . -1))
q
\once \override Tie.minimum-length-after-break = 8
<c e g c>1~
\break
q
<>^"default"
\revert-pointing-curve Tie
<c e g c>1~ q
}
%}
% {
\new Staff \with { instrumentName = "PhrasingSlur" }
\relative c' {
\pointing-curve PhrasingSlur
<c e g c>1^\( q q <g d' g b g'>\)
<>^"default"
\revert-pointing-curve PhrasingSlur
<c e g c>1^\( q q <g d' g b g'>\)
}
%}
% {
%% \shape works
\new Staff \with { instrumentName = "RepeatTie" }
\relative c' {
\pointing-curve RepeatTie
c1\repeatTie
%% If left _and_ right arrow is wished, the RepeatTie may be too
%% short, use \shape then
<>^"shaped"
\shape #'((-0.6 . 0) (-0.6 . -0.1) (0 . -0.1) (0 . 0)) RepeatTie
c1\repeatTie
<>^"default"
\revert-pointing-curve RepeatTie
c1\repeatTie
}
%}
% {
\new Staff \with { instrumentName = "LaissezVibrerTie" }
\relative c' {
\pointing-curve LaissezVibrerTie
c1\laissezVibrer
%% If left _and_ right arrow is wished, the LaissezVibrerTie may be too
%% short, use \shape then
<>^"shaped"
c1-\shape #'((0 . 0) (0 . -0.1) (0.6 . -0.1) (0.6 . 0))-\laissezVibrer
<>^"default"
\revert-pointing-curve LaissezVibrerTie
c1\laissezVibrer
}
\paper { indent = 30 }
#(set-global-staff-size 18)
%}
arrow-slur-03.pdf
Description: Adobe PDF document
_______________________________________________ lilypond-user mailing list lilypond-user@gnu.org https://lists.gnu.org/mailman/listinfo/lilypond-user
