the cat now always has to fight against 6 randomly filled in dots instead of having all dots having a 1/30 chance of being filled in

svn: r12236
This commit is contained in:
Robby Findler 2008-11-04 21:10:17 +00:00
parent 4b10a33b85
commit a6743b3089

View File

@ -621,20 +621,14 @@ making some of the test cases much easier to manage.
(define (clack world x y evt) (define (clack world x y evt)
(cond (cond
[(equal? evt 'button-up) [(and (equal? evt 'button-up)
(cond (equal? 'playing (world-state world))
[(equal? 'playing (world-state world)) (point-in-circle? (world-board world) x y))
(cond
[(point-in-circle? (world-board world) x y)
(move-cat (move-cat
(make-world (add-obstacle (world-board world) x y) (make-world (add-obstacle (world-board world) x y)
(world-cat world) (world-cat world)
(world-state world) (world-state world)
(world-size world)))] (world-size world)))]
[else
world])]
[else
world])]
[else [else
world])) world]))
@ -643,6 +637,13 @@ making some of the test cases much easier to manage.
10 10
'button-down) 'button-down)
(make-world '() (make-posn 0 0) 'playing 1)) (make-world '() (make-posn 0 0) 'playing 1))
(check-expect (clack (make-world '() (make-posn 0 0) 'playing 1)
0
0
'button-up)
(make-world '() (make-posn 0 0) 'playing 1))
(check-expect (clack (make-world '() (make-posn 0 0) 'cat-lost 1) (check-expect (clack (make-world '() (make-posn 0 0) 'cat-lost 1)
10 10
10 10
@ -650,7 +651,7 @@ making some of the test cases much easier to manage.
(make-world '() (make-posn 0 0) 'cat-lost 1)) (make-world '() (make-posn 0 0) 'cat-lost 1))
(check-expect (clack (check-expect (clack
(make-world (make-world
(list (make-cell (make-posn 1 0) true) (list (make-cell (make-posn 1 0) false)
(make-cell (make-posn 2 0) true) (make-cell (make-posn 2 0) true)
(make-cell (make-posn 0 1) true) (make-cell (make-posn 0 1) true)
(make-cell (make-posn 1 1) false) (make-cell (make-posn 1 1) false)
@ -660,7 +661,9 @@ making some of the test cases much easier to manage.
(make-posn 1 1) (make-posn 1 1)
'playing 'playing
3) 3)
10 10 'button-up) (cell-center-x (make-posn 1 0))
(cell-center-y (make-posn 1 0))
'button-up)
(make-world (make-world
(list (make-cell (make-posn 1 0) true) (list (make-cell (make-posn 1 0) true)
(make-cell (make-posn 2 0) true) (make-cell (make-posn 2 0) true)
@ -789,6 +792,11 @@ making some of the test cases much easier to manage.
(list (make-posn 2 2)) (list (make-posn 2 2))
(list 2)) (list 2))
(make-posn 1 1)) (make-posn 1 1))
(check-expect (find-best-position (make-posn 1 1)
'
(list)
(list))
false)
(check-expect (find-best-position (make-posn 2 2) (check-expect (find-best-position (make-posn 2 2)
2 2
(list) (list)
@ -995,10 +1003,40 @@ making some of the test cases much easier to manage.
(check-expect (append-all (list (list 1) (list 2) (list 3))) (check-expect (append-all (list (list 1) (list 2) (list 3)))
(list 1 2 3)) (list 1 2 3))
;; add-n-random-blocked-cells : number (listof cell) number -> (listof cell)
(define (add-n-random-blocked-cells n all-cells board-size)
(cond
[(zero? n) all-cells]
[else
(local [(define unblocked-cells
(filter (lambda (x)
(let ([cat-cell? (and (= (posn-x (cell-p x)) (quotient board-size 2))
(= (posn-y (cell-p x)) (quotient board-size 2)))])
(and (not (cell-blocked? x))
(not cat-cell?))))
all-cells))
(define to-block (list-ref unblocked-cells
(random (length unblocked-cells))))]
(add-n-random-blocked-cells
(sub1 n)
(map (lambda (c) (if (equal? to-block c)
(make-cell (cell-p c) true)
c))
all-cells)
board-size))]))
(check-expect (add-n-random-blocked-cells 0 (list (make-cell (make-posn 0 0) true)) 10)
(list (make-cell (make-posn 0 0) true)))
(check-expect (add-n-random-blocked-cells 1 (list (make-cell (make-posn 0 0) false)) 10)
(list (make-cell (make-posn 0 0) true)))
(define dummy (define dummy
(local (local
[(define board-size 11) [(define board-size 11)
(define initial-board (define initial-board
(add-n-random-blocked-cells
6
(filter (filter
(lambda (c) (lambda (c)
(not (and (= 0 (posn-x (cell-p c))) (not (and (= 0 (posn-x (cell-p c)))
@ -1012,11 +1050,9 @@ making some of the test cases much easier to manage.
(build-list (build-list
board-size board-size
(lambda (j) (lambda (j)
(let ([cat-cell? (and (= i (quotient board-size 2))
(= j (quotient board-size 2)))])
(make-cell (make-posn i j) (make-cell (make-posn i j)
(and (not cat-cell?) false)))))))
(zero? (random 30)))))))))))) board-size))
(define initial-world (define initial-world
(make-world initial-board (make-world initial-board
(make-posn (quotient board-size 2) (make-posn (quotient board-size 2)