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

fix image list coercion

Browse Source 
unbreaks place-image in the case that it gets bitmaps directly

Also, bring test-image.rkt down below 102 columns
This commit is contained in:
Robby Findler 2013-10-04 09:16:18 -05:00
parent ba9873b0a0
commit 88871caf6e
2 changed files with 21 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
pkgs/htdp-pkgs/htdp-lib/2htdp/private/img-err.rkt
View File

@ -128,7 +128,8 @@
(to-img arg)]
[(images)
(check-arg fn-name (and (list? arg) (andmap image? arg)) 'image-list i arg)
arg]
(for/list ([i (in-list arg)])
(to-img i))]
[(mode)
(check-arg fn-name
(mode? arg)

23
pkgs/htdp-pkgs/htdp-test/2htdp/tests/test-image.rkt
View File

@ -1306,8 +1306,10 @@
(define blue2x1 (list->bytes '(255 0 0 255 255 0 255 0)))
;(call-with-values (λ () (scale blue2x1 2 1 20)) show-bitmap)
(define blue2x2 (list->bytes '(255 0 0 255 255 0 0 255 255 0 0 255 255 0 0 255)))
(define gray2x2 (list->bytes '(255 100 100 100 255 100 100 100 255 100 100 100 255 100 100 100)))
(define blue2x2
(list->bytes '(255 0 0 255 255 0 0 255 255 0 0 255 255 0 0 255)))
(define gray2x2
(list->bytes '(255 100 100 100 255 100 100 100 255 100 100 100 255 100 100 100)))
;; Some blue x green checkerboards:
(define checker2x2 (list->bytes '(255 0 0 255 255 0 255 0
255 0 255 0 255 0 0 255)))
@ -1500,6 +1502,7 @@
(define-runtime-path u.png "u.png")
(define u-bitmap (read-bitmap u.png))
(let ()
(define i (rotate 0 (make-object bitmap% u.png 'unknown/mask)))
(define t (new text%))
@ -1641,6 +1644,16 @@
(place-image image3 spot spot
background))))
(test (place-images (list u-bitmap)
(list (make-posn 0 0))
background)
=>
(place-image u-bitmap 0 0 background))
(test (place-images '() '() background)
=>
background)
(test (place-images/align (list image1 image2 image3)
(list (make-posn 30 10) p p)
'center 'center
@ -1691,10 +1704,12 @@
(test (image-height (crop 0 0 101 61 (rectangle 100 60 'outline 'black)))
=>
61)
(test (image-width (crop -1 -1 12 12 (rectangle 10 10 'outline (pen "black" 2 "solid" "round" "round"))))
(test (image-width (crop -1 -1 12 12 (rectangle 10 10 'outline
(pen "black" 2 "solid" "round" "round"))))
=>
12)
(test (image-height (crop -1 -1 12 12 (rectangle 10 10 'outline (pen "black" 4 "solid" "round" "round"))))
(test (image-height (crop -1 -1 12 12 (rectangle 10 10 'outline
(pen "black" 4 "solid" "round" "round"))))
=>
12)