Am Fr., 19. Apr. 2019 um 23:37 Uhr schrieb Trevor <t.dani...@treda.co.uk>: > > > Aaron, Harm > > Could I please comment on just one feature? The overrides to add or inhibit > arrow-heads at the left and right ends of the Slur are: > > \override Slur.details.arrow-left = #LEFT > \override Slur.details.arrow-right = #RIGHT > \override Slur.details.arrow-left = ##f > \override Slur.details.arrow-right = ##f > > This slightly confused me, especially when I tried > > \override Slur.details.arrow-right = #LEFT > > which draws a left-pointing arrow-head at the right end of the Slur. > Something I don't think anyone would want. > > Why not have the simpler and less confusing > > \override Slur.details.arrow-left = ##t > \override Slur.details.arrow-right = ##t > \override Slur.details.arrow-left = ##f > \override Slur.details.arrow-right = ##f > > ? > > Trevor
Hi Trevor, yep, it's the same concern Lukas already raised. Attached the next iteration of the code. arrow-left/right will now operate on the boolean #f or any not-false value. If the not-false value is a procedure, it will be evaluated. This is needed to make alterBroken etc work (some commented examples in \layout). Regrettable this has some negative impact on the performance. Not sure whether this can be improved. If the not-false value is something else, it's taken as #t. Cheers, Harm
\version "2.19.82" %% Thanks to Aaron Hill %% http://lists.gnu.org/archive/html/lilypond-user/2019-04/msg00240.html %% 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 direct replacement possible, only used in %% the examples, though) #(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 #}) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% EXAMPLES %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \layout { \override Tie.details.arrow-left = ##t \override Slur.details.arrow-left = ##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))) } % { \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) %% time values on my machine %% arrow-slur-05.ly %% real 0m4,855s %% user 0m4,376s %% sys 0m0,456s %% arrow-slur-04.ly %% real 0m3,880s %% user 0m3,595s %% sys 0m0,286s %% arrow-slur-03.ly %% real 0m3,540s %% user 0m3,323s %% sys 0m0,216s %% arrow-slur-03-patch.ly %% real 0m4,191s %% user 0m3,776s %% sys 0m0,414s
_______________________________________________ lilypond-user mailing list lilypond-user@gnu.org https://lists.gnu.org/mailman/listinfo/lilypond-user
