world modified

svn: r5140
This commit is contained in:
Matthias Felleisen 2006-12-19 19:47:05 +00:00
parent cbfdfd91b4
commit 586b47c0dd

View File

@ -34,6 +34,19 @@
;; 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
on-tick-event (tock) ;; (World -> World) -> true
)
@ -95,10 +108,11 @@
(define (place-image image x y scene)
(check-image 'place-image image "first")
(check-arg 'place-image (and (number? x) (integer? x)) 'integer "second" x)
(check-arg 'place-image (and (number? y) (integer? x)) 'integer "third" y)
(check-arg 'place-image (number? x) 'integer "second" x)
(check-arg 'place-image (number? y) 'integer "third" y)
(check-image 'place-image scene "fourth" "scene")
(let ()
(let ([x (number->integer x)]
[y (number->integer y)])
(define sw (image-width scene))
(define sh (image-height scene))
(define ns (overlay/xy scene x y image))
@ -108,6 +122,8 @@
ns
(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)
#|
(check-image 'add-line image "first")
@ -475,10 +491,11 @@
(lambda (x y)
(<= (string->number (car (regexp-match #rx"[0-9]+" x)))
(string->number (car (regexp-match #rx"[0-9]+" y)))))))
#;
(define cmdline (format "convert -delay 5 ~a ~a.gif"
(apply string-append (map (lambda (x) (format " ~a" x)) files))
d))
#;
(system cmdline)
#t))