suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

partial fix for pr11350

Browse Source
This commit is contained in:
Matthias Felleisen 2010-10-27 10:12:37 -04:00
parent 95c3772e8a
commit f876a854c6
3 changed files with 56 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/2htdp/private/world.rkt
View File

@ -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?))))))))

40
collects/2htdp/tests/record-stop-when.rkt Normal file
View File

@ -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 "<html><body><img src=\"i-animated.gif\" /></body></html>"))
#: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)

17
collects/2htdp/tests/record.rkt
View File

@ -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/")
(create-n-images 3 4 "images3/")
(create-n-images 0 0 "images0/")