Am Di., 24. Dez. 2019 um 22:20 Uhr schrieb Thomas Morley
<[email protected]>:
>
> Am Di., 24. Dez. 2019 um 21:50 Uhr schrieb dtsmarin <[email protected]>:
> >
> > Hi,
> >
> > I'm using this snippet http://lsr.di.unimi.it/LSR/Snippet?id=1066 but I want
> > to add an arrow at its right edge. Unfortunately LP's default code for that
> > purpose:
> > \once\override Glissando.bound-details.right.arrow = ##t
> > doesn't work so I need some help to figure out how to add the arrow
> > manually.
>
> Hi,
>
> this is one of my snippets and not designed to react to `arrow` set #t.
> It's likely not impossible to improve it, though, I'll not have much
> time the next days ...
>
> Maybe somebody else may want to chime in.
>
> Cheers,
> Harm
I found some time :)
See attached, please test.
Cheers,
Harm
\version "2.19.83"
lengthen-gliss =
#(define-music-function (parser loation nmbr)(number?)
#{
\once \override Glissando.springs-and-rods = #ly:spanner::set-spacing-rods
\once \override Glissando.minimum-length = #nmbr
#})
#(define (coord+ coord1 coord2)
"Add @var{coord1} to @var{coord2}, returning a coordinate."
(cons (+ (car coord1) (car coord2))
(+ (cdr coord1) (cdr coord2))))
#(define (coord- coord1 coord2)
"Subtract @var{coord2} from @var{coord1}."
(cons (- (car coord1) (car coord2))
(- (cdr coord1) (cdr coord2))))
#(define (coord* scalar coord)
"Multiply each component of @var{coord} by @var{scalar}."
(cons (* (car coord) scalar)
(* (cdr coord) scalar)))
#(define (interpolated-control-points control-points split-value)
"Interpolate @var{control-points} at @var{split-value}. Return a
set of control points that is one degree less than @var{control-points}."
(if (null? (cdr control-points))
'()
(let ((first (car control-points))
(second (cadr control-points)))
(cons* (coord+ first (coord* split-value (coord- second first)))
(interpolated-control-points
(cdr control-points)
split-value)))))
#(define (split-bezier bezier split-value)
"Split a cubic bezier defined by @var{bezier} at the value
@var{split-value}. @var{bezier} is a list of pairs; each pair is
is the coordinates of a control point. Returns a list of beziers.
The first element is the LHS spline; the second
element is the RHS spline."
(let* ((quad-points (interpolated-control-points
bezier
split-value))
(lin-points (interpolated-control-points
quad-points
split-value))
(const-point (interpolated-control-points
lin-points
split-value))
(left-side (list (car bezier)
(car quad-points)
(car lin-points)
(car const-point)))
(right-side (list (car const-point)
(list-ref lin-points 1)
(list-ref quad-points 2)
(list-ref bezier 3))))
(cons left-side right-side)))
#(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))))
fancy-gliss =
#(define-music-function (pts-list)(list?)
#{
\once \override Glissando.stencil =
#(lambda (grob)
(let ((stil (ly:line-spanner::print grob)))
(if (and (ly:stencil? stil) (>= (length pts-list) 1))
(let*
((left-bound-info (ly:grob-property grob 'left-bound-info))
(left-X (assoc-get 'X left-bound-info))
(left-bound (ly:spanner-bound grob LEFT))
(bound-details (ly:grob-property grob 'bound-details))
(right-bound-details
(assoc-get 'right bound-details))
(right-arrow
(assoc-get 'arrow right-bound-details #f))
(y-off (assoc-get 'Y left-bound-info))
(padding (assoc-get 'padding left-bound-info))
(raw-stil-ext (ly:stencil-extent stil X))
(arrow-length
(ly:grob-property grob 'arrow-length 1.11))
(shorten-stil-val
(if right-arrow
;; Going for simple `arrow-length` will open a too large
;; gap at the right of the target note-head.
;; We would need the actual angle or gradient of the current
;; part of the glissando, which relies on the stencil-extent
;; which we want to shorten.
;; So this is a cicrle...
;; For now one could adjust by using
;; \override Glissando.bound-details.right.padding
;; with a suitable value.
arrow-length
0))
(stil-ext
(cons (car raw-stil-ext) (- (cdr raw-stil-ext) shorten-stil-val)))
(left-note-column (ly:grob-parent left-bound X))
(note-heads (ly:grob-object left-note-column 'note-heads))
(factor
(/ (interval-length stil-ext)
(car (take-right (last pts-list) 2))))
(scaled-pts-list
(map
(lambda (e)
(cond ((= (length e) 2)
(cons (* (car e) factor) (cdr e)))
((= (length e) 6)
(list
(* (car e) factor)
(cadr e)
(* (third e) factor)
(fourth e)
(* (fifth e) factor)
(sixth e)))
(else
(ly:error
"Some element(s) of the given list do not fit"))))
pts-list))
(gradient-pts
(append
(if (< (length scaled-pts-list) 2)
'(0 0)
(take-right (second (reverse scaled-pts-list)) 2))
(last scaled-pts-list)))
(gradient-angle
(cond ((= (length gradient-pts) 4)
(ly:angle
(- (third gradient-pts) (car gradient-pts))
(- (fourth gradient-pts) (second gradient-pts))))
((= (length gradient-pts) 8)
(let ((cps
(list
(cons
(first gradient-pts) (second gradient-pts))
(cons
(third gradient-pts) (fourth gradient-pts))
(cons
(fifth gradient-pts) (sixth gradient-pts))
(cons
(seventh gradient-pts) (eighth gradient-pts))))
;; for now we hard-code dir and offset
(dir 1)
(offset 0))
(bezier::angle
(bezier::approx-control-points-to-length
cps dir offset)
(if (positive? dir) 0 1))))
(else
(ly:error
"list of points not suitable: ~a" gradient-pts))))
(thickness (ly:grob-property grob 'thickness 1))
(l-th (layout-line-thickness grob))
(thick (* l-th thickness))
(half-l-th (/ l-th 2))
(ext-X
(if (null? note-heads)
'(0 . 0)
(ly:relative-group-extent note-heads grob X)))
(dot-column (ly:note-column-dot-column left-note-column))
(dots
(if (null? dot-column)
'()
(ly:grob-object dot-column 'dots)))
(dots-ext-X
(if (null? dots)
'(0 . 0)
(ly:relative-group-extent dots grob X)))
(new-glissando-line-stencil
(make-connected-path-stencil
scaled-pts-list
thick ;line-width
1 ;scaling
1 ;scaling
#f
#f))
(translate-value
(cons (+ (interval-length ext-X)
(interval-length dots-ext-X)
padding)
y-off))
(translated-glissando-line-stencil
(ly:stencil-translate
new-glissando-line-stencil
translate-value))
(arrow-stencil empty-stencil))
;; Only execute if arrow is requested
(if right-arrow
(set! arrow-stencil
(let* (
(arrow-half-width
(ly:grob-property grob 'arrow-width 0.425))
(arrow-pts
(list
(cons 0 (- arrow-half-width))
(cons arrow-length arrow-half-width)
(cons (- arrow-length) (* 1 arrow-half-width))))
(start-arrow-pt (take-right (last scaled-pts-list) 2))
(rotated-path-pts
(append
(list
'moveto (car start-arrow-pt) (cadr start-arrow-pt))
(append-map
(lambda (coord)
(let ((new-coord
(coord-rotated coord gradient-angle)))
(list
'rlineto (car new-coord) (cdr new-coord))))
arrow-pts)
(list 'closepath)))
(arrow-head
(make-path-stencil
rotated-path-pts
thick
1 1 #t)))
(ly:stencil-add
arrow-stencil
(ly:stencil-translate
arrow-head
translate-value)))))
; (ly:grob-set-property! grob 'stencil
(ly:stencil-add
arrow-stencil
translated-glissando-line-stencil
))
; )
(begin
(ly:warning
"Cannot find stencil. Please set 'minimum-length accordingly")
#f
empty-stencil
))))
#})
%% comment me
%#(display "\n\tLimitations:
%\t-Does not work with line-break
%\t-dotted notes with glissando may return a warning for unknown reasons,
%\t strange things may happen, if contexts die prematurely")
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% EXAMPLE
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
<<
\new Staff \with { instrumentName = "fancy-gliss " }
\relative c' {
\cadenzaOn
r2
%% If spacing is very tight Glissando sometimes is omitted.
%% Use 'lengthen-gliss' with an apropiate value in this case.
\lengthen-gliss #50
\override Glissando.cross-staff = ##t
\override Glissando.bound-details.right.arrow = ##t
%\once\override Glissando.arrow-width = 1
%\once\override Glissando.arrow-length = 5
%\once\override Glissando.thickness = 2
\fancy-gliss
#'(
(1 8)
(2 -10)
(3 7)
(4 1)
(5 3.5)
(6 0)
(7 0 8 5 12 -6)
(16 0 11 5 15 6)
(16 4)
)
f1\glissando
f'1
}
\new Staff { \cadenzaOn r1 r r2 }
>>
