suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

closes PR 11236

Browse Source
This commit is contained in:
Robby Findler 2010-09-21 16:47:55 -05:00
parent 8499a4e65d
commit 08b9396e2f
2 changed files with 16 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/2htdp/tests/test-image.rkt
View File

@ -773,7 +773,7 @@
#t) #t)
(test (equal~? (rectangle 100 10 'solid 'red) (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) 0.1)
=> =>
#t) #t)
@ -1578,6 +1578,18 @@
(rectangle 1 1 'solid (color 5 5 5)) (rectangle 1 1 'solid (color 5 5 5))
(rectangle 1 1 'solid (color 6 6 6))))) (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. ;; test pinholes.

6
collects/mrlib/image-core.rkt
View File

@ -774,12 +774,12 @@ has been moved out).
(define (polygon-points->path points) (define (polygon-points->path points)
(let ([path (new dc-path%)]) (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)]) (let loop ([points (cdr points)])
(unless (null? points) (unless (null? points)
(send path line-to (send path line-to
(round (point-x (car points))) (point-x (car points))
(round (point-y (car points)))) (point-y (car points)))
(loop (cdr points)))) (loop (cdr points))))
(send path close) (send path close)
;(send path line-to (round (point-x (car points))) (round (point-y (car points)))) ;(send path line-to (round (point-x (car points))) (round (point-y (car points))))