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

world modified

Browse Source 
svn: r5140
This commit is contained in:
Matthias Felleisen 2006-12-19 19:47:05 +00:00
parent cbfdfd91b4
commit 586b47c0dd
1 changed files with 163 additions and 146 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
collects/htdp/world.ss
View File

@ -34,6 +34,19 @@
;; cut all pieces that are outside the given rectangle ;; cut all pieces that are outside the given rectangle
) )
(provide-higher-order-primitive
run-simulation (_ _ _ create-scene) ;; (Nat Nat Number (Nat -> Image) -> true)
)
(define (run-simulation width height rate f)
(check-pos 'run-simulation width "first")
(check-pos 'run-simulation height "second")
(check-arg 'run-simulation (number? rate) 'number "third" rate)
(check-proc 'run-simulation f 1 "fourth" "one argument")
(big-bang width height rate 1)
(on-redraw f)
(on-tick-event add1))
(provide-higher-order-primitive (provide-higher-order-primitive
on-tick-event (tock) ;; (World -> World) -> true on-tick-event (tock) ;; (World -> World) -> true
) )
@ -95,10 +108,11 @@
(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 (and (number? x) (integer? x)) 'integer "second" x) (check-arg 'place-image (number? x) 'integer "second" x)
(check-arg 'place-image (and (number? y) (integer? x)) 'integer "third" y) (check-arg 'place-image (number? y) 'integer "third" y)
(check-image 'place-image scene "fourth" "scene") (check-image 'place-image scene "fourth" "scene")
(let () (let ([x (number->integer x)]
[y (number->integer y)])
(define sw (image-width scene)) (define sw (image-width scene))
(define sh (image-height scene)) (define sh (image-height scene))
(define ns (overlay/xy scene x y image)) (define ns (overlay/xy scene x y image))
@ -108,6 +122,8 @@
ns ns
(shrink ns 0 0 sw sh)))) (shrink ns 0 0 sw sh))))
(define (number->integer x) (inexact->exact (floor x)))
(define (add-line-to-scene img x0 y0 x1 y1 c) (define (add-line-to-scene img x0 y0 x1 y1 c)
#| #|
(check-image 'add-line image "first") (check-image 'add-line image "first")
@ -475,10 +491,11 @@
(lambda (x y) (lambda (x y)
(<= (string->number (car (regexp-match #rx"[0-9]+" x))) (<= (string->number (car (regexp-match #rx"[0-9]+" x)))
(string->number (car (regexp-match #rx"[0-9]+" y))))))) (string->number (car (regexp-match #rx"[0-9]+" y)))))))
#;
(define cmdline (format "convert -delay 5 ~a ~a.gif" (define cmdline (format "convert -delay 5 ~a ~a.gif"
(apply string-append (map (lambda (x) (format " ~a" x)) files)) (apply string-append (map (lambda (x) (format " ~a" x)) files))
d)) d))
#;
(system cmdline) (system cmdline)
#t)) #t))