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

10393 fixed

Browse Source 
svn: r16673
This commit is contained in:
Matthias Felleisen 2009-11-10 22:06:29 +00:00
parent 2683cecd17
commit b2d51ab278
2 changed files with 15 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -213,7 +213,7 @@
(define/public (name arg ...)
(queue-callback
(lambda ()
(with-handlers ([exn:break? (handler #f)][exn? (handler #t)])
(with-handlers ([exn? (handler #t)])
(define tag (format "~a callback" 'transform))
(define nw (transform (send world get) arg ...))
(when (package? nw)
@ -266,6 +266,7 @@
(define (handler re-raise)
(lambda (e)
(printf "breaking ..\n")
(disable-images-button)
(stop! (if re-raise e (send world get)))))

20
collects/2htdp/universe.ss
View File

@ -41,8 +41,8 @@
[(_ x rate)
#'(list (proc> 'on-tick (f2h x) 1)
(num> 'on-tick rate (lambda (x)
(and (real? x) (positive? x)))
"pos. number" "rate"))])]
(and (real? x) (positive? x)))
"pos. number" "rate"))])]
;; -- state specifies whether to display the current state
[state (expr-with-check bool> "expected a boolean (show state or not)")]
;; -- check-with must specify a predicate
@ -169,9 +169,12 @@
[_ (err '#'record? stx)])))]
[args
(->args stx (syntax (clause ...)) AllSpec WldSpec ->rec? "world")])
#`(parameterize ([current-eventspace (make-eventspace)])
(let ([o (new (if #,rec? aworld% world%) [world0 w] #,@args)])
(send o last))))]))
#`(let* ([esp (make-eventspace)]
[thd (eventspace-handler-thread esp)])
(with-handlers ((exn:break? (lambda (x) (break-thread thd))))
(parameterize ([current-eventspace esp])
(let ([o (new (if #,rec? aworld% world%) [world0 w] #,@args)])
(send o last))))))]))
(define (run-simulation f)
(check-proc 'run-simulation f 1 "first" "one argument")
@ -267,6 +270,9 @@
[(not (memq 'on-msg domain))
(raise-syntax-error #f "missing on-msg clause" stx)]
[else ; (and (memq #'on-new domain) (memq #'on-msg domain))
#`(parameterize ([current-eventspace (make-eventspace)])
(send (new universe% [universe0 u] #,@args) last))]))]))
#`(let* ([esp (make-eventspace)]
[thd (eventspace-handler-thread esp)])
(with-handlers ((exn:break? (lambda (x) (break-thread thd))))
(parameterize ([current-eventspace esp])
(send (new universe% [universe0 u] #,@args) last))))]))]))