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
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>
(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)
board-size))
(make-world initial-board
(make-posn (quotient board-size 2)
(quotient board-size 2))
'playing
board-size
#f
#f))]
(make-posn (quotient board-size 2)
(quotient board-size 2))
'playing
board-size
#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>
(void
(big-bang (make-initial-world)
(on-draw render-world
(world-width board-size)
(world-height board-size))
(on-key change)
(on-mouse clack)
(name "Chat Noir")))]
(provide main)
(define (main)
(void
(big-bang (make-initial-world)
(on-draw render-world
(world-width board-size)
(world-height board-size))
(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@
(import)
(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.
;; this adds a help button to the world.ss window
(thread
(λ ()
(let loop ([n 0])
(when (n . < . 100)
(sleep 1/10)
(let ([fs (get-top-level-windows)])
(cond
[(null? fs)
(loop (+ n 1))]
[else
(let ([f (car fs)]
[show-help
(show-scribbling
'(lib "games/scribblings/games.scrbl")
"chat-noir")])
(new button%
[parent f]
[callback (λ (x y) (show-help))]
[label (string-constant help)]))]))))))
(cond
[(n . < . 100)
(sleep 1/10)
(let ([fs (find-windows)])
(cond
[(null? fs)
(loop (+ n 1))]
[else
(let ([f (car fs)]
[show-help
(show-scribbling
'(lib "games/scribblings/games.scrbl")
"chat-noir")])
(new button%
[parent f]
[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"))
(namespace-attach-module orig-namespace '(lib "class.ss" "scheme"))
(dynamic-require chat-noir #f)))
;; start up the game
(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)))))