[code
\version "2.20.0"
#(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
(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)))
;; 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}."
(let* ((control-points (modify-control-points-for-arrows 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))
(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)))
(if (and (not arrow-left) (not arrow-right))
;; we're setting 'after-line-breaking, thus do nothing for no arrows
'()
(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:grob-set-property! grob 'stencil
(ly:stencil-add
(ly:stencil-translate arrow-left-stil frst)
(ly:stencil-translate arrow-right-stil frth)
stil)))))))
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."
#{
\temporary \override $curve . after-line-breaking = #add-arrow-head-to-curve
#})
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
#})
\once \override Staff.DotColumn.after-line-breaking =
#(lambda (grob)
(for-each
(lambda (grob) (ly:grob-translate-axis! grob -0.6 X))
(take (ly:grob-array->list (ly:grob-object grob 'dots)) 2)))
eins = \relative c' {
\acciaccatura {\once \pointing-curve Slur \override Slur.details.arrow-left = ##t
cis 16 (\override Stem.transparent = ##t d cis} \override Stem.transparent = ##f dis8) r
\override Rest.X-offset = 2 r4 r2
}
zwei = \relative c' {
\override NoteColumn.X-offset = -6 \override Dots.extra-offset = #'(-4 . 0) es4. es16 f
\override Rest.X-offset = 8 r2
}
\score {
\new StaffGroup <<
\new Staff = eins <<\eins>>
\new Staff = zwei <<\zwei>>
>>
}
]
Liebe Freunde,
gibt es für dieses Konstrukt eine elegantere Lösung? (Es sollen beide Instrumente gleichzeitig beginnen.)
Frage grundsätzlicher Art: warum kommt unter NoteColumn der Punkt nicht mit?
Und: "Dots" regiert nicht auf X-offset ?
Gruß
Christa
Hallo Christa,
ich hatte mir vorgenommen, nicht mehr auf Anfragen ohne Minimalbeispiel zu antworten. Ich dachte, der ganze Pfeil-Kram wär nötig, deshalb habe ich mir deinen Code doch angeschaut. Das einfachste wird sein, den Vorschlag nicht als solchen zu notieren, weil er eben kein Vorschlag ist:\version "2.20.0"
eins = \relative c' {
\magnifyMusic #(magstep -2) {
cis16*2/3( d cis
}
dis8*1/2)\noBeam r
r4 r2
}
zwei = \relative c' {
es4. es16 f
r2
}
\new StaffGroup <<
\new Staff \eins
\new Staff \zwei
>>
Die Skalierungsfaktoren beeinflussen das horizontale Spacing, da müßtest du also ggf. noch andere Werte ausprobieren.
Viele Grüße
Malte
Hallo Malte,
den "Pfeilkram" hatte ich mitgeschickt, damit deutlich wird, warum die Aktion...
Ich hatte keine richtige Bezeichnung, deshalb "acciaccatura".
Danke, dass du nachsichtig warst.
Diese Lösung ist sehr schön.