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

fix predicates to return booleans

Browse Source
This commit is contained in:
Robby Findler 2012-02-07 20:29:38 -06:00
parent 4bac243efe
commit ed22a630fd
2 changed files with 35 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
collects/2htdp/private/img-err.rkt
View File

@ -282,11 +282,15 @@
argname)]))
(define (y-place? arg)
(member arg '("top" top "bottom" bottom "middle" middle "center" center "baseline" baseline "pinhole" pinhole)))
(and (member arg '("top" top "bottom" bottom "middle" middle "center" center
"baseline" baseline "pinhole" pinhole))
#t))
(define (x-place? arg)
(member arg '("left" left "right" right "middle" middle "center" center "pinhole" pinhole)))
(and (member arg '("left" left "right" right "middle" middle
"center" center "pinhole" pinhole))
#t))
(define (mode? arg)
(or (member arg '(solid outline "solid" "outline"))
(or (and (member arg '(solid outline "solid" "outline")) #t)
(and (integer? arg)
(<= 0 arg 255))))
(define (angle? arg)
@ -300,14 +304,17 @@
(1 . <= . i)))
(define (image-color? c) (or (symbol? c) (string? c) (color? c)))
(define (pen-style? arg)
(member (if (string? arg) (string->symbol arg) arg)
'(solid dot long-dash short-dash dot-dash)))
(and (member (if (string? arg) (string->symbol arg) arg)
'(solid dot long-dash short-dash dot-dash))
#t))
(define (pen-cap? arg)
(member (if (string? arg) (string->symbol arg) arg)
'(round projecting butt)))
(and (member (if (string? arg) (string->symbol arg) arg)
'(round projecting butt))
#t))
(define (pen-join? arg)
(member (if (string? arg) (string->symbol arg) arg)
'(round bevel miter)))
(and (member (if (string? arg) (string->symbol arg) arg)
'(round bevel miter))
#t))
(define (real-valued-posn? arg)
(and (posn? arg)
(real? (posn-x arg))

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

@ -120,6 +120,25 @@
(map loop (cdr (vector->list (struct->vector x))))))]
[else x])))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; predicates
;;
(test (mode? "outline") => #t)
(test (mode? 'outline) => #t)
(test (mode? 'oooutlineh) => #f)
(test (pen-style? 'solid) => #t)
(test (pen-style? 'solidd) => #f)
(test (pen-cap? 'round) => #t)
(test (pen-cap? 'roound) => #f)
(test (pen-join? 'round) => #t)
(test (pen-join? 'roound) => #f)
(test (x-place? 'left) => #t)
(test (x-place? 'zuo) => #f)
(test (y-place? 'top) => #t)
(test (y-place? 'shang) => #f)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; circle vs ellipse