record? is working as it used, plus ability to auto-save images so I can write a test case, Closes PR11348 and PR11349

collects/2htdp/private/syn-aux-aux.rkt

@@ -18,7 +18,7 @@
 ;          ;   ;                                    
 ;           ;;;                                     
 
-(provide nat> nat? proc> bool> num> ip> string> symbol>)
+(provide nat> nat? proc> bool> num> ip> string> symbol> any>)
 
 ;; Any -> Boolean
 (define (nat? x)
@@ -58,3 +58,7 @@
 (define (nat> tag x spec)
   (check-arg tag (nat? x) spec "natural number" x)
   x)
+
+;; Symbol X String -> X
+(define (any> tag x)
+  x)

collects/2htdp/private/world.rkt

@@ -51,8 +51,8 @@
     (class* object% (start-stop<%>)
       (inspect #f)
       (init-field world0)
-      (init-field name state register check-with on-key on-mouse)
+      (init-field name state register check-with on-key on-mouse record?)
-      (init on-release on-receive on-draw stop-when record?)
+      (init on-release on-receive on-draw stop-when)
       
       ;; -----------------------------------------------------------------------
       (field
@@ -341,9 +341,8 @@
       (start!)
       (let ([w (send world get)])
         (cond
-          [(stop w) (stop! (send world get))]
+          [(stop w) (stop! w)]
-          [(stop-the-world? w) 
+          [(stop-the-world? w) (stop! (stop-the-world-world w))]))))))
-           (stop! (stop-the-world-world (send world get)))]))))))
 
 ; (define make-new-world (new-world world%))
 
@@ -357,7 +356,7 @@
 
 (define aworld%
   (class world% (super-new)
-    (inherit-field world0 tick key release mouse rec draw rate width height)
+    (inherit-field world0 tick key release mouse rec draw rate width height record?)
     (inherit show callback-stop!)
     
     ;; Frame Custodian ->* (-> Void) (-> Void)
@@ -365,9 +364,15 @@
     ;; whose callbacks runs as a thread in the custodian
     (define/augment (create-frame frm play-back-custodian)
       (define p (new horizontal-pane% [parent frm][alignment '(center center)]))
+      (define (pb)
+        (parameterize ([current-custodian play-back-custodian])
+          (thread (lambda () (play-back)))
+          (stop)))
       (define (switch)
         (send stop-button enable #f)
-        (send image-button enable #t))
+        (if (and (string? record?) (directory-exists? record?))
+            (pb)
+            (send image-button enable #t)))
       (define (stop) 
         (send image-button enable #f)
         (send stop-button enable #f))
@@ -377,10 +382,7 @@
       (define stop-button 
         (btn break-button:label (b e) (callback-stop! 'stop-images) (switch)))
       (define image-button 
-        (btn image-button:label (b e)
+        (btn image-button:label (b e) (pb)))
-             (parameterize ([current-custodian play-back-custodian])
-               (thread (lambda () (play-back)))
-               (stop))))
       (send image-button enable #f)
       (values switch stop))
     
@@ -392,10 +394,8 @@
     ;; --- new callbacks ---
     (define-syntax-rule
       (def/cb ovr (pname name arg ...))
-      (begin 
-        ; (ovr pname)
       (define/override (pname arg ...) 
-          (when (super pname arg ...) (add-event 'name arg ...)))))
+	(when (super pname arg ...) (add-event name arg ...))))
     
     (def/cb augment (ptock tick))
     (def/cb augment (pkey key e))
@@ -424,19 +424,20 @@
         (send bm save-file (format "i~a.png" (zero-fill imag# digt#)) 'png)
         (set! bmps (cons bm bmps)))
       ;; --- choose place 
-      (define img:dir (get-directory "image directory:" #f (current-directory)))
+      (define img:dir 
+        (or (and (string? record?) (directory-exists? record?) record?)
+            (get-directory "image directory:" #f (current-directory))))
       (when img:dir
         (parameterize ([current-directory img:dir])
-          (define last 
+          (define worldN 
-            (foldr (lambda (event world)
+            (let L ([history event-history][world world0])
               (save-image (draw world))
-                     (show (text (format "~a/~a created" imag# total) 18 'red))
+              (if (empty? history) 
-                     (world-transition world event))
+                  world
-                   world0 
+                  (L (rest history) (world-transition world (first history))))))
-                   event-history))
           (show (text (format "creating ~a" ANIMATED-GIF-FILE) 18 'red))
           (create-animated-gif rate (reverse bmps))
-          (show (draw last)))))))
+          (show (draw worldN)))))))
 
 ;; Number [Listof (-> bitmap)] -> Void
 ;; turn the list of thunks into animated gifs 

collects/2htdp/tests/record.rkt

@@ -0,0 +1,40 @@
+#lang racket
+
+(require 2htdp/universe)
+(require 2htdp/image)
+
+(define (draw-number n)
+  (place-image (text (number->string n) 44 'red)
+               50 50
+               (empty-scene 100 100)))
+
+;; Nat String -> Nat 
+;; create n images in ./images directory
+;; ASSUME: dir exists 
+(define (create-n-images n dir)
+  (parameterize ([current-directory dir])
+    (for-each delete-file (directory-list)))
+  (with-output-to-file (format "./~a/index.html" dir)
+    (lambda ()
+      (displayln "<html><body><img src=\"i-animated.gif\" /></body></html>"))
+    #:exists 'replace)
+  (define final-world 
+   (big-bang 0
+             (on-tick add1)
+             (stop-when (curry = (+ n 1)))
+             (on-draw draw-number)
+             (record? dir)))
+  (sleep 1)
+  (define number-of-png
+    (parameterize ([current-directory dir])
+      (define dlst (directory-list))
+      ; (displayln dlst)
+      (length
+       (filter (lambda (f) (regexp-match "\\.png" (path->string f)))
+               dlst))))
+  (unless (= (+ n 2) number-of-png)
+    (error 'record? "(~s, ~s) didn't record proper number of images: ~s" n dir 
+           number-of-png)))
+
+(create-n-images 3 "images3/")
+(create-n-images 0 "images0/")

collects/2htdp/universe.rkt

@@ -94,9 +94,10 @@
               [(_ stop? last-picture)
                #'(list (proc> 'stop-when (f2h stop?) 1)
                        (proc> 'stop-when (f2h last-picture) 1))])]
-  ;; (U #f Boolean)
+  ;; (U #f Any)
   ;; -- should the session be recorded and turned into PNGs and an animated GIF
-  [record? DEFAULT #'#f (expr-with-check bool> "expected a boolean")]
+  ;; -- if the value is a string and is the name of a local directory, use it! 
+  [record? DEFAULT #'#f (expr-with-check any> "")]
   ;; (U #f String)
   ;; -- name specifies one string 
   [name DEFAULT #'#f (expr-with-check string> "expected a string")]