world with lang scheme

svn: r10331

collects/htdp/Test/world.ss

@@ -2,25 +2,19 @@
 ;; about the language level of this file in a form that our tools can easily process.
 #reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname world) (read-case-sensitive #t) (teachpacks ((lib "world.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "world.ss" "teachpack" "htdp")))))
 ;; testing world
-
 ;; World = Nat
 
-(define world0 10)
+(define world0 100)
 
 (define (world->image w)
-  (place-image (circle 3 'solid 'red)
+  (place-image (circle 3 'solid 'red) 50 w (empty-scene 100 100)))
-               50 w
-               (empty-scene 100 100)))
 
-(define (world->next w) 
+(define (world->next w) (sub1 w))
-  (if (>= (+ w 3) 100)
-      100
-      (+ w 1)))
 
 (define (world->steer w ke)
   (cond
     [(char? ke) w]
-    [(symbol=? ke 'left) 10]
+    [(symbol=? ke 'left) 100]
     [(symbol=? ke 'right) 90]
     [else w]))
 
@@ -31,4 +25,4 @@
 (on-redraw world->image)
 (on-tick-event world->next)
 (on-key-event world->steer)
-(is-end-of-world (lambda (w) (= w 100)))
+(stop-when zero?)

collects/htdp/world.ss

@@ -1,6 +1,6 @@
-;; Mon Jun 16 15:38:14 EDT 2008: removed end-of-time and provided is-end-of-time 
+;; Mon Jun 16 15:38:14 EDT 2008: removed end-of-time and provided stop-when 
 ;;                               also allow repeated setting of callbacks now
-;;                               If this is changed back, is-end-of-world will fail
+;;                               If this is changed back, stop-when will fail
 
 ;; Wed Apr 23 11:42:25 EDT 2008: fixed reverse bug in animation 
 ;; Thu Mar 20 17:15:54 EDT 2008: fixed place-image0, which used shrink off-by-1
@@ -45,13 +45,14 @@ Matthew
 ;; Sat Dec 10 19:39:03 EST 2005: fixed name, changed interface to on-key-event
 ;; Fri Dec  9 21:39:03 EST 2005: remoevd (update ... produce ...); added on-redraw 
 ;; Thu Dec  1 17:03:03 EST 2005: fixed place-image; all coordinates okay now
-(module world mzscheme
+#lang scheme
 (require mzlib/class
+         mzlib/kw
          mzlib/etc
          mred
          htdp/error
          htdp/image
-           (only lang/htdp-beginner image?)
+         (only-in lang/htdp-beginner image?)
          mrlib/cache-image-snip
          lang/prim)
 
@@ -82,7 +83,7 @@ Matthew
 
 ;; image manipulation functions:
 ;; =============================
-  (provide (all-from htdp/image))
+(provide (all-from-out htdp/image))
 
 (provide
  ;; Scene is Image with pinhole in origin 
@@ -128,7 +129,7 @@ Matthew
  )
 
 (provide-higher-order-primitive
-   is-end-of-world (last-world)  ;; (World -> Boolean) -> true
+ stop-when (last-world)  ;; (World -> Boolean) -> true
  )
 
 (provide-higher-order-primitive
@@ -284,10 +285,10 @@ Matthew
   (set-mouse-callback f (current-eventspace))
   #t)
 
-  (define (is-end-of-world f)
+(define (stop-when f)
-    (check-proc 'is-end-of-world f 1 "is-end-of-world" "one argument")
+  (check-proc 'stop-when f 1 "stop-when" "one argument")
-    (check-world 'is-end-of-world)
+  (check-world 'stop-when)
-    (set-is-end-of-world-callback f)
+  (set-stop-when-callback f)
   #t)
 
 (define (run-movie movie)
@@ -734,7 +735,8 @@ Matthew
       (update-frame (text (format "~a/~a created" image-count total) 18 'red))
       (save-image img)
       (cond
-          [(null? ev) (update-frame (text "creating i-animated.gif" 18 'red))
+        [(null? ev)
+         (update-frame (text (format "creating ~a" ANIMATED-GIF-FILE) 18 'red))
          (create-animated-gif (reverse bitmap-list))
          (update-frame img)]
         [else
@@ -748,7 +750,7 @@ Matthew
   (define intv (if (> +inf.0 *the-delta* 0) (inexact->exact (floor (* 100 *the-delta*))) 5))
   (when (file-exists? ANIMATED-GIF-FILE)
     (delete-file ANIMATED-GIF-FILE))
-    (write-animated-gif bitmap-list intv ANIMATED-GIF-FILE #:one-at-a-time? #t))
+  (write-animated-gif bitmap-list intv ANIMATED-GIF-FILE #;one-at-a-time? #t))
 
 (define ANIMATED-GIF-FILE "i-animated.gif")
 
@@ -768,7 +770,7 @@ Matthew
 ;                                                                 
 ;                                                                 
 
-  ;; callbacks: timer, mouse, key, redraw, is-end-of-world 
+;; callbacks: timer, mouse, key, redraw, stop-when 
 
 ;; Definition = (define-callback Symbol String Symbol Expression ...)
 ;; effect: (define-callback introduces three names: name, name0, set-name
@@ -779,9 +781,9 @@ Matthew
             [callback (lambda (before after)
                         (string->symbol 
                          (string-append before n:str "-callback" after)))]
-              [name (datum->syntax-object stx (callback "" ""))]
+            [name (datum->syntax stx (callback "" ""))]
-              [name0 (datum->syntax-object stx (callback "" "0"))]
+            [name0 (datum->syntax stx (callback "" "0"))]
-              [set-name (datum->syntax-object stx (callback "set-" ""))])
+            [set-name (datum->syntax stx (callback "set-" ""))])
        #`(define-values (#,name #,name0 #,set-name)
            (values 
             void void 
@@ -798,7 +800,7 @@ Matthew
   (set! timer-callback void)
   (set! mouse-callback void)
   (set! key-callback void)
-    (set! is-end-of-world-callback (lambda (w) #f))
+  (set! stop-when-callback (lambda (w) #f))
   (set! redraw-callback void))
 
 ;; Any -> Boolean
@@ -828,17 +830,17 @@ Matthew
         (check-result tname (lambda (x) (image? x)) "scene" result))
     (update-frame result)
     ;; if this world is the last one, stop the world
-      (when (is-end-of-world-callback)
+    (when (stop-when-callback)
       (callback-stop!))))
 
 ;; f : [World -> Boolean]
-  (define-callback is-end-of-world "is end of world check" (f) ()
+(define-callback stop-when "is end of world check" (f) ()
   (define result (f the-world))
   (define fname (object-name f))
   (define tname (if fname fname 'your-redraw-function))
   (check-result fname boolean? "boolean" result)
   result)
-  (set-is-end-of-world-callback (lambda (w) #f))
+(set-stop-when-callback (lambda (w) #f))
 
 ;; f : [World KeyEvent -> World]
 ;; esp : EventSpace 
@@ -894,4 +896,4 @@ Matthew
 ;; Number -> Integer
 (define (number->integer x)
   (inexact->exact (floor x)))
-  )
+