universe restart test, bug from Marco
(cherry picked from commit 7df831feec
)
This commit is contained in:
parent
37236ea16e
commit
17a48546f8
45
collects/2htdp/tests/universe-restart.rkt
Normal file
45
collects/2htdp/tests/universe-restart.rkt
Normal file
|
@ -0,0 +1,45 @@
|
|||
#lang racket
|
||||
|
||||
(module drop-on-message racket
|
||||
(require 2htdp/universe 2htdp/image)
|
||||
|
||||
(define (u)
|
||||
(universe 0
|
||||
(on-new (lambda (u w) (make-bundle (+ u 1) '() '())))
|
||||
(on-msg (lambda (u w m) (make-bundle (- u 1) '() (list w))))
|
||||
(state #t)))
|
||||
|
||||
(define (w n)
|
||||
(big-bang 3
|
||||
[to-draw (lambda (w) (overlay (text (number->string w) 22 'black) (circle 100 'solid 'red)))]
|
||||
[on-tick (lambda (w) (if (<= w 1) (make-package 0 n) (- w 1)))]
|
||||
[register LOCALHOST]
|
||||
[name n]))
|
||||
|
||||
(launch-many-worlds (u) (w "one") (w "two")))
|
||||
|
||||
(require (submod "." drop-on-message))
|
||||
|
||||
(module drop-bad racket
|
||||
(require 2htdp/universe 2htdp/image)
|
||||
|
||||
(define *world* #false)
|
||||
|
||||
(define (u)
|
||||
(universe '()
|
||||
(on-new (lambda (u w) (make-bundle (cons w u) '() '())))
|
||||
(on-msg (lambda (u w m)
|
||||
;; set *world* to the first world that comes around, reuse
|
||||
(unless *world* (set! *world* w))
|
||||
(make-bundle u '() (list *world*))))))
|
||||
|
||||
(define (w n)
|
||||
(big-bang 3
|
||||
[to-draw (lambda (w) (overlay (text (number->string w) 22 'black) (circle 100 'solid 'red)))]
|
||||
[on-tick (lambda (w) (if (= w 1) (make-package 0 n) (- w 1)))]
|
||||
[register LOCALHOST]
|
||||
[name n]))
|
||||
|
||||
(launch-many-worlds (u) (w "one") (w "two") (w "three")))
|
||||
|
||||
; (require (submod "." drop-bad))
|
Loading…
Reference in New Issue
Block a user