diff --git a/collects/2htdp/private/world.rkt b/collects/2htdp/private/world.rkt index cb31063e18..3d15a16eda 100644 --- a/collects/2htdp/private/world.rkt +++ b/collects/2htdp/private/world.rkt @@ -226,6 +226,11 @@ ;; Any ... -> Boolean (begin (define/public (name arg ...) + (define (last-draw) + (define draw0 draw) + (dynamic-wind (lambda () (set! draw last-picture)) + (lambda () (pdraw)) + (lambda () (set! draw draw0)))) (queue-callback (lambda () (with-handlers ([exn? (handler #t)]) @@ -245,8 +250,7 @@ (begin (set! nw (stop-the-world-world nw)) (send world set tag nw) - (when last-picture - (set! draw last-picture)) + (when last-picture (last-draw)) (when draw (pdraw)) (callback-stop! 'name) (enable-images-button)) @@ -270,9 +274,7 @@ [else (set! draw# (- draw# 1))])) (when (pstop) - (when last-picture - (set! draw last-picture) - (pdraw)) + (when last-picture (last-draw)) (callback-stop! 'name) (enable-images-button)) changed-world?)))))))) diff --git a/collects/2htdp/tests/record-stop-when.rkt b/collects/2htdp/tests/record-stop-when.rkt new file mode 100644 index 0000000000..de3c676ed9 --- /dev/null +++ b/collects/2htdp/tests/record-stop-when.rkt @@ -0,0 +1,40 @@ +#lang racket + +(require 2htdp/universe 2htdp/image (only-in lang/imageeq image=?)) + +(define (draw-number n) + (place-image (text (number->string n) 44 'red) + 50 50 + (empty-scene 100 100))) + +(define (draw-stop n) + stop) +(define stop (text "STOP" 44 'red)) + +;; -> Nat +;; make the clock tick n times, expected expected-n files in dir +(define (create-n-images) + (define dir "images0") + (unless (directory-exists? dir) + (make-directory dir)) + (parameterize ([current-directory dir]) + (for-each delete-file (directory-list))) + (with-output-to-file (format "./~a/index.html" dir) + (lambda () + (displayln "")) + #:exists 'replace) + (define final-world + (big-bang 0 + (on-tick add1) + (stop-when (curry = 5) draw-stop) + (on-draw draw-number) + (record? dir))) + (sleep 1) + (parameterize ([current-directory dir]) + (define dlst (directory-list)) + (displayln dlst) + (length + (filter (lambda (f) (regexp-match "\\.png" (path->string f))) + dlst)))) + +(create-n-images) diff --git a/collects/2htdp/tests/record.rkt b/collects/2htdp/tests/record.rkt index 96989555a3..f22ca740f2 100644 --- a/collects/2htdp/tests/record.rkt +++ b/collects/2htdp/tests/record.rkt @@ -8,10 +8,11 @@ 50 50 (empty-scene 100 100))) -;; Nat String -> Nat -;; create n images in ./images directory -;; ASSUME: dir exists -(define (create-n-images n dir) +;; Nat Nat String -> Nat +;; make the clock tick n times, expected expected-n files in dir +(define (create-n-images n expected-n dir) + (unless (directory-exists? dir) + (make-directory dir)) (parameterize ([current-directory dir]) (for-each delete-file (directory-list))) (with-output-to-file (format "./~a/index.html" dir) @@ -21,7 +22,7 @@ (define final-world (big-bang 0 (on-tick add1) - (stop-when (curry = (+ n 1))) + (stop-when (curry = n)) (on-draw draw-number) (record? dir))) (sleep 1) @@ -32,9 +33,9 @@ (length (filter (lambda (f) (regexp-match "\\.png" (path->string f))) dlst)))) - (unless (= (+ n 2) 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))) -(create-n-images 3 "images3/") -(create-n-images 0 "images0/") \ No newline at end of file +(create-n-images 3 4 "images3/") +(create-n-images 0 0 "images0/") \ No newline at end of file