svn: r13640
This commit is contained in:
parent
02efc28dff
commit
f461108f2f
|
@ -29,3 +29,9 @@ Problems:
|
||||||
and it should be built when setup-plt runs on this collection to
|
and it should be built when setup-plt runs on this collection to
|
||||||
build the documentation, ie, this file should eventually be merged
|
build the documentation, ie, this file should eventually be merged
|
||||||
together with ../scribblings/chat-noir.scrbl.
|
together with ../scribblings/chat-noir.scrbl.
|
||||||
|
|
||||||
|
|
||||||
|
- @chunks in the TOC
|
||||||
|
|
||||||
|
- hyperlink bound top-level identifiers to their bindings?
|
||||||
|
|
||||||
|
|
|
@ -7,12 +7,15 @@
|
||||||
|
|
||||||
Chat Noir. What a game.
|
Chat Noir. What a game.
|
||||||
|
|
||||||
|
@schememodname[htdp/world]
|
||||||
|
|
||||||
@chunk[<main>
|
@chunk[<main>
|
||||||
<init-junk>
|
<init-junk>
|
||||||
<data-definitions>
|
<data-definitions>
|
||||||
|
<graph>
|
||||||
<everything-else>]
|
<everything-else>]
|
||||||
|
|
||||||
@section{Data Definitions}
|
@section{The World}
|
||||||
|
|
||||||
The main data structure for Chat Noir is @tt{world}.
|
The main data structure for Chat Noir is @tt{world}.
|
||||||
|
|
||||||
|
@ -23,22 +26,23 @@ The main data structure for Chat Noir is @tt{world}.
|
||||||
|
|
||||||
It consists of a structure with six fields:
|
It consists of a structure with six fields:
|
||||||
@itemize[
|
@itemize[
|
||||||
@item{
|
@item{@tt{board}: representing the state of the board as a list of @tt{cell}s, one for each circle on the game. }
|
||||||
a @scheme[board], which is represented as a list of @tt{cell}s, one for each circle on the game. }
|
@item{@tt{cat}:
|
||||||
@item{
|
a @scheme[posn] indicating the position of the cat (interpreting the @scheme[posn] in the way
|
||||||
a @scheme[posn] for the cat,}
|
that they are interpreted for the @tt{board} field),}
|
||||||
@item{the state of the game (@scheme[state] below), which can be one of
|
@item{@tt{state}: the state of the game, which can be one of
|
||||||
@itemize{
|
@itemize{
|
||||||
@item{@scheme['playing], indicating that the game is still going; this is the initial state.
|
@item{@scheme['playing], indicating that the game is still going; this is the initial state.
|
||||||
}
|
}
|
||||||
@item{@scheme['cat-won], indicating that the game is over and the cat won, or}
|
@item{@scheme['cat-won], indicating that the game is over and the cat won, or}
|
||||||
@item{@scheme['cat-lost], indicating that the game is over and the cat lost.}}
|
@item{@scheme['cat-lost], indicating that the game is over and the cat lost.}}
|
||||||
}
|
}
|
||||||
@item{
|
@item{@tt{size}: an odd natural number indicating the size of the board}
|
||||||
|
@item{@tt{mouse-posn}:
|
||||||
a @scheme[posn] for the location of the mouse (or @scheme[#f] if the
|
a @scheme[posn] for the location of the mouse (or @scheme[#f] if the
|
||||||
mouse is not in the window),}
|
mouse is not in the window), and}
|
||||||
@item{and a boolean indicating if the @tt{h}
|
@item{@tt{h-down?}: a boolean indicating if the @tt{h}
|
||||||
key has been pushed down.}
|
key is being pushed down.}
|
||||||
]
|
]
|
||||||
|
|
||||||
A @tt{cell} is a structure with two fields:
|
A @tt{cell} is a structure with two fields:
|
||||||
|
@ -47,110 +51,44 @@ A @tt{cell} is a structure with two fields:
|
||||||
(define-struct cell (p blocked?) #:transparent)]
|
(define-struct cell (p blocked?) #:transparent)]
|
||||||
|
|
||||||
The first field contains a @scheme[posn] struct.
|
The first field contains a @scheme[posn] struct.
|
||||||
|
The coordinates of the posn indicate a position on the
|
||||||
|
hexagonal grid.
|
||||||
|
The @tt{y} field of the @scheme[posn]
|
||||||
|
refers to the row of the cell, and the
|
||||||
|
@tt{x} coordinate the position in the row.
|
||||||
|
This means that, for example,
|
||||||
|
@scheme[(make-posn 0 1)]
|
||||||
|
is centered above
|
||||||
|
@scheme[(make-posn 1 0)] and
|
||||||
|
@scheme[(make-posn 1 1)]. See @scheme[cell-center-x]
|
||||||
|
and @scheme[cell-center-y] below for the conversion
|
||||||
|
of those positions to screen coordinates.
|
||||||
|
|
||||||
@verbatim{
|
The @tt{blocked?} field is a boolean indicating if
|
||||||
;; a cell is
|
the cell has been clicked on, thus blocking the cat
|
||||||
;; (make-cell (make-posn int[0-board-size]
|
from stepping there.
|
||||||
;; int[0-board-size])
|
|
||||||
;; boolean)
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
|
@section{Graph}
|
||||||
|
|
||||||
@section{Init Junk}
|
The cat's move decision is based on a breadth-first
|
||||||
|
search of a graph. The graph's nodes are the cells
|
||||||
|
on the board, and there are edges between each pair
|
||||||
|
of adjacent cells, unless one of the cells is blocked,
|
||||||
|
in which case there are no edges.
|
||||||
|
|
||||||
@chunk[<init-junk>
|
The breadth-first function constructs a @scheme[distance-map],
|
||||||
|
which is a list of @scheme[dist-cell] structs:
|
||||||
|
|
||||||
(require htdp/world lang/posn)
|
@chunk[<graph>
|
||||||
(define-syntax (check-expect stx)
|
(define-struct dist-cell (p n) #:transparent)]
|
||||||
(syntax-case stx ()
|
|
||||||
[(_ actual expected)
|
|
||||||
(with-syntax ([line (syntax-line stx)])
|
|
||||||
#'(check-expect/proc (λ () actual)
|
|
||||||
(λ () expected)
|
|
||||||
line))]))
|
|
||||||
|
|
||||||
(define check-expect-count 0)
|
Each @tt{p} field in the @scheme[dist-cell] is
|
||||||
(define check-expects '())
|
|
||||||
|
|
||||||
(define (check-expect/proc actual-thunk expected-thunk line)
|
The core of the breadth-first search is this function,
|
||||||
(set! check-expects
|
@scheme[bst]. It accepts a @scheme[queue] and a
|
||||||
(cons
|
|
||||||
(λ ()
|
|
||||||
(set! check-expect-count (+ check-expect-count 1))
|
|
||||||
(let ([actual (actual-thunk)]
|
|
||||||
[expected (expected-thunk)])
|
|
||||||
(unless (equal? actual expected)
|
|
||||||
(error 'check-expect "test ~a on line ~a failed:\n ~s\n ~s\n"
|
|
||||||
check-expect-count
|
|
||||||
line
|
|
||||||
actual
|
|
||||||
expected))))
|
|
||||||
check-expects)))
|
|
||||||
|
|
||||||
(define (run-check-expects)
|
@chunk[<bfs>
|
||||||
(for-each (λ (t) (t))
|
|
||||||
(reverse check-expects)))
|
|
||||||
|
|
||||||
(define (make-immutable-hash/list-init [init '()])
|
|
||||||
(make-immutable-hash
|
|
||||||
(map (λ (x) (cons (car x) (cadr x)))
|
|
||||||
init)))]
|
|
||||||
|
|
||||||
@section{Everything Else}
|
|
||||||
|
|
||||||
|
|
||||||
@chunk[<everything-else>
|
|
||||||
|
|
||||||
#;'()
|
|
||||||
|
|
||||||
|
|
||||||
;; constants
|
|
||||||
(define circle-radius 20)
|
|
||||||
(define circle-spacing 22)
|
|
||||||
|
|
||||||
(define normal-color 'lightskyblue)
|
|
||||||
(define on-shortest-path-color 'white)
|
|
||||||
(define blocked-color 'black)
|
|
||||||
(define under-mouse-color 'black)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;
|
|
||||||
;
|
|
||||||
;
|
|
||||||
;
|
|
||||||
;
|
|
||||||
; ;;;;;
|
|
||||||
; ;;;;
|
|
||||||
; ;;;
|
|
||||||
; ;;;; ;;; ; ;;;; ;;;; ;; ; ;;;; ;;; ;
|
|
||||||
; ;;;;;;; ;;;;;; ;;;; ;;;;;;;;; ;;;;;;;;; ;;; ;;;
|
|
||||||
; ; ;;;; ;;; ;;;;;;;;;;;;;;; ;; ;; ;;; ;;;;
|
|
||||||
; ;; ;;; ;;; ;;;; ;;; ;;; ; ;; ;;;; ;;;
|
|
||||||
; ;;;;;;; ;;; ;; ;;;; ; ;;; ;;; ;;;
|
|
||||||
; ;;; ;;; ;;;;;;;;;; ;;;;;;; ;; ;;;
|
|
||||||
; ;;;; ;;;;;;;;;;; ;;;;;;;;;;; ;; ;;; ;; ;;;
|
|
||||||
; ;;;;; ;;; ;;;;; ;; ;;;; ;;;
|
|
||||||
; ;;;; ;;; ;; ;;
|
|
||||||
; ;;;;;; ;
|
|
||||||
;
|
|
||||||
|
|
||||||
;; a distance-map is
|
|
||||||
;; (listof dist-cells)
|
|
||||||
|
|
||||||
;; a dist-cell is
|
|
||||||
;; - (make-dist-cell posn (number or '∞))
|
|
||||||
(define-struct dist-cell (p n) #:transparent)
|
|
||||||
|
|
||||||
|
|
||||||
;; build-bfs-table : world (or/c 'boundary posn) -> distance-table
|
|
||||||
(define (build-bfs-table world init-point)
|
|
||||||
(local [;; posn : posn
|
|
||||||
;; dist : number
|
|
||||||
(define-struct queue-ent (posn dist) #:transparent)
|
|
||||||
|
|
||||||
(define neighbors/w (neighbors world))
|
|
||||||
|
|
||||||
(define (bfs queue dist-table)
|
(define (bfs queue dist-table)
|
||||||
(cond
|
(cond
|
||||||
|
@ -169,6 +107,26 @@ The first field contains a @scheme[posn] struct.
|
||||||
[else
|
[else
|
||||||
(bfs (rest queue) dist-table)]))]))]
|
(bfs (rest queue) dist-table)]))]))]
|
||||||
|
|
||||||
|
@chunk[<graph>
|
||||||
|
|
||||||
|
;; a distance-map is
|
||||||
|
;; (listof dist-cells)
|
||||||
|
|
||||||
|
;; a dist-cell is
|
||||||
|
;; - (make-dist-cell posn (number or '∞))
|
||||||
|
(define-struct dist-cell (p n) #:transparent)
|
||||||
|
|
||||||
|
|
||||||
|
;; build-bfs-table : world (or/c 'boundary posn) -> distance-table
|
||||||
|
(define (build-bfs-table world init-point)
|
||||||
|
(local [;; posn : posn
|
||||||
|
;; dist : number
|
||||||
|
(define-struct queue-ent (posn dist) #:transparent)
|
||||||
|
|
||||||
|
(define neighbors/w (neighbors world))
|
||||||
|
|
||||||
|
<bfs>]
|
||||||
|
|
||||||
(hash-map
|
(hash-map
|
||||||
(bfs (list (make-queue-ent init-point 0))
|
(bfs (list (make-queue-ent init-point 0))
|
||||||
(make-immutable-hash/list-init))
|
(make-immutable-hash/list-init))
|
||||||
|
@ -619,10 +577,67 @@ The first field contains a @scheme[posn] struct.
|
||||||
(check-expect (+/f '∞ '∞) '∞)
|
(check-expect (+/f '∞ '∞) '∞)
|
||||||
(check-expect (+/f '∞ 1) '∞)
|
(check-expect (+/f '∞ 1) '∞)
|
||||||
(check-expect (+/f 1 '∞) '∞)
|
(check-expect (+/f 1 '∞) '∞)
|
||||||
(check-expect (+/f 1 2) 3)
|
(check-expect (+/f 1 2) 3)]
|
||||||
|
|
||||||
|
@section{Init Junk}
|
||||||
|
|
||||||
|
@chunk[<init-junk>
|
||||||
|
|
||||||
|
(require htdp/world lang/posn)
|
||||||
|
(define-syntax (check-expect stx)
|
||||||
|
(syntax-case stx ()
|
||||||
|
[(_ actual expected)
|
||||||
|
(with-syntax ([line (syntax-line stx)])
|
||||||
|
#'(check-expect/proc (λ () actual)
|
||||||
|
(λ () expected)
|
||||||
|
line))]))
|
||||||
|
|
||||||
|
(define check-expect-count 0)
|
||||||
|
(define check-expects '())
|
||||||
|
|
||||||
|
(define (check-expect/proc actual-thunk expected-thunk line)
|
||||||
|
(set! check-expects
|
||||||
|
(cons
|
||||||
|
(λ ()
|
||||||
|
(set! check-expect-count (+ check-expect-count 1))
|
||||||
|
(let ([actual (actual-thunk)]
|
||||||
|
[expected (expected-thunk)])
|
||||||
|
(unless (equal? actual expected)
|
||||||
|
(error 'check-expect "test ~a on line ~a failed:\n ~s\n ~s\n"
|
||||||
|
check-expect-count
|
||||||
|
line
|
||||||
|
actual
|
||||||
|
expected))))
|
||||||
|
check-expects)))
|
||||||
|
|
||||||
|
(define (run-check-expects)
|
||||||
|
(for-each (λ (t) (t))
|
||||||
|
(reverse check-expects)))
|
||||||
|
|
||||||
|
(define (make-immutable-hash/list-init [init '()])
|
||||||
|
(make-immutable-hash
|
||||||
|
(map (λ (x) (cons (car x) (cadr x)))
|
||||||
|
init)))]
|
||||||
|
|
||||||
|
|
||||||
|
@section{Everything Else}
|
||||||
|
|
||||||
|
|
||||||
|
@chunk[<everything-else>
|
||||||
|
|
||||||
|
#;'()
|
||||||
|
|
||||||
|
|
||||||
|
;; constants
|
||||||
|
(define circle-radius 20)
|
||||||
|
(define circle-spacing 22)
|
||||||
|
|
||||||
|
(define normal-color 'lightskyblue)
|
||||||
|
(define on-shortest-path-color 'white)
|
||||||
|
(define blocked-color 'black)
|
||||||
|
(define under-mouse-color 'black)
|
||||||
|
|
||||||
|
|
||||||
;
|
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
|
|
Loading…
Reference in New Issue
Block a user