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

cleaned up chat noir

Browse Source 
svn: r11947
This commit is contained in:
Robby Findler 2008-10-06 02:32:37 +00:00
parent a01a8a962f
commit d2d85b39b3
3 changed files with 125 additions and 122 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -4,18 +4,15 @@
(prefix-in x: lang/htdp-intermediate-lambda)
(prefix-in x: htdp/world))
(provide game@)
(define orig-namespace (current-namespace))
(define-runtime-path chat-noir "chat-noir.ss")
(define-runtime-path chat-noir "chat-noir-module.ss")
(define-unit game@
(import)
(export)
(define ns (make-base-namespace))
(parameterize ([current-namespace ns])
(namespace-attach-module orig-namespace
'(lib "htdp-intermediate-lambda.ss" "lang"))
(namespace-attach-module orig-namespace
'(lib "world.ss" "htdp"))
(namespace-attach-module orig-namespace '(lib "mred.ss" "mred"))
(namespace-attach-module orig-namespace '(lib "class.ss" "scheme"))
(dynamic-require chat-noir #f)))

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

@ -4,8 +4,6 @@ Hint: include the size of the board in your world structure
This enables you to make test cases with different size boards,
making some of the test cases much easier to manage.
figure out why there is an extra board (sometimes)
|#
(define circle-radius 20)
@ -195,28 +193,6 @@ figure out why there is an extra board (sometimes)
(check-expect (world-height 3) 116.208)
;
;
;
;
;
; ;;;;;;;;;;
; ;;; ;;;
; ;;; ;;;
; ;;;;;; ;;;;; ;;; ;;; ; ;;;; ;;;;; ;;;;;;
; ;;; ;;;;;;; ;;; ;;; ;;; ;;;;;;;;; ;;;;;;; ;;; ;;;
; ;;; ;;;;;;;; ;;; ;;; ;;; ;; ;; ;;;;;;;; ;;;
; ;;; ;;;;;;;;;;;; ;;; ;;; ; ;; ;; ; ;;;;;;;;;
; ;;; ;;; ;; ;; ; ;;; ; ;; ;;;;
; ;;; ; ;;; ;;; ;;; ;;; ;;;;;;; ;;;;;;;; ;;;;; ;;;
; ;;; ; ;; ;;; ;;;; ;;;; ;; ;;; ;;;;;; ;;;; ;;
; ;;;; ;;;; ;; ;;;; ;;;;;;
; ;;
; ;
;
;; cell-center : cell -> number
(define (cell-center-x p)
(local [(define x (posn-x p))
@ -446,6 +422,24 @@ figure out why there is an extra board (sometimes)
(make-dist-cell (make-posn 4 4) 0)
(make-dist-cell (make-posn 3 3) 1)))
;; lookup-board : board posn -> cell-or-false
(define (lookup-board board p)
(cond
[(empty? board) (error 'lookup-board "did not find posn")]
[else
(cond
[(equal? (cell-p (first board)) p)
(first board)]
[else
(lookup-board (rest board) p)])]))
(check-expect (lookup-board (list (make-cell (make-posn 2 2) false))
(make-posn 2 2))
(make-cell (make-posn 2 2) false))
(check-error (lookup-board '() (make-posn 0 0))
"lookup-board: did not find posn")
;; add-to-table : posn number table -> table
(define (add-to-table p n t)
(cond
@ -839,20 +833,27 @@ figure out why there is an extra board (sometimes)
(list (make-cell (make-posn 0 0) true)
(make-cell (make-posn 0 1) false)))
;
;
; ;;
; ;;
; ;;;; ;;;; ;;;;;
; ;; ; ;; ;;
; ;; ;; ;;
; ;; ;;;;; ;;
; ;; ;; ;; ;;
; ;;; ; ;; ;; ;;
; ;;; ;;;;;; ;;;
;
;
;
;
;
;
;
;
; ;;;;
; ;;;
; ;;; ;
; ;;;;;; ;;;; ;;;;;;;;;;;
; ;;; ;;;; ;;;;;;;;; ;;; ;;
; ;;; ;;;;;;;;;;;;;;; ;;;
; ;;; ;;;;;;; ;;; ;;; ;;;;
; ;;; ;; ;;;; ;;; ;;;;;
; ;;; ; ;;;;;;;;;; ;;; ;;;;
; ;;; ; ;;;;;;;;;;; ;;; ;;
; ;;;; ;;;;; ;;;;;
;
;
;
;; cat : symbol -> image
(define (cat mode)
@ -918,37 +919,45 @@ figure out why there is an extra board (sometimes)
(define sad-cat (cat 'sad))
(define thinking-cat (cat 'thinking))
;
; ;;; ;;;
; ;; ;;
; ;; ;;
; ;;;;; ;;;; ;;;; ;;; ;; ;;;;;
; ;; ;; ;; ;; ;; ;;;;; ;; ;;
; ;; ;; ;; ;; ;; ;; ;; ;;
; ;; ;; ;; ;; ;;;;; ;; ;; ;;
; ;; ;; ;; ;; ;; ;; ;; ;; ;;
; ;; ;; ;; ;; ;; ;; ;; ;; ;;
; ;;;;; ;;;; ;;;;;; ;;;; ;;;;;;
;
;
;
;; lookup-board : board posn -> cell-or-false
(define (lookup-board board p)
(cond
[(empty? board) (error 'lookup-board "did not find posn")]
[else
(cond
[(equal? (cell-p (first board)) p)
(first board)]
[else
(lookup-board (rest board) p)])]))
(check-expect (lookup-board (list (make-cell (make-posn 2 2) false))
(make-posn 2 2))
(make-cell (make-posn 2 2) false))
(check-error (lookup-board '() (make-posn 0 0))
"lookup-board: did not find posn")
;
;
;
;
;
; ;;;; ;;;; ;;;; ;;;; ;;;;;
; ;;;;; ;;;;; ;;; ;;;;; ;;;
; ;;; ; ;;;
; ;;;;;; ;; ; ;;;;;;;;; ; ;;;; ;; ;;;
; ;;;;; ;;; ;;;; ;;;;; ;;; ;;;;;;; ;;;;;;;;; ;;;
; ;;; ;;; ;;;; ;;; ;;; ;;; ;;;;;;;;;; ;;;
; ;;; ;;;; ;;; ;;; ;;; ;;;; ;;; ;;; ;;; ;;;
; ;;; ;;; ;;; ;;; ;;; ;;;;; ;;; ;; ;;;; ;;
; ;;;; ;;; ;;; ;;;; ;;; ;;;; ;;;; ;;;;;;;;;; ;;;
; ;;;;;;;;;; ;;; ;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;
; ;;;; ;;;;; ;;;;;
; ;;;
;
;
;
;
;
;
;
; ;;;;; ;;
; ;;;; ;;;;
; ;;; ;;;
; ;;; ;;; ;;;;; ;;;; ;; ; ;;;; ;;; ;;;
; ;;;;;;;; ;;;;;;; ;;;;;;;;;;;;;;; ;;;; ;;;;;;;;
; ;;;;;;;; ;;;;;;;; ;;;;;;;;;; ;;; ;;;;;;;;;;;;;;
; ;;; ;; ;; ; ;;; ;;; ;;; ;;;; ;;; ;;;
; ;;; ;; ; ;; ;; ;;;; ;;; ;; ;;;;
; ;;;;;;; ;;;;;;;; ;;;;;;;;;; ;;; ;;;;;;;;
; ;;;;;;; ;;;;;; ;;;;;;;;;;;;;;;;;; ;;;;;;;;;
; ;;;; ;;;;;
;
;
;
;; append-all : (listof (list X)) -> (listof X)
(define (append-all ls)
@ -963,16 +972,12 @@ figure out why there is an extra board (sometimes)
(local
[(define board-size 11)
(define initial-board
(foldl
(lambda (c l)
(cond
[(and (= 0 (posn-x (cell-p c)))
(or (= 0 (posn-y (cell-p c)))
(= (- board-size 1)
(posn-y (cell-p c)))))
l]
[else (cons c l)]))
'()
(filter
(lambda (c)
(not (and (= 0 (posn-x (cell-p c)))
(or (= 0 (posn-y (cell-p c)))
(= (- board-size 1)
(posn-y (cell-p c)))))))
(append-all
(build-list
board-size
@ -994,6 +999,7 @@ figure out why there is an extra board (sometimes)
(and
;; illustrates the speedup for state-based dfs
;((lambda (x) true) (time (build-table initial-world)))
;((lambda (x) true) (time (build-table/fast initial-world)))

76
collects/games/scribblings/chat-noir.scrbl
View File

@ -5,13 +5,6 @@
@gametitle["Chat Noir" "chat-noir" "Puzzle Game"]
This game is written in the
@link["http://www.htdp.org/"]{How to Design Programs}
Intermediate language. It is a model solution to the final project for
the introductory programming course at the University of Chicago in
the fall of 2008. See the source code:
@schemeblock[#,(tt (path->string (simplify-path cn)))]
The goal of the game is to stop the cat from escaping the board. Each
turn you click on a circle, which prevents the cat from stepping on
that space, and the cat responds by taking a step. If the cat is
@ -19,41 +12,48 @@ completely boxed in and thus unable reach the border, you win. If the
cat does reach the border, you lose.
The game was inspired by this one the one at
@link["http://www.gamedesign.jp/flash/chatnoir/chatnoir.html"]{Game
Design} and has essentailly the same rules.
@link["http://www.gamedesign.jp/flash/chatnoir/chatnoir.html"]{Game Design}
and has essentailly the same rules.
This game is written in the
@link["http://www.htdp.org/"]{How to Design Programs}
Intermediate language. It is a model solution to the final project for
the introductory programming course at the University of Chicago in
the fall of 2008, as below.
@(define-syntax (m stx)
(syntax-case stx ()
[(_)
(call-with-input-file (build-path (current-load-relative-directory)
'up
"chat-noir"
"chat-noir.ss")
(lambda (port)
(port-count-lines! port)
#`(schemeblock
#,@
(let loop ()
(let ([p (peeking-input-port port)])
(let ([l (read-line p)])
(cond
[(eof-object? l) '()]
[(regexp-match #rx"^[ \t]*$" l)
(read-line port)
(loop)]
[(regexp-match #rx"^ *;+" l)
=>
(lambda (m)
(let-values ([(line col pos) (port-next-location port)])
(read-line port)
(let-values ([(line2 col2 pos2) (port-next-location port)])
(cons (datum->syntax
#f
`(code:comment ,(regexp-replace* #rx" " l "\u00a0")))
(list "chat-noir.ss" line col pos (- pos2 pos)))
(loop))))]
[else
(cons (read-syntax "chat-noir.ss" port)
(loop))])))))))]))
'up
"chat-noir"
"chat-noir.ss")
(lambda (port)
(port-count-lines! port)
#`(schemeblock
#,@
(let loop ()
(let* ([p (peeking-input-port port)]
[l (read-line p)])
(cond
[(eof-object? l) '()]
[(regexp-match #rx"^[ \t]*$" l)
(read-line port)
(loop)]
[(regexp-match #rx"^ *;+" l)
=>
(lambda (m)
(let-values ([(line col pos) (port-next-location port)])
(read-line port)
(let-values ([(line2 col2 pos2) (port-next-location port)])
(cons (datum->syntax
#f
`(code:comment ,(regexp-replace* #rx" " l "\u00a0"))
(list "chat-noir.ss" line col pos (- pos2 pos)))
(loop)))))]
[else
(cons (read-syntax "chat-noir.ss" port)
(loop))])))))
#:mode 'text)]))
@m[]