X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fstencil.scm;h=391e80882f3f42f73e5fba4358ff52427f8de46e;hb=f93965bd56355b8fb01dbfdea8ec2001bfc9d2c2;hp=d2fad841cbd589d70297b49bc414e479a4a53381;hpb=4e9fd2773a496f31bf6f3a2c1a900fbc4d647487;p=lilypond.git diff --git a/scm/stencil.scm b/scm/stencil.scm index d2fad841cb..391e80882f 100644 --- a/scm/stencil.scm +++ b/scm/stencil.scm @@ -49,8 +49,6 @@ The higher the value of number @var{angularity}, the more angular the shape of 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 @@ -77,9 +75,9 @@ Limitation: s-curves are currently not supported. ;;;; (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 @@ -195,76 +193,34 @@ a list of @var{paddings}." 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)) @@ -282,10 +238,7 @@ the more angular the shape of the parenthesis." (define-public (make-transparent-box-stencil xext yext) "Make a transparent box." - (ly:make-stencil - (list 'transparent-stencil - (ly:stencil-expr (make-filled-box-stencil xext yext))) - xext yext)) + (ly:stencil-outline empty-stencil (make-filled-box-stencil xext yext))) (define-public (make-filled-box-stencil xext yext) "Make a filled box." @@ -774,10 +727,12 @@ box, remains the same." replaced-stil)) (define-public (stencil-with-color stencil color) - (ly:make-stencil - (list 'color color (ly:stencil-expr stencil)) - (ly:stencil-extent stencil X) - (ly:stencil-extent stencil Y))) + (if (color? color) + (ly:make-stencil + (list 'color color (ly:stencil-expr stencil)) + (ly:stencil-extent stencil X) + (ly:stencil-extent stencil Y)) + stencil)) (define*-public (stencil-whiteout-outline stil #:optional (thickness 0.3) (color white) @@ -795,21 +750,18 @@ of the white stencil we make between 0 and 2*pi." (begin (ly:warning "Both angle-increments and radial-increments must be positive numbers.") stil) - (let* ((2pi 6.283185307) - (angle-inc (/ 2pi angle-increments)) + (let* ((angle-inc (/ 360 angle-increments)) (radial-inc (/ thickness radial-increments))) (define (circle-plot ang dec radius original-stil new-stil) - ;; ang (angle) and dec (decrement) are in radians, not degrees + ;; ang (angle) and dec (decrement) are in degrees, not radians (if (<= ang 0) new-stil (circle-plot (- ang dec) dec radius original-stil (ly:stencil-add new-stil (ly:stencil-translate original-stil - (cons - (* radius (cos ang)) - (* radius (sin ang)))))))) + (ly:directed ang radius)))))) (define (radial-plot radius original-stil new-stil) (if (<= radius 0) @@ -818,7 +770,7 @@ of the white stencil we make between 0 and 2*pi." (radial-plot (- radius radial-inc) original-stil - (circle-plot 2pi angle-inc + (circle-plot 360 angle-inc radius original-stil empty-stencil))))) (let ((whiteout-expr @@ -843,19 +795,31 @@ the white outline extends past the extents of stencil @var{stil}." (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 'special) stil) + ((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}, @@ -1165,8 +1129,11 @@ grestore ((eq? head 'color) (interpret (caddr expr))) ((eq? head 'rotate-stencil) (interpret (caddr expr))) ((eq? head 'translate-stencil) (interpret (caddr expr))) + ;; for signatures, we indeed want the _outline_ rather than + ;; the expression interpreted. Right? + ((eq? head 'with-outline) (interpret (cadr expr))) ((eq? head 'combine-stencil) - (for-each (lambda (e) (interpret e)) (cdr expr))) + (for-each interpret (cdr expr))) (else (collect (fold-false-pairs (strip-floats expr))))