rounded-rectangle/border gets #:corner-radius and #:angle arguments

This commit is contained in:
Kevin Tew 2011-09-29 13:48:15 -06:00
parent dc481d2d20
commit 09891c9263
2 changed files with 24 additions and 6 deletions

View File

@ -209,8 +209,7 @@
;; borders may be of slightly uneven width, sadly
(define-values (ellipse/border
rectangle/border
rounded-rectangle/border)
rectangle/border)
(let ()
(define ((mk shape) w h
#:color (color "white")
@ -222,8 +221,22 @@
(- h (* 2 border-width)))
color)))
(values (mk filled-ellipse)
(mk filled-rectangle)
(mk filled-rounded-rectangle))))
(mk filled-rectangle))))
(define (rounded-rectangle/border
w h
#:color (color "white")
#:border-color (border-color "black")
#:border-width (border-width 2)
#:corner-radius (radius -0.25)
#:angle (angle 0))
(cc-superimpose
(colorize (filled-rounded-rectangle w h radius #:angle angle) border-color)
(colorize (filled-rounded-rectangle
(- w (* 2 border-width))
(- h (* 2 border-width)) radius #:angle angle)
color)))
(define (circle/border d
#:color (color "white")
#:border-color (border-color "black")
@ -240,7 +253,10 @@
(provide/contract
[ellipse/border shape/border-contract]
[rectangle/border shape/border-contract]
[rounded-rectangle/border shape/border-contract]
[rounded-rectangle/border
(->* [real? real?]
[#:color color/c #:border-color color/c #:border-width real? #:corner-radius real? #:angle real?]
pict?)]
[circle/border
(->* [real?]
[#:color color/c #:border-color color/c #:border-width real?]

View File

@ -289,7 +289,9 @@ Sets @racket[pict-combine] to refer to @racket[combine-id] within each of the
@defproc[(rounded-rectangle/border [w real?] [h real?]
[#:color color color/c "white"]
[#:border-color border-color color/c "black"]
[#:border-width border-width real? 2])
[#:border-width border-width real? 2]
[#:corner-radius corner-radius real? -0.25]
[#:angle angle real? 0])
pict?]
)]{
These functions create shapes with border of the given color and width.