the bow.
@var{bow-height} determines the height of the bow.
@var{orientation} determines, whether the bow is concave or convex.
-@var{orientation} should be set to @val{-1} or @val{1}, other values are
-possible but will affect the bow's height as well.
Both variables are supplied to support independent usage.
Done by calculating a horizontal unit-bow first, then moving all control-points
;;;; (1) calculate control-points for the horizontal unit-bow,
;; y-values for 2nd/3rd control-points
(outer-control
- (* 4/3 orientation (/ bow-height length-to-print)))
+ (* 4/3 (sign orientation) (/ bow-height length-to-print)))
(inner-control
- (* orientation
+ (* (sign orientation)
(- (abs outer-control) (/ thickness length-to-print))))
;; x-values for 2nd/3rd control-points depending on `angularity'
(offset-index
stil))
(define (make-parenthesis-stencil
- y-extent half-thickness width angularity)
+ y-extent thickness width angularity orientation)
"Create a parenthesis stencil.
@var{y-extent} is the Y extent of the markup inside the parenthesis.
@var{half-thickness} is the half thickness of the parenthesis.
@var{width} is the width of a parenthesis.
+@var{orientation} is the orientation of a parenthesis.
The higher the value of number @var{angularity},
the more angular the shape of the parenthesis."
- (let* ((line-width 0.1)
- ;; Horizontal position of baseline that end points run through.
- (base-x
- (if (< width 0)
- (- width)
- 0))
- ;; X value farthest from baseline on outside of curve
- (outer-x (+ base-x width))
- ;; X extent of bezier sandwich centerline curves
- (x-extent (ordered-cons base-x outer-x))
- (bottom-y (interval-start y-extent))
- (top-y (interval-end y-extent))
-
- (lower-end-point (cons base-x bottom-y))
- (upper-end-point (cons base-x top-y))
-
- (outer-control-x (+ base-x (* 4/3 width)))
- (inner-control-x (+ outer-control-x
- (if (< width 0)
- half-thickness
- (- half-thickness))))
-
- ;; Vertical distance between a control point
- ;; and the end point it connects to.
- (offset-index (- (* 0.6 angularity) 0.8))
- (lower-control-y (interval-index y-extent offset-index))
- (upper-control-y (interval-index y-extent (- offset-index)))
-
- (lower-outer-control-point
- (cons outer-control-x lower-control-y))
- (upper-outer-control-point
- (cons outer-control-x upper-control-y))
- (upper-inner-control-point
- (cons inner-control-x upper-control-y))
- (lower-inner-control-point
- (cons inner-control-x lower-control-y)))
- (ly:make-stencil
- (ly:stencil-expr
- (make-bezier-sandwich-stencil
- (list
- ;; Step 1: move to lower end point.
- lower-end-point
- ;; Step 2: curve through outer control points
- ;; to upper end point.
- lower-outer-control-point
- upper-outer-control-point
- upper-end-point
- ;; Step 3: curve through inner control points
- ;; to lower end point.
- upper-inner-control-point
- lower-inner-control-point)
- (min (* 2 half-thickness) line-width)))
- (interval-widen x-extent (/ line-width 2))
- (interval-widen y-extent (/ line-width 2)))))
+ (let* ((start (cons 0 (car y-extent)))
+ (stop (cons 0 (cdr y-extent)))
+ (line-width 0.1)
+ (bow-stil
+ (make-bow-stencil
+ start stop thickness angularity width orientation))
+ (x-extent (ly:stencil-extent bow-stil X)))
+ (ly:make-stencil
+ (ly:stencil-expr bow-stil)
+ (interval-widen x-extent (/ line-width 2))
+ (interval-widen y-extent (/ line-width 2)))))
(define-public (parenthesize-stencil
stencil half-thickness width angularity padding)
"Add parentheses around @var{stencil}, returning a new stencil."
(let* ((y-extent (ly:stencil-extent stencil Y))
(lp (make-parenthesis-stencil
- y-extent half-thickness (- width) angularity))
+ y-extent half-thickness width angularity 1))
(rp (make-parenthesis-stencil
- y-extent half-thickness width angularity)))
+ y-extent half-thickness width angularity -1)))
(set! stencil (ly:stencil-combine-at-edge stencil X LEFT lp padding))
(set! stencil (ly:stencil-combine-at-edge stencil X RIGHT rp padding))
stencil))
(stencil-with-color (ly:round-filled-box x-ext y-ext blot) color)
stil)))
-(define-public (stencil-whiteout stil style thickness line-thickness)
- "@var{style} is a symbol that determines the shape of the white
-background. @var{thickness} is how far, as a multiple of
-@var{line-thickness}, the white background extends past the extents
-of stencil @var{stil}. If @var{thickness} has not been specified
-by the user, an appropriate default is chosen based on @var{style}."
+(define*-public (stencil-whiteout stil
+ #:optional style thickness (line-thickness 0.1))
+ "@var{style}, @var{thickness} and @var{line-thickness} are optional
+arguments. If set, @var{style} determines the shape of the white
+background. Given @code{'outline} the white background is produced
+by @code{stencil-whiteout-outline}, given @code{'rounded-box} it is
+produced by @code{stencil-whiteout-box} with rounded corners, given
+other arguments (e.g. @code{'box}) or when unspecified it defaults to
+@code{stencil-whiteout-box} with square corners. If @var{thickness} is
+specified it determines how far, as a multiple of @var{line-thickness},
+the white background extends past the extents of stencil @var{stil}. If
+@var{thickness} has not been specified, an appropriate default is chosen
+based on @var{style}."
(let ((thick (* line-thickness
(if (number? thickness)
thickness
- (if (eq? style 'outline) 3 0)))))
- (if (eq? style 'outline)
- (stencil-whiteout-outline stil thick)
- (stencil-whiteout-box stil thick))))
+ (cond
+ ((eq? style 'outline) 3)
+ ((eq? style 'rounded-box) 3)
+ (else 0))))))
+ (cond
+ ((eq? style 'outline) (stencil-whiteout-outline stil thick))
+ ((eq? style 'rounded-box) (stencil-whiteout-box stil thick (* 2 thick)))
+ (else (stencil-whiteout-box stil thick)))))
(define-public (arrow-stencil-maker start? end?)
"Return a function drawing a line from current point to @code{destination},
projects / lilypond.git / blobdiff