fixed a bug in the star image constructing function

svn: r6130
This commit is contained in:
Robby Findler 2007-05-03 19:13:19 +00:00
parent d44fea1dd1
commit fa2b488b75
2 changed files with 16 additions and 6 deletions

View File

@ -525,21 +525,30 @@ plt/collects/tests/mzscheme/image-test.ss
(let* ([inner-radius (inexact->exact (floor in-inner-radius))]
[outer-radius (inexact->exact (floor in-outer-radius))]
[points (star-points inner-radius outer-radius points)]
[radial-offset
(if (<= inner-radius outer-radius)
0
(- inner-radius outer-radius))]
[draw
(make-color-wrapper
color (mode->brush-symbol mode) 'solid
(λ (dc dx dy)
(send dc draw-polygon points dx dy)))]
(send dc draw-polygon points
(+ dx radial-offset)
(+ dy radial-offset))))]
[mask-draw
(make-color-wrapper
'black (mode->brush-symbol mode) 'solid
(λ (dc dx dy)
(send dc draw-polygon points dx dy)))])
(send dc draw-polygon points
(+ dx radial-offset)
(+ dy radial-offset))))]
[size-determining-radius (+ (max inner-radius outer-radius) 1)])
(make-simple-cache-image-snip
(* outer-radius 2)
(* outer-radius 2)
outer-radius
outer-radius
(* size-determining-radius 2)
(* size-determining-radius 2)
size-determining-radius
size-determining-radius
draw
mask-draw)))

View File

@ -788,6 +788,7 @@
(check-on-bitmap 'solid-triangle (triangle 10 'solid 'red))
(check-on-bitmap 'outline-triangle (triangle 10 'outline 'red))
(check-on-bitmap 'solid-star (star 4 10 20 'solid 'red))
(check-on-bitmap 'solid-star/reverse-args (star 4 20 10 'solid 'red))
(check-on-bitmap 'outline-star (star 4 10 20 'outline 'red))
(check-on-bitmap 'line (line 10 7 'red))
; (check-on-bitmap 'text (text "XX" 12 'red)) ;; this test fails for reasons I can't control ... -robby