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

fixed small bug in draw check; eliminated the 'equal' optimization

Browse Source 
svn: r17649
This commit is contained in:
Matthias Felleisen 2010-01-14 17:43:44 +00:00
parent 485900bfa6
commit be76ed2add
3 changed files with 45 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/2htdp/private/checked-cell.ss
View File

@ -73,12 +73,14 @@
;; effect: set value to v if distinct, also display it if pb exists ;; effect: set value to v if distinct, also display it if pb exists
(define/public (set tag v) (define/public (set tag v)
(define nw (coerce tag v)) (define nw (coerce tag v))
(if (equal? value nw) ;; this is the old Robby "optimization" for not triggering draw
#t ;; when the world doesn't change
(begin ;if (equal? value nw)
(set! value nw) ; #t
(when pb (show-state)) (begin
#f))) (set! value nw)
(when pb (show-state))
#f))
;; -> ok? ;; -> ok?
(define/public (get) value) (define/public (get) value)

2
collects/2htdp/private/universe-image.ss
View File

@ -58,7 +58,7 @@
i i
(if (1:image? i) (if (1:image? i)
(check-result tname 1:scene? "scene" i (image-pins i)) (check-result tname 1:scene? "scene" i (image-pins i))
(check-result tname #f "scene" i)))) (check-result tname (lambda _ #f) "scene" i))))
(define (image-pins i) (define (image-pins i)
(format "image with pinhole at (~s,~s)" (1:pinhole-x i) (1:pinhole-y i))) (format "image with pinhole at (~s,~s)" (1:pinhole-x i) (1:pinhole-y i)))

70
collects/2htdp/private/world.ss
View File

@ -233,39 +233,40 @@
(broadcast (package-message nw)) (broadcast (package-message nw))
(set! nw (package-world nw))) (set! nw (package-world nw)))
(if (stop-the-world? nw) (if (stop-the-world? nw)
(begin (begin
(set! nw (stop-the-world-world nw)) (set! nw (stop-the-world-world nw))
(send world set tag nw) (send world set tag nw)
(when last-picture (when last-picture
(set! draw last-picture)) (set! draw last-picture))
(when draw (pdraw)) (when draw (pdraw))
(callback-stop! 'name) (callback-stop! 'name)
(enable-images-button)) (enable-images-button))
(let ([changed-world? (send world set tag nw)]) (let ([changed-world? (send world set tag nw)])
(unless changed-world? ;; this is the old "Robby optimization" see checked-cell:
(when draw ; unless changed-world?
(cond (when draw
[(not drawing) (cond
(set! drawing #t) [(not drawing)
(let ([b (box d)]) (set! drawing #t)
(set! w (cons b w)) (let ([b (box d)])
;; low priority, otherwise it's too fast (set! w (cons b w))
(queue-callback (lambda () ((unbox b))) #f))] ;; low priority, otherwise it's too fast
[(< draw# 0) (queue-callback (lambda () ((unbox b))) #f))]
(set-draw#!) [(< draw# 0)
(for-each (lambda (b) (set-box! b void)) w) (set-draw#!)
(set! w '()) (for-each (lambda (b) (set-box! b void)) w)
;; high!! the scheduled callback didn't fire (set! w '())
(queue-callback (lambda () (d)) #t)] ;; high!! the scheduled callback didn't fire
[else (queue-callback (lambda () (d)) #t)]
(set! draw# (- draw# 1))])) [else
(when (pstop) (set! draw# (- draw# 1))]))
(when last-picture (when (pstop)
(set! draw last-picture) (when last-picture
(pdraw)) (set! draw last-picture)
(callback-stop! 'name) (pdraw))
(enable-images-button))) (callback-stop! 'name)
changed-world?))))))) (enable-images-button))
changed-world?)))))))
;; tick, tock : deal with a tick event for this world ;; tick, tock : deal with a tick event for this world
(def/pub-cback (ptock) tick) (def/pub-cback (ptock) tick)
@ -314,8 +315,9 @@
(define/public (start!) (define/public (start!)
(queue-callback (queue-callback
(lambda () (lambda ()
(when draw (show-canvas)) (with-handlers ([exn? (handler #t)])
(when register (register-with-host))))) (when draw (show-canvas))
(when register (register-with-host))))))
(define/public (stop! w) (define/public (stop! w)
(set! live #f) (set! live #f)