Am Mo., 20. Juli 2020 um 04:13 Uhr schrieb Sam Bivens <sambiv...@gmail.com>:
>
> Hi Harm,
> I won't be using this with broken slurs; these will all be small,
> individualized segments of about five measures maximum.
> Sam
Hi Sam,
ok, for now every part of a broken Slur will get text then.
I implemented some changes (examples):
To get outside-staff-Slurs use \override Slur.details.outside-staff = ##t
To get text attached use \override Slur.details.attach = "Slur"
Text-Slur-distance is adjustable with \override
Slur.details.slur-text-distance = 1
Furthermore, to avoid collisions of the attached Text with other stuff
I changed the default skyline to:
\override Slur.vertical-skylines =
#grob::unpure-vertical-skylines-from-stencil
Alas expensive, I don't see another possibility.
Cheers,
Harm
\version "2.19.84"
%#(ly:set-option 'debug-skylines #t)
\include "arrow-slur-06.ly"
%% Text may be attached by using \tweak or \override
{
\arrowed-slur
c'1
-\tweak details.attach "first Slur"
^(
c')
\once \override Slur.details.attach = \markup \box "2nd Slur"
c'1 _(
c')
}
\version "2.19.82"
%% Thanks to Aaron Hill
%% http://lists.gnu.org/archive/html/lilypond-user/2019-04/msg00240.html
#(ly:load "bezier-tools.scm")
#(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 (bezier::point control-points t)
"Given a Bezier curve of arbitrary degree specified by @var{control-points},
compute the point at the specified position @var{t}."
(if (< 1 (length control-points))
(let ((q0 (bezier::point (drop-right control-points 1) t))
(q1 (bezier::point (drop control-points 1) t)))
(cons
(+ (* (car q0) (- 1 t)) (* (car q1) t))
(+ (* (cdr q0) (- 1 t)) (* (cdr q1) t))))
(car control-points)))
#(define (bezier::angle control-points t)
"Given a Bezier curve of arbitrary degree specified by @var{control-points},
compute the slope at the specified position @var{t}."
(let ((q0 (bezier::point (drop-right control-points 1) t))
(q1 (bezier::point (drop control-points 1) t)))
(ly:angle (- (car q1) (car q0)) (- (cdr q1) (cdr q0)))))
#(define*
(bezier::approx-control-points-to-length
control-points dir length
#:optional (precision 0.01) (right-t 0.2) (left-t 0.8))
"Given a Bezier curve specified by @var{control-points}, return
new control-points where the length of the Bezier specified by them is approx
@var{length}.
The procedure returns if difference of the new calculated length and the given
@var{length} is lower than optional @var{precision}.
The optional @var{left-t} and @var{right-t} represent the steps where new
control-points are calculated relying on @var{dir}."
;; TODO
;; Do the values for precision, left-t, right-t cover all cases?
(let* ((frst-cp (car control-points))
(last-cp (last control-points))
(actual-length
(ly:length
(- (car frst-cp) (car last-cp))
(- (cdr frst-cp) (cdr last-cp))))
(diff (- (abs actual-length) (abs length))))
(if (< diff precision)
control-points
(bezier::approx-control-points-to-length
(if (positive? dir)
(cdr (split-bezier control-points right-t))
(car (split-bezier control-points left-t)))
dir
length))))
#(define (bezier::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* ((staff-space (ly:staff-symbol-staff-space curve))
;; reducing fs-from-staff-space a bit looks nicer
(fs-from-staff-space (1- (magnification->font-size staff-space)))
(grob-font
(ly:paper-get-font
(ly:grob-layout curve)
`(((font-encoding . fetaMusic)
(font-size . ,fs-from-staff-space)))))
(arrowhead-stil
(ly:font-get-glyph grob-font
(format #f "arrowheads.open.0~a1"
(if (positive? dir) "" "M"))))
(arrowhead-width
(interval-length (ly:stencil-extent arrowhead-stil X)))
(offset-stil
(ly:stencil-translate
arrowhead-stil
(cons (* dir 0.4 arrowhead-width) 0)))
(arrowhead-end
(interval-bound (ly:stencil-extent offset-stil X) (- dir)))
(offset (* 0.33 arrowhead-end))
(angle
(bezier::angle
(bezier::approx-control-points-to-length
control-points dir offset)
(if (positive? dir) 0 1))))
(ly:stencil-rotate-absolute offset-stil angle 0 0)))))
#(define (modify-control-points-for-arrows c-ps)
(lambda (grob)
"Returns a number-pair-list suitable for setting @code{control-points}-property.
The given values, @var{c-ps}, 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)))
;; numerical values are my choice -- harm
(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}.
Text may be added to the curve, controlled by the @code{attach} subproperty of
@code{details}."
(let* ((default-cps (ly:grob-property grob 'control-points))
(control-points ((modify-control-points-for-arrows default-cps) grob))
(details (ly:grob-property grob 'details))
(details-arrow-left (assoc-get 'arrow-left details #f))
(details-arrow-right (assoc-get 'arrow-right details #f))
(attach (assoc-get 'attach details #f))
(arrow-left
(if (procedure? details-arrow-left)
(details-arrow-left grob)
details-arrow-left))
(arrow-right
(if (procedure? details-arrow-right)
(details-arrow-right grob)
details-arrow-right))
(raw-stil
(if (and (not arrow-left) (not arrow-right))
(ly:slur::print grob)
(let* ((frst (car control-points))
(frth (cadddr control-points))
(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)))
(arrow-right-stil
(if arrow-right
((bezier::adjusted-arrow-head RIGHT control-points)
grob)
empty-stencil))
(arrow-left-stil
(if arrow-left
((bezier::adjusted-arrow-head LEFT control-points)
grob)
empty-stencil)))
(ly:stencil-add
(ly:stencil-translate arrow-left-stil frst)
(ly:stencil-translate arrow-right-stil frth)
stil)))))
(if attach
(let* ((dir (ly:grob-property grob 'direction UP))
(slur-text-distance (assoc-get 'slur-text-distance details 0))
(slur-thick (ly:grob-property grob 'thickness))
(slur-line-thick (ly:grob-property grob 'line-thickness))
(line-thick (ly:staff-symbol-line-thickness grob))
(start-x (caar control-points))
(end-x (car (last control-points)))
(text-stil
(grob-interpret-markup grob
(make-fontsize-markup
(1- (- (ly:grob-property grob 'fontsize 0)))
attach)))
(text-stil-Y-ext (ly:stencil-extent text-stil Y))
(move-Y-text-stil
(if (positive? dir)
(* -1 (car text-stil-Y-ext))
(* -1 (cdr text-stil-Y-ext))))
(half-way-pt
(bezier::point control-points
(/ (/ (- end-x start-x) 2)
(- end-x start-x)))))
(ly:stencil-add
raw-stil
(ly:stencil-translate
(ly:stencil-aligned-to text-stil X CENTER)
(cons
(car half-way-pt)
(+ (cdr half-way-pt)
move-Y-text-stil
(* dir (+ slur-thick slur-line-thick) line-thick)
(* dir slur-text-distance))))))
raw-stil))))
#(define outside-staff-curve
;; prints the curve outside the staff
;; TODO whole coding is a little half-baked, revise it!
(lambda (grob)
(let* ((details (ly:grob-property grob 'details))
(outside-staff? (assoc-get 'outside-staff details #f))
(function
(assoc-get
'control-points
(reverse (ly:grob-basic-properties grob))))
(c-ps (function grob)))
(if outside-staff?
(let* ((frst (car c-ps))
(scnd (cadr c-ps))
(thrd (caddr c-ps))
(frth (cadddr c-ps))
(curve-dir (ly:grob-property grob 'direction))
(curve-up? (= 1 curve-dir))
(right-bound (ly:spanner-bound grob RIGHT))
(right-bound-stem (ly:grob-object right-bound 'stem))
(right-bound-stem-dir
(if (ly:grob? right-bound-stem)
(ly:grob-property right-bound-stem 'direction)
#f))
(right-bound-beam
(if (ly:grob? right-bound-stem)
(ly:grob-object right-bound-stem 'beam)
#f))
(left-bound (ly:spanner-bound grob LEFT))
(left-bound-stem (ly:grob-object left-bound 'stem))
(left-bound-stem-dir
(if (ly:grob? left-bound-stem)
(ly:grob-property left-bound-stem 'direction)
#f))
(left-bound-beam
(if (ly:grob? left-bound-stem)
(ly:grob-object left-bound-stem 'beam)
#f))
;; If Stem and Slur have same direction, more distance is
;; needed, but not if a beam is present
(crr
(if (and right-bound-stem-dir
left-bound-stem-dir
(or (= right-bound-stem-dir curve-dir)
(= left-bound-stem-dir curve-dir))
(ly:stencil?
(ly:grob-property left-bound-stem 'stencil))
(ly:stencil?
(ly:grob-property right-bound-stem 'stencil))
(null? right-bound-beam)
(null? left-bound-beam)
(or (> (max (cdr frst) (cdr frth)) 2.551)
(< (min (cdr frst) (cdr frth)) -2.551)))
(* 1.2 curve-dir)
0))
;; Ensure first and fourth control-points have the same value
;; to creatw a "flat" curve
;; Set second and third appropriate
;; The numeric values are my choice.
(new-cps
(map
(lambda (cp)
(if (or (eq? cp frst) (eq? cp frth))
(cons
(car cp)
;; For first and fourth control-point, choose the
;; highest y-value, 2.551 at least.
;; Similiar if the curve is below.
(+ crr
(if curve-up?
(max (cdr frst) (cdr frth) 2.551)
(min (cdr frst) (cdr frth) -2.551))))
(cons
(car cp)
;; For second and third control-point, choose an
;; appropiate y-value, 4.235 at least.
;; Similiar if the curve is below.
(+ crr
(if curve-up?
(max
4.235
(cdr scnd)
(cdr thrd)
(+ (max (cdr frst) (cdr frth)) 1.2))
(min
-4.235
(cdr scnd)
(cdr thrd)
(- (min (cdr frst) (cdr frth)) 1.2)))))))
c-ps)))
new-cps)
c-ps))))
pointing-curve =
#(define-music-function (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 = ##t
\\override Slur.details.arrow-left = ##t
@end lilypond
separately.
If @code{details.attach} is set, the text appears centered above/below the
@var{curve}. The distance is adjustable by @code{details.slur-text-distance}.
In this case @code{\\override Slur.vertical-skylines =
#grob::unpure-vertical-skylines-from-stencil} should be used.
If @code{details.outside-staff} is set the curve appears outside staff as a more
or less flat curve.
"
#{
\override $curve . control-points = #outside-staff-curve
\temporary \override $curve . stencil = #add-arrow-head-to-curve
#})
arrowed-slur = \pointing-curve Slur
revert-pointing-curve =
#(define-music-function (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 = ##t
% \override Slur.details.arrow-left = ##t
\override Slur.details.slur-text-distance = 0
%% needed if text is attached to Slur, although expensive
\override Slur.vertical-skylines =
#grob::unpure-vertical-skylines-from-stencil
\override Slur.details.outside-staff = ##t
\override PhrasingSlur.details.arrow-left = ##t
\override RepeatTie.details.arrow-left = ##t
\override LaissezVibrerTie.details.arrow-left = ##t
\override Tie.details.arrow-right = ##t
\override Slur.details.arrow-right = ##t
\override PhrasingSlur.details.arrow-right = ##t
\override RepeatTie.details.arrow-right = ##t
\override LaissezVibrerTie.details.arrow-right = ##t
}
%% Two possibilities to limit printing of arrows for broken spanner
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% \alterBroken
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% \alterBroken details.arrow-right #(list #f #f #t) Slur
%% \alterBroken details.arrow-left #(list #t #f #f) Slur
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Setting details.arrow-right to a procedure
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% \override Slur.details.arrow-right =
%% #(lambda (grob)
%% (let* ((orig (if (ly:spanner? grob)
%% (ly:grob-original grob)
%% #f))
%% (siblings (if (ly:grob? orig)
%% (ly:spanner-broken-into orig)
%% '())))
%% ;; print arrow-right for unbroken or last part of a broken Slur
%% (if (or (not (pair? siblings))
%% (and (pair? siblings)
%% (equal? grob (car (last-pair siblings)))))
%% #t
%% #f)))
%%%%%%%%%%%%%%%%%%%%%%
%% EXAMPLES
%%%%%%%%%%%%%%%%%%%%%%
%{
\new Staff \with { instrumentName = "Slurs" }
\relative c'' {
\pointing-curve Slur
c'1( c
\break
c
\break
c)
\slurDown
c4( 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)
