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

fixed end of game bug

Browse Source 
svn: r12934
This commit is contained in:
Robby Findler 2008-12-24 15:58:23 +00:00
parent 6ae922a4bc
commit f5dfb7ed31
1 changed files with 60 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
collects/games/chat-noir/chat-noir.ss
View File

@ -12,7 +12,7 @@
;; data definitions ;; data definitions
;; a world is: ;; a world is:
;; (make-world board posn state number) ;; (make-world board posn state number mouse)
(define-struct world (board cat state size)) (define-struct world (board cat state size))
;; a state is either: ;; a state is either:
@ -51,8 +51,8 @@
; ;
;; world->image : world -> image ;; render-world : world -> image
(define (world->image w) (define (render-world w)
(chop-whiskers (chop-whiskers
(overlay (board->image (world-board w) (overlay (board->image (world-board w)
(world-size w) (world-size w)
@ -66,7 +66,7 @@
(- (cell-center-y (world-cat w))))))) (- (cell-center-y (world-cat w)))))))
(check-expect (check-expect
(world->image (render-world
(make-world (list (make-cell (make-posn 0 1) false)) (make-world (list (make-cell (make-posn 0 1) false))
(make-posn 0 1) (make-posn 0 1)
'playing 'playing
@ -80,7 +80,7 @@
(- (cell-center-y (make-posn 0 1)))))) (- (cell-center-y (make-posn 0 1))))))
(check-expect (check-expect
(world->image (render-world
(make-world (list (make-cell (make-posn 0 1) false)) (make-world (list (make-cell (make-posn 0 1) false))
(make-posn 0 1) (make-posn 0 1)
'cat-won 'cat-won
@ -94,7 +94,7 @@
(- (cell-center-y (make-posn 0 1)))))) (- (cell-center-y (make-posn 0 1))))))
(check-expect (check-expect
(world->image (render-world
(make-world (list (make-cell (make-posn 0 1) false)) (make-world (list (make-cell (make-posn 0 1) false))
(make-posn 0 1) (make-posn 0 1)
'cat-lost 'cat-lost
@ -107,6 +107,34 @@
(- (cell-center-x (make-posn 0 1))) (- (cell-center-x (make-posn 0 1)))
(- (cell-center-y (make-posn 0 1)))))) (- (cell-center-y (make-posn 0 1))))))
(check-expect
(render-world
(make-world (list
(make-cell (make-posn 0 1) true)
(make-cell (make-posn 1 0) true)
(make-cell (make-posn 1 1) false)
(make-cell (make-posn 1 2) true)
(make-cell (make-posn 2 0) true)
(make-cell (make-posn 2 1) true)
(make-cell (make-posn 2 2) true))
(make-posn 1 1)
'cat-lost
3))
(overlay
(board->image (list
(make-cell (make-posn 0 1) true)
(make-cell (make-posn 1 0) true)
(make-cell (make-posn 1 1) false)
(make-cell (make-posn 1 2) true)
(make-cell (make-posn 2 0) true)
(make-cell (make-posn 2 1) true)
(make-cell (make-posn 2 2) true))
3
(lambda (x) false))
(move-pinhole sad-cat
(- (cell-center-x (make-posn 1 1)))
(- (cell-center-y (make-posn 1 1))))))
;; chop-whiskers : image -> image ;; chop-whiskers : image -> image
;; crops the image so that anything above or to the left of the pinhole is gone ;; crops the image so that anything above or to the left of the pinhole is gone
(define (chop-whiskers img) (define (chop-whiskers img)
@ -123,7 +151,7 @@
(check-expect (check-expect
(pinhole-x (pinhole-x
(world->image (render-world
(make-world (make-world
(empty-board 3) (empty-board 3)
(make-posn 0 0) (make-posn 0 0)
@ -132,7 +160,7 @@
0) 0)
(check-expect (check-expect
(pinhole-x (pinhole-x
(world->image (render-world
(make-world (make-world
(empty-board 3) (empty-board 3)
(make-posn 0 1) (make-posn 0 1)
@ -549,7 +577,7 @@
'∞) '∞)
;; on-cats-path? : world -> posn -> boolean ;; p : world -> posn -> boolean
;; returns true when the posn is on the shortest path ;; returns true when the posn is on the shortest path
;; from the cat to the edge of the board, in the given world ;; from the cat to the edge of the board, in the given world
(define (on-cats-path? w) (define (on-cats-path? w)
@ -557,10 +585,14 @@
(define cat-distance-map (build-bfs-table w (world-cat w))) (define cat-distance-map (build-bfs-table w (world-cat w)))
(define cat-distance (lookup-in-table edge-distance-map (define cat-distance (lookup-in-table edge-distance-map
(world-cat w)))] (world-cat w)))]
(lambda (p) (cond
(equal? (+/f (lookup-in-table cat-distance-map p) [(equal? cat-distance '∞)
(lookup-in-table edge-distance-map p)) (lambda (p) false)]
cat-distance)))) [else
(lambda (p)
(equal? (+/f (lookup-in-table cat-distance-map p)
(lookup-in-table edge-distance-map p))
cat-distance))])))
(check-expect ((on-cats-path? (make-world (empty-board 5) (make-posn 1 1) 'playing 5)) (check-expect ((on-cats-path? (make-world (empty-board 5) (make-posn 1 1) 'playing 5))
(make-posn 1 0)) (make-posn 1 0))
@ -568,6 +600,20 @@
(check-expect ((on-cats-path? (make-world (empty-board 5) (make-posn 1 1) 'playing 5)) (check-expect ((on-cats-path? (make-world (empty-board 5) (make-posn 1 1) 'playing 5))
(make-posn 2 1)) (make-posn 2 1))
false) false)
(check-expect ((on-cats-path?
(make-world (list
(make-cell (make-posn 0 1) true)
(make-cell (make-posn 1 0) true)
(make-cell (make-posn 1 1) false)
(make-cell (make-posn 1 2) true)
(make-cell (make-posn 2 0) true)
(make-cell (make-posn 2 1) true)
(make-cell (make-posn 2 2) true))
(make-posn 1 1)
'cat-lost
3))
(make-posn 0 1))
false)
;; neighbors : world (or/c 'boundary posn) -> (listof (or/c 'boundary posn)) ;; neighbors : world (or/c 'boundary posn) -> (listof (or/c 'boundary posn))
;; computes the neighbors of a posn, for a given board size ;; computes the neighbors of a posn, for a given board size
@ -1239,5 +1285,5 @@
(world-height board-size) (world-height board-size)
1 1
initial-world) initial-world)
(on-redraw world->image) (on-redraw render-world)
(on-mouse-event clack)))) (on-mouse-event clack))))