Added shapes with borders.

This commit is contained in:
Vincent St-Amour 2010-08-12 11:42:36 -04:00
parent cf692e986d
commit 17e6f8a997
2 changed files with 69 additions and 0 deletions

View File

@ -305,3 +305,45 @@
before at after before/at at/after except
pict-if pict-cond pict-case pict-match
pict-combine with-pict-combine)
;; the following has been added by stamourv
;; borders may be of slightly uneven width, sadly
(define-values (ellipse/border
rectangle/border
rounded-rectangle/border)
(let ()
(define ((mk shape) w h
#:color (color "white")
#:border-color (border-color "black")
#:border-width (border-width 2))
(cc-superimpose
(colorize (shape w h) border-color)
(colorize (shape (- w (* 2 border-width))
(- h (* 2 border-width)))
color)))
(values (mk filled-ellipse)
(mk filled-rectangle)
(mk filled-rounded-rectangle))))
(define (circle/border d
#:color (color "white")
#:border-color (border-color "black")
#:border-width (border-width 2))
(cc-superimpose
(colorize (disk d) border-color)
(colorize (disk (- d (* 2 border-width)))
color)))
(define shape/border-contract
(->* [real? real?]
[#:color color/c #:border-color color/c #:border-width real?]
pict?))
(provide/contract
[ellipse/border shape/border-contract]
[rectangle/border shape/border-contract]
[rounded-rectangle/border shape/border-contract]
[circle/border
(->* [real?]
[#:color color/c #:border-color color/c #:border-width real?]
pict?)])

View File

@ -311,3 +311,30 @@ Computes the width of one column out of @scheme[n] that takes up a ratio of
@scheme[r] of the available space (according to @scheme[current-para-width]).
}
@addition{Vincent St-Amour}
@deftogether[(
@defproc[(ellipse/border [w real?] [h real?]
[#:color color color/c]
[#:border-color border-color color/c]
[#:border-width border-width real?])
pict?]
@defproc[(circle/border [diameter real?]
[#:color color color/c]
[#:border-color border-color color/c]
[#:border-width border-width real?])
pict?]
@defproc[(rectangle/border [w real?] [h real?]
[#:color color color/c]
[#:border-color border-color color/c]
[#:border-width border-width real?])
pict?]
@defproc[(rounded-rectangle/border [w real?] [h real?]
[#:color color color/c]
[#:border-color border-color color/c]
[#:border-width border-width real?])
pict?]
)]{
These functions create shapes with border of the given color and width.
}