interpolation for recorded animation; for David for now

pkgs/htdp-pkgs/htdp-lib/2htdp/private/world.rkt

@@ -431,7 +431,10 @@
 (define aworld%
   (class world% 
     ;; an argument-recording ppdraw
-    (field [image-history '()]) ;; [Listof Evt]
+    
+    ;; [Listof [List N Image]]
+    ;; a list of the displayed images combined with a time stamp 
+    (field [image-history '()]) 
     
     (super-new)
     (inherit-field world0 draw rate width height record?)
@@ -468,7 +471,7 @@
     
     (define/override (ppdraw)
       (define image (super ppdraw))
-      (set! image-history (cons image image-history))
+      (set! image-history (cons (list (current-inexact-milliseconds) image) image-history))
       image)
     
     ;; --> Void
@@ -498,14 +501,47 @@
             (get-directory "image directory:" #f (current-directory))))
       (when img:dir
         (parameterize ([current-directory img:dir])
+          (define image-history-interpolated (interpolate-history image-history))
           (define imageN 
-            (if (empty? image-history)
+            (if (empty? image-history-interpolated)
                 (save-image (draw world0))
-                (first (map save-image image-history))))
+                (first (map save-image image-history-interpolated))))
           (show (text (format "creating ~a" ANIMATED-GIF-FILE) 18 'red))
           (create-animated-gif rate bmps)
           (show imageN))))))
 
+;; ---------------------------------------------------------------------------------------------------
+;; [Listof [List Real Image]] -> [Listof Image]
+;; for David's talk
+(define (interpolate-history lox0)
+  (define lox (reverse lox0))
+  (cond 
+    [(or (empty? lox) (empty? (rest lox))) (map second lox)]
+    [else 
+     ;; -----------------------------------------------------------------------------x
+     (define raw-times (map first lox))
+     (define intervals 
+       (let loop ([l (rest raw-times)][last (first raw-times)])
+         (cond
+           [(empty? l) '()]
+           [else (cons (- (first l) last) (loop (rest l) (first l)))])))
+     (define delta (apply min intervals))
+     ;; -----------------------------------------------------------------------------
+     (define image1 (second (first lox)))
+     (let loop ([last-image image1][t (first (first lox))][lox (rest lox)][images (list image1)])
+       (cond
+         [(empty? lox) images]
+         [else (define stamp+image (first lox))
+               (define stamp (first stamp+image))
+               (define image (second stamp+image))
+               (define new-t (+ delta t))
+               (if (< new-t stamp)
+                   (loop last-image new-t lox (cons last-image images))
+                   (loop image      new-t (rest lox) (cons image  images)))]))]))
+
+;; ---------------------------------------------------------------------------------------------------
+
+
 ;; Number [Listof (-> bitmap)] -> Void
 ;; turn the list of thunks into animated gifs 
 ;; effect: overwrite the ANIMATED-GIF-FILE (in current directory)

pkgs/htdp-pkgs/htdp-test/2htdp/tests/record.rkt

@@ -32,7 +32,7 @@
       (length
        (filter (lambda (f) (regexp-match "\\.png" (path->string f)))
                dlst))))
-  (unless (= expected-n number-of-png)
+  (unless (<= expected-n number-of-png)
     (error 'record? "(~s, ~s) didn't record proper number of images: ~s" n dir 
            number-of-png)))