fixed an imprecision error

svn: r16633
This commit is contained in:
Robby Findler 2009-11-09 16:59:53 +00:00
parent 2324ed605b
commit 53f8290928

View File

@ -432,15 +432,16 @@ has been moved out).
[points (polygon-points simple-shape)]) [points (polygon-points simple-shape)])
(send path move-to (point-x (car points)) (point-y (car points))) (send path move-to (point-x (car points)) (point-y (car points)))
(let loop ([point (make-rectangular (point-x (car points)) (point-y (car points)))] (let loop ([point (make-rectangular (point-x (car points)) (point-y (car points)))]
[last-point (car points)]
[points (cdr points)]) [points (cdr points)])
(unless (null? points) (unless (null? points)
(let* ([vec (make-rectangular (- (point-x (car points)) (let* ([vec (make-rectangular (- (point-x (car points))
(real-part point)) (point-x last-point))
(- (point-y (car points)) (- (point-y (car points))
(imag-part point)))] (point-y last-point)))]
[endpoint (+ point vec (make-polar -1 (angle vec)))]) [endpoint (+ point vec (make-polar -1 (angle vec)))])
(send path line-to (real-part endpoint) (imag-part endpoint)) (send path line-to (real-part endpoint) (imag-part endpoint))
(loop endpoint (cdr points))))) (loop endpoint (car points) (cdr points)))))
(send path line-to (point-x (car points)) (point-y (car points))) (send path line-to (point-x (car points)) (point-y (car points)))
(send dc set-pen (mode-color->pen (polygon-mode simple-shape) (polygon-color simple-shape))) (send dc set-pen (mode-color->pen (polygon-mode simple-shape) (polygon-color simple-shape)))
(send dc set-brush (mode-color->brush (polygon-mode simple-shape) (polygon-color simple-shape))) (send dc set-brush (mode-color->brush (polygon-mode simple-shape) (polygon-color simple-shape)))