Added shapes with borders.
This commit is contained in:
parent
cf692e986d
commit
17e6f8a997
|
@ -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?)])
|
||||
|
|
|
@ -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.
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue
Block a user