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

allow outline and solid arguments to image contructors to be strings

Browse Source 
svn: r1036
This commit is contained in:
Robby Findler 2005-10-10 17:04:35 +00:00
parent 9426bc8248
commit ff430e189d
2 changed files with 50 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/htdp/image.ss
View File

@ -91,21 +91,21 @@ plt/collects/tests/mzscheme/image-test.ss
(error (format "cannot make ~a x ~a image" w h))))
(define (mode? x)
(or (eq? x 'solid)
(eq? x 'outline)))
(member x '(solid "solid" outline "outline")))
(define mode-str "'solid or 'outline")
(define mode-str "'solid \"solid\" 'outline or \"outline\"")
(define (mode->brush-symbol m)
(case m
[(solid) 'solid]
[(outline) 'transparent]))
(cond
[(member m '(solid "solid"))
'solid]
[(member m '(outline "outline"))
'transparent]))
(define (mode->pen-symbol m)
(case m
[(solid) 'transparent]
[(outline) 'solid]))
(cond
[(member m '(solid "solid")) 'transparent]
[(member m '(outline "outline")) 'solid]))
(define (make-color% c)
(cond

45
collects/tests/mzscheme/htdp-image.ss
View File

@ -141,6 +141,27 @@
'color-list
(image->color-list (rectangle 2 2 'solid 'blue)))
(test (list blue blue blue
blue blue blue
blue blue blue)
'color-list2
(image->color-list (rectangle 3 3 'solid 'blue)))
(test (list blue blue blue
blue blue blue
blue blue blue)
'color-list2
(image->color-list (rectangle 3 3 "solid" 'blue)))
(test (list blue blue blue
blue white blue
blue blue blue)
'color-list2
(image->color-list (rectangle 3 3 'outline 'blue)))
(test (list blue blue blue
blue white blue
blue blue blue)
'color-list2
(image->color-list (rectangle 3 3 "outline" 'blue)))
(test #t
'color-list
(image=? (color-list->image (list blue blue blue blue) 2 2 0 0)
@ -160,15 +181,29 @@
(car (image->alpha-color-list (rectangle 1 1 'solid 'red)))))
(test #t
'alpha-color-list2
(equal? (make-alpha-color 0 255 0 0)
(car (image->alpha-color-list (rectangle 1 1 "solid" 'red)))))
(test #t
'alpha-color-list3
(andmap (lambda (x) (equal? x (make-alpha-color 0 255 0 0)))
(image->alpha-color-list (rectangle 1 1 "solid" 'red))))
(test #t
'alpha-color-list4
(andmap (lambda (x) (equal? x (make-alpha-color 0 255 0 0)))
(image->alpha-color-list (rectangle 1 1 'solid 'red))))
(test #t
'alpha-color-list5
(equal? (make-alpha-color 0 0 255 0)
(car (image->alpha-color-list (rectangle 1 1 'solid 'green)))))
(test #t
'alpha-color-list3
'alpha-color-list6
(equal? (make-alpha-color 0 0 0 255)
(car (image->alpha-color-list (rectangle 1 1 'solid 'blue)))))
(test #t
'alpha-color-list4
'alpha-color-list7
(= (image-width
(alpha-color-list->image
(list ared aclr ared
@ -180,7 +215,7 @@
3))
(test #t
'alpha-color-list5
'alpha-color-list8
(= (image-height
(alpha-color-list->image
(list ared aclr ared
@ -192,7 +227,7 @@
2))
(test #t
'alpha-color-list6
'alpha-color-list9
(equal? (image->color-list
(alpha-color-list->image
(list ared aclr ared
@ -201,7 +236,7 @@
(list red white red
white white white)))
(test #t
'alpha-color-list7
'alpha-color-list10
(equal? (image->color-list
(overlay
(p00 (rectangle 3 3 'solid 'blue))