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) (define (internal-scene? i)
(and (= 0 (pinhole-x i)) (= 0 (pinhole-y i)))) (and (= 0 (pinhole-x i)) (= 0 (pinhole-y i))))
;; Number -> Integer ;; Number Symbol Symbol -> Integer
(define (number->integer x) (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))) (inexact->exact (floor x)))
;; ----------------------------------------------------------------------------- ;; -----------------------------------------------------------------------------
@ -160,7 +163,7 @@
;; Symbol Any String -> Void ;; Symbol Any String -> Void
(define (check-pos t c r) (define (check-pos t c r)
(check-arg (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 ;; Symbol Any String String *-> Void
(define (check-image tag i rank . other-message) (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) (define (place-image image x y scene)
(check-image 'place-image image "first") (check-image 'place-image image "first")
(check-arg 'place-image (number? x) 'integer "second" x) (check-arg 'place-image (real? x) 'real "second" x)
(check-arg 'place-image (number? y) 'integer "third" y) (check-arg 'place-image (real? y) 'real "third" y)
(check-scene 'place-image scene "fourth") (check-scene 'place-image scene "fourth")
(let ([x (number->integer x)] (let ([x (number->integer x)]
[y (number->integer y)]) [y (number->integer y)])
@ -55,14 +55,14 @@
(define (scene+line img x0 y0 x1 y1 c) (define (scene+line img x0 y0 x1 y1 c)
;; img and c are checked via calls to add-line from image.ss ;; 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 (scene? img) "scene" "first" "plain image")
(check-arg 'scene+line (number? x0) "number" "second" x0) (check-arg 'scene+line (real? x0) "number" "second" x0)
(check-arg 'scene+line (number? y0) "number" "third" y0) (check-arg 'scene+line (real? y0) "number" "third" y0)
(check-arg 'scene+line (number? x1) "number" "fourth" x1) (check-arg 'scene+line (real? x1) "number" "fourth" x1)
(check-arg 'scene+line (number? y1) "number" "fifth" y1) (check-arg 'scene+line (real? y1) "number" "fifth" y1)
(let ([x0 (number->integer x0)] (let ([x0 (number->integer x0 'scene+line 'second)]
[x1 (number->integer x1)] [x1 (number->integer x1 'scene+line 'third)]
[y0 (number->integer y0)] [y0 (number->integer y0 'scene+line 'fourth)]
[y1 (number->integer y1)]) [y1 (number->integer y1 'scene+line 'fifth)])
(add-line-to-scene0 img x0 y0 x1 y1 c))) (add-line-to-scene0 img x0 y0 x1 y1 c)))
;; Image Number Number Image -> Image ;; Image Number Number Image -> Image

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

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

4
collects/2htdp/universe.ss
View File

@ -40,7 +40,9 @@
except except
[(_ x rate) [(_ x rate)
#'(list (proc> 'on-tick (f2h x) 1) #'(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 specifies whether to display the current state
[state (expr-with-check bool> "expected a boolean (show state or not)")] [state (expr-with-check bool> "expected a boolean (show state or not)")]
;; -- check-with must specify a predicate ;; -- check-with must specify a predicate