clean up test suite ala gr2
This commit is contained in:
parent
e1eb3cbfba
commit
2a7ccc552a
|
@ -1229,8 +1229,8 @@
|
||||||
16)
|
16)
|
||||||
|
|
||||||
(test (let ()
|
(test (let ()
|
||||||
(define bmp (make-object bitmap% 4 4))
|
(define bmp (make-bitmap 4 4))
|
||||||
(define mask (make-object bitmap% 4 4))
|
(define mask (make-bitmap 4 4))
|
||||||
(define bdc (make-object bitmap-dc% bmp))
|
(define bdc (make-object bitmap-dc% bmp))
|
||||||
(send bdc set-brush "black" 'solid)
|
(send bdc set-brush "black" 'solid)
|
||||||
(send bdc draw-rectangle 0 0 4 4)
|
(send bdc draw-rectangle 0 0 4 4)
|
||||||
|
@ -1242,13 +1242,13 @@
|
||||||
(let-values ([(bytes w h) (bitmap->bytes bmp mask)])
|
(let-values ([(bytes w h) (bitmap->bytes bmp mask)])
|
||||||
bytes))
|
bytes))
|
||||||
=>
|
=>
|
||||||
(bytes-append #"\0\0\0\0" #"\0\0\0\0" #"\0\0\0\0" #"\0\0\0\0"
|
(bytes-append #"\377\0\0\0" #"\377\0\0\0" #"\377\0\0\0" #"\377\0\0\0"
|
||||||
#"\0\0\0\0" #"\377\0\0\0" #"\0\0\0\0" #"\0\0\0\0"
|
#"\377\0\0\0" #"\377\0\0\0" #"\377\0\0\0" #"\377\0\0\0"
|
||||||
#"\0\0\0\0" #"\0\0\0\0" #"\0\0\0\0" #"\0\0\0\0"
|
#"\377\0\0\0" #"\377\0\0\0" #"\377\0\0\0" #"\377\0\0\0"
|
||||||
#"\0\0\0\0" #"\0\0\0\0" #"\0\0\0\0" #"\0\0\0\0"))
|
#"\377\0\0\0" #"\377\0\0\0" #"\377\0\0\0" #"\377\0\0\0"))
|
||||||
|
|
||||||
;; ensure no error
|
;; ensure no error
|
||||||
(test (begin (scale 2 (make-object bitmap% 10 10))
|
(test (begin (scale 2 (make-bitmap 10 10))
|
||||||
(void))
|
(void))
|
||||||
=>
|
=>
|
||||||
(void))
|
(void))
|
||||||
|
@ -1261,18 +1261,18 @@
|
||||||
(send bdc draw-rectangle x y w h)
|
(send bdc draw-rectangle x y w h)
|
||||||
(send bdc set-bitmap #f)))
|
(send bdc set-bitmap #f)))
|
||||||
|
|
||||||
(define blue-10x20-bitmap (make-object bitmap% 10 20))
|
(define blue-10x20-bitmap (make-bitmap 10 20))
|
||||||
(fill-bitmap blue-10x20-bitmap "blue")
|
(fill-bitmap blue-10x20-bitmap "blue")
|
||||||
(define blue-20x10-bitmap (make-object bitmap% 20 10))
|
(define blue-20x10-bitmap (make-bitmap 20 10))
|
||||||
(fill-bitmap blue-20x10-bitmap "blue")
|
(fill-bitmap blue-20x10-bitmap "blue")
|
||||||
(define blue-20x40-bitmap (make-object bitmap% 20 40))
|
(define blue-20x40-bitmap (make-bitmap 20 40))
|
||||||
(fill-bitmap blue-20x40-bitmap "blue")
|
(fill-bitmap blue-20x40-bitmap "blue")
|
||||||
|
|
||||||
(define green-blue-10x20-bitmap (make-object bitmap% 10 20))
|
(define green-blue-10x20-bitmap (make-bitmap 10 20))
|
||||||
(fill-bitmap green-blue-10x20-bitmap "green")
|
(fill-bitmap green-blue-10x20-bitmap "green")
|
||||||
(fill-bitmap green-blue-10x20-bitmap "blue" 0 0 10 10)
|
(fill-bitmap green-blue-10x20-bitmap "blue" 0 0 10 10)
|
||||||
|
|
||||||
(define green-blue-20x10-bitmap (make-object bitmap% 20 10))
|
(define green-blue-20x10-bitmap (make-bitmap 20 10))
|
||||||
(fill-bitmap green-blue-20x10-bitmap "green")
|
(fill-bitmap green-blue-20x10-bitmap "green")
|
||||||
(fill-bitmap green-blue-20x10-bitmap "blue" 10 0 10 10)
|
(fill-bitmap green-blue-20x10-bitmap "blue" 10 0 10 10)
|
||||||
|
|
||||||
|
@ -1285,9 +1285,6 @@
|
||||||
(test (image-baseline (image-snip->image (make-object image-snip% blue-10x20-bitmap)))
|
(test (image-baseline (image-snip->image (make-object image-snip% blue-10x20-bitmap)))
|
||||||
=>
|
=>
|
||||||
20)
|
20)
|
||||||
(test (scale 2 (make-object image-snip% blue-10x20-bitmap))
|
|
||||||
=>
|
|
||||||
(image-snip->image (make-object image-snip% blue-20x40-bitmap)))
|
|
||||||
|
|
||||||
(test (rotate 90 (make-object image-snip% blue-10x20-bitmap))
|
(test (rotate 90 (make-object image-snip% blue-10x20-bitmap))
|
||||||
=>
|
=>
|
||||||
|
@ -1489,9 +1486,9 @@
|
||||||
"white"))
|
"white"))
|
||||||
|
|
||||||
(let* ([bdc (make-object bitmap-dc%)]
|
(let* ([bdc (make-object bitmap-dc%)]
|
||||||
[bm-ul (make-object bitmap% 10 10)]
|
[bm-ul (make-bitmap 10 10)]
|
||||||
[bm-ur (make-object bitmap% 10 10)]
|
[bm-ur (make-bitmap 10 10)]
|
||||||
[bm-ll (make-object bitmap% 10 10)])
|
[bm-ll (make-bitmap 10 10)])
|
||||||
(send bdc set-bitmap bm-ul)
|
(send bdc set-bitmap bm-ul)
|
||||||
(send bdc set-pen "red" 1 'transparent)
|
(send bdc set-pen "red" 1 'transparent)
|
||||||
(send bdc set-brush "red" 'solid)
|
(send bdc set-brush "red" 'solid)
|
||||||
|
@ -2154,8 +2151,8 @@
|
||||||
(let ()
|
(let ()
|
||||||
(define w 200)
|
(define w 200)
|
||||||
(define h 200)
|
(define h 200)
|
||||||
(define bm1 (make-object bitmap% w h))
|
(define bm1 (make-bitmap w h))
|
||||||
(define bm2 (make-object bitmap% w h))
|
(define bm2 (make-bitmap w h))
|
||||||
(define bytes1 (make-bytes (* w h 4) 0))
|
(define bytes1 (make-bytes (* w h 4) 0))
|
||||||
(define bytes2 (make-bytes (* w h 4) 0))
|
(define bytes2 (make-bytes (* w h 4) 0))
|
||||||
(define bdc1 (make-object bitmap-dc% bm1))
|
(define bdc1 (make-object bitmap-dc% bm1))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user