From 08b9396e2fdea6e1430cfabc130efafe14a5c4b1 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Tue, 21 Sep 2010 16:47:55 -0500 Subject: [PATCH] closes PR 11236 --- collects/2htdp/tests/test-image.rkt | 14 +++++++++++++- collects/mrlib/image-core.rkt | 6 +++--- 2 files changed, 16 insertions(+), 4 deletions(-) diff --git a/collects/2htdp/tests/test-image.rkt b/collects/2htdp/tests/test-image.rkt index 04d07cbcda..fce13bee7a 100644 --- a/collects/2htdp/tests/test-image.rkt +++ b/collects/2htdp/tests/test-image.rkt @@ -773,7 +773,7 @@ #t) (test (equal~? (rectangle 100 10 'solid 'red) - (rotate 90 (rectangle 10.001 100.0001 'solid 'red)) + (rotate 90 (rectangle 10.0001 100.0001 'solid 'red)) 0.1) => #t) @@ -1578,6 +1578,18 @@ (rectangle 1 1 'solid (color 5 5 5)) (rectangle 1 1 'solid (color 6 6 6))))) +(let ([has-color? + (λ (img) + (ormap (λ (x) (or (not (equal? (color-red x) + (color-green x))) + (not (equal? (color-red x) + (color-blue x))))) + (image->color-list img)))]) + (test (has-color? (place-image (rectangle 1 10 "solid" "red") 2 10 + (empty-scene 5 20))) + => + #t)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; test pinholes. diff --git a/collects/mrlib/image-core.rkt b/collects/mrlib/image-core.rkt index e8bac3ff7a..6c15ac3ae5 100644 --- a/collects/mrlib/image-core.rkt +++ b/collects/mrlib/image-core.rkt @@ -774,12 +774,12 @@ has been moved out). (define (polygon-points->path points) (let ([path (new dc-path%)]) - (send path move-to (round (point-x (car points))) (round (point-y (car points)))) + (send path move-to (point-x (car points)) (point-y (car points))) (let loop ([points (cdr points)]) (unless (null? points) (send path line-to - (round (point-x (car points))) - (round (point-y (car points)))) + (point-x (car points)) + (point-y (car points))) (loop (cdr points)))) (send path close) ;(send path line-to (round (point-x (car points))) (round (point-y (car points))))