X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fstencil.scm;h=391e80882f3f42f73e5fba4358ff52427f8de46e;hb=f93965bd56355b8fb01dbfdea8ec2001bfc9d2c2;hp=bec03016505e4cc5317061f08d2b80f5e416e53f;hpb=3c0f38115857598db730782b1d2ff0a19fd833af;p=lilypond.git diff --git a/scm/stencil.scm b/scm/stencil.scm index bec0301650..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 @@ -240,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." @@ -732,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) @@ -753,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) @@ -776,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 @@ -801,12 +795,19 @@ 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 @@ -815,6 +816,7 @@ by the user, an appropriate default is chosen based on @var{style}." ((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))))) @@ -1127,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))))