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

modified the playback to use system

Browse Source 
svn: r5152
This commit is contained in:
Matthias Felleisen 2006-12-21 03:03:33 +00:00
parent caffa6d450
commit 69c1149492
1 changed files with 20 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
collects/htdp/world.ss
View File

@ -13,6 +13,7 @@
(lib "etc.ss") (lib "etc.ss")
(lib "list.ss") (lib "list.ss")
(lib "process.ss") (lib "process.ss")
(lib "port.ss")
(lib "mred.ss" "mred") (lib "mred.ss" "mred")
(lib "error.ss" "htdp") (lib "error.ss" "htdp")
(lib "image.ss" "htdp") (lib "image.ss" "htdp")
@ -566,16 +567,14 @@
;; --> Void ;; --> Void
(define (play-back) (define (play-back)
(define target:dir ;; --- state transitions
(let* ([cd (current-directory)]
[dd (get-directory "Select directory for images" #f cd)])
(if dd dd cd)))
(define (world-transition world fst) (define (world-transition world fst)
(case (car fst) (case (car fst)
[(tick) (timer-callback0 world)] [(tick) (timer-callback0 world)]
[(key) (key-callback0 world (cadr fst))] [(key) (key-callback0 world (cadr fst))]
[(mouse) (mouse-callback0 world (cadr fst) (caddr fst) (cadddr fst))] [(mouse) (mouse-callback0 world (cadr fst) (caddr fst) (cadddr fst))]
[else (error 'play-back "bad type of event: ~s" fst)])) [else (error 'play-back "bad type of event: ~s" fst)]))
;; --- creating images
(define image-count 0) (define image-count 0)
(define (save-image img) (define (save-image img)
(define total (length event-history)) (define total (length event-history))
@ -583,6 +582,7 @@
(set! image-count (+ image-count 1)) (set! image-count (+ image-count 1))
(send bm save-file (format "i~a.png" image-count) 'png) (send bm save-file (format "i~a.png" image-count) 'png)
(update-frame (text (format "~a/~a created" image-count total) 18 'red))) (update-frame (text (format "~a/~a created" image-count total) 18 'red)))
;; --- creating the animated gif on my mac
(define (create-animated-gif-on-my-mac) (define (create-animated-gif-on-my-mac)
(define files:dir (map path->string (directory-list))) (define files:dir (map path->string (directory-list)))
(define files:str (define files:str
@ -594,13 +594,19 @@
(define files:sorted (define files:sorted
(sort files:s+i (lambda (x y) (<= (cdr x) (cdr y))))) (sort files:s+i (lambda (x y) (<= (cdr x) (cdr y)))))
(define files:pln (define files:pln
(map (lambda (f) (format " ~a" (car f))) files:sorted)) (map (lambda (f) (format "~a" (car f))) files:sorted))
(define files (apply string-append files:pln)) ; (define files (apply string-append files:pln))
(define cmdline (format "convert -delay 5 ~a i-animated.gif" files)) (define convert (find-executable-path "convert"))
(define status? (process cmdline)) (define a* (append (list "-delay" "5") files:pln (list "i-animated.gif")))
((fifth status?) 'wait)) (apply system* convert a*))
;; re-play the history of events, creating a png per step, ;; re-play the history of events, creating a png per step,
;; summing them into an animated gif at the end ;; summing them into an animated gif at the end
(define target:dir
(let* ([cd (current-directory)]
[dd (get-directory "Select directory for images" #f cd)])
(if dd dd cd)))
(parameterize ([current-directory target:dir]) (parameterize ([current-directory target:dir])
(let pb ([ev event-history][world the-world0][img (circle 1 'solid 'red)]) (let pb ([ev event-history][world the-world0][img (circle 1 'solid 'red)])
(cond (cond