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

fixed image.ss to handle the case when positive and negative infinity are supplied to overlay/xy and also limited one-of/c's inputs

Browse Source 
svn: r2659
This commit is contained in:
Robby Findler 2006-04-11 13:53:53 +00:00
parent 2df38b2be3
commit 0ad4118f6f
3 changed files with 16 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/htdp/image.ss
View File

@ -76,7 +76,7 @@ plt/collects/tests/mzscheme/image-test.ss
(define (check name p? v desc arg-posn) (check-arg name (p? v) desc arg-posn v))
(define (check-coordinate name val arg-posn) (check name number? val "number" arg-posn))
(define (check-integer-coordinate name val arg-posn) (check name integer? val "integer" arg-posn))
(define (check-integer-coordinate name val arg-posn) (check name nii? val "integer" arg-posn))
(define (check-size name val arg-posn) (check name posi? val "positive exact integer" arg-posn))
(define (check-size/0 name val arg-posn) (check name nnosi? val "non-negative exact integer" arg-posn))
(define (check-image name val arg-posn) (check name image? val "image" arg-posn))
@ -85,6 +85,7 @@ plt/collects/tests/mzscheme/image-test.ss
(define (posi? i) (and (number? i) (integer? i) (positive? i) (exact? i)))
(define (nnosi? i) (and (number? i) (integer? i) (exact? i) (or (zero? i) (positive? i))))
(define (nii? x) (and (integer? x) (not (= x +inf.0)) (not (= x -inf.0))))
(define (check-sizes who w h)

13
collects/mzlib/private/contract.ss
View File

@ -938,7 +938,18 @@ add struct contracts for immutable structs?
(apply string-append (map (lambda (x) (format "~e " x)) ss))))
(make-one-of/c ss))
(define (one-of/c . elems) (make-one-of/c elems))
(define atomic-value?
(let ([undefined (letrec ([x x]) x)])
(λ (x)
(or (char? x) (symbol? x) (boolean? x)
(null? x) (keyword? x) (number? x)
(void? x) (eq? x undefined)))))
(define (one-of/c . elems)
(unless (andmap atomic-value? elems)
(error 'one-of/c "expected chars, symbols, booleans, null, keywords, numbers, void, or undefined, got ~e"
elems))
(make-one-of/c elems))
(define-struct/prop one-of/c (elems)
((pos-proj-prop flat-pos-proj)

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

@ -1063,5 +1063,7 @@ snips as arguments
(circle 50 'outline 'blue))
"third")
(err/rt-name-test (overlay/xy (rectangle 100 200 'outline 'red) 10 10 #f) "fourth")
(err/rt-name-test (overlay/xy (rectangle 100 200 'outline 'red) 10 +inf.0 #f) "third")
(err/rt-name-test (overlay/xy (rectangle 100 200 'outline 'red) -inf.0 +inf.0 #f) "second")
(report-errs)