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

fixed weak contract for real numbers; no need to propagate

Browse Source 
svn: r16102
This commit is contained in:
Matthias Felleisen 2009-09-21 14:11:43 +00:00
parent 8daec2e15d
commit c15885ca6c
4 changed files with 20 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/2htdp/private/check-aux.ss
View File

@ -41,8 +41,11 @@
(define (internal-scene? i)
(and (= 0 (pinhole-x i)) (= 0 (pinhole-y i))))
;; Number -> Integer
(define (number->integer x)
;; Number Symbol Symbol -> Integer
(define (number->integer x . rst)
(define t (if (pair? rst) (car rst) ""))
(define p (if (and (pair? rst) (pair? (cdr rst))) (cadr rst) ""))
(check-arg t (and (number? x) (real? x)) "real number" p x)
(inexact->exact (floor x)))
;; -----------------------------------------------------------------------------
@ -160,7 +163,7 @@
;; Symbol Any String -> Void
(define (check-pos t c r)
(check-arg
t (and (number? c) (>= (number->integer c) 0)) "positive integer" r c))
t (and (number? c) (>= (number->integer c t r) 0)) "positive integer" r c))
;; Symbol Any String String *-> Void
(define (check-image tag i rank . other-message)

20
collects/2htdp/private/image.ss
View File

@ -37,8 +37,8 @@
(define (place-image image x y scene)
(check-image 'place-image image "first")
(check-arg 'place-image (number? x) 'integer "second" x)
(check-arg 'place-image (number? y) 'integer "third" y)
(check-arg 'place-image (real? x) 'real "second" x)
(check-arg 'place-image (real? y) 'real "third" y)
(check-scene 'place-image scene "fourth")
(let ([x (number->integer x)]
[y (number->integer y)])
@ -55,14 +55,14 @@
(define (scene+line img x0 y0 x1 y1 c)
;; img and c are checked via calls to add-line from image.ss
(check-arg 'scene+line (scene? img) "scene" "first" "plain image")
(check-arg 'scene+line (number? x0) "number" "second" x0)
(check-arg 'scene+line (number? y0) "number" "third" y0)
(check-arg 'scene+line (number? x1) "number" "fourth" x1)
(check-arg 'scene+line (number? y1) "number" "fifth" y1)
(let ([x0 (number->integer x0)]
[x1 (number->integer x1)]
[y0 (number->integer y0)]
[y1 (number->integer y1)])
(check-arg 'scene+line (real? x0) "number" "second" x0)
(check-arg 'scene+line (real? y0) "number" "third" y0)
(check-arg 'scene+line (real? x1) "number" "fourth" x1)
(check-arg 'scene+line (real? y1) "number" "fifth" y1)
(let ([x0 (number->integer x0 'scene+line 'second)]
[x1 (number->integer x1 'scene+line 'third)]
[y0 (number->integer y0 'scene+line 'fourth)]
[y1 (number->integer y1 'scene+line 'fifth)])
(add-line-to-scene0 img x0 y0 x1 y1 c)))
;; Image Number Number Image -> Image

2
collects/2htdp/private/timer.ss
View File

@ -30,7 +30,7 @@
[timer (new timer% [notify-callback (lambda () (ptock))])])
(define/override (start!)
(unless (<= rate 0)
(send timer start (number->integer (* 1000 rate))))
(send timer start (number->integer (* 1000 rate) 'big-bang/universe 'clock-rate)))
(super start!))
(define/override (stop! w)
(send timer stop)

4
collects/2htdp/universe.ss
View File

@ -40,7 +40,9 @@
except
[(_ x rate)
#'(list (proc> 'on-tick (f2h x) 1)
(num> 'on-tick rate positive? "pos. number" "rate"))])]
(num> 'on-tick rate (lambda (x)
(and (real? x) (positive? x)))
"pos. number" "rate"))])]
;; -- state specifies whether to display the current state
[state (expr-with-check bool> "expected a boolean (show state or not)")]
;; -- check-with must specify a predicate