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

refactored so that the chat-noir tests run in drdr

Browse Source 
svn: r18770
This commit is contained in:
Robby Findler 2010-04-09 19:19:14 +00:00
parent 1621091fc1
commit dcaa17e860
2 changed files with 68 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
collects/games/chat-noir/chat-noir-literate.ss
View File

@ -2332,7 +2332,7 @@ and reports the results.
This section contains expressions that start This section contains expressions that start
the Chat Noir game going. the Chat Noir game going.
First, a function to compute state of the world at the start of a game is defined. First, here is a function to compute state of the world at the start of a game.
@chunk[<initial-world> @chunk[<initial-world>
(define board-size 11) (define board-size 11)
@ -2343,21 +2343,24 @@ First, a function to compute state of the world at the start of a game is define
(empty-board board-size) (empty-board board-size)
board-size)) board-size))
(make-world initial-board (make-world initial-board
(make-posn (quotient board-size 2) (make-posn (quotient board-size 2)
(quotient board-size 2)) (quotient board-size 2))
'playing 'playing
board-size board-size
#f #f
#f))] #f))]
Next, the game starts by calling @scheme[big-bang] with the appropriate arguments. Finally, we can define and provide a function to start the game
by calling @scheme[big-bang] with the appropriate arguments.
@chunk[<go> @chunk[<go>
(void (provide main)
(big-bang (make-initial-world) (define (main)
(on-draw render-world (void
(world-width board-size) (big-bang (make-initial-world)
(world-height board-size)) (on-draw render-world
(on-key change) (world-width board-size)
(on-mouse clack) (world-height board-size))
(name "Chat Noir")))] (on-key change)
(on-mouse clack)
(name "Chat Noir"))))]

70
collects/games/chat-noir/chat-noir-unit.ss
View File

@ -15,31 +15,59 @@
(define-unit game@ (define-unit game@
(import) (import)
(export) (export)
(define ns (make-base-namespace))
(define sub-custodian (make-custodian))
(define main-custodian (current-custodian))
(define (find-windows)
(let loop ([cust sub-custodian])
(let o-loop ([objs (custodian-managed-list cust main-custodian)])
(cond
[(null? objs) null]
[else
(let ([obj (car objs)])
(cond
[(custodian? obj)
(append (loop obj)
(o-loop (cdr objs)))]
[(eventspace? obj)
(append (parameterize ([current-eventspace obj])
(get-top-level-windows))
(o-loop (cdr objs)))]
[else
(o-loop (cdr objs))]))]))))
;; a hack. ;; a hack.
;; this adds a help button to the world.ss window ;; this adds a help button to the world.ss window
(thread (thread
(λ () (λ ()
(let loop ([n 0]) (let loop ([n 0])
(when (n . < . 100) (cond
(sleep 1/10) [(n . < . 100)
(let ([fs (get-top-level-windows)]) (sleep 1/10)
(cond (let ([fs (find-windows)])
[(null? fs) (cond
(loop (+ n 1))] [(null? fs)
[else (loop (+ n 1))]
(let ([f (car fs)] [else
[show-help (let ([f (car fs)]
(show-scribbling [show-help
'(lib "games/scribblings/games.scrbl") (show-scribbling
"chat-noir")]) '(lib "games/scribblings/games.scrbl")
(new button% "chat-noir")])
[parent f] (new button%
[callback (λ (x y) (show-help))] [parent f]
[label (string-constant help)]))])))))) [callback (λ (x y) (show-help))]
[label (string-constant help)]))]))]
[else
(fprintf (current-error-port) "never found a window\n")]))))
(parameterize ([current-namespace ns])
(namespace-attach-module orig-namespace '(lib "mred.ss" "mred")) ;; start up the game
(namespace-attach-module orig-namespace '(lib "class.ss" "scheme"))
(dynamic-require chat-noir #f))) (parameterize ([current-custodian sub-custodian])
(parameterize ([current-namespace (make-base-namespace)])
(namespace-attach-module orig-namespace '(lib "mred.ss" "mred"))
(namespace-attach-module orig-namespace '(lib "class.ss" "scheme"))
((dynamic-require chat-noir 'main)))))