diff --git a/collects/games/chat-noir/chat-noir-unit.ss b/collects/games/chat-noir/chat-noir-unit.ss index 0e0accc536..5b16026954 100644 --- a/collects/games/chat-noir/chat-noir-unit.ss +++ b/collects/games/chat-noir/chat-noir-unit.ss @@ -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))) diff --git a/collects/games/chat-noir/chat-noir.ss b/collects/games/chat-noir/chat-noir.ss index 38fda78eba..9f40276a1d 100644 --- a/collects/games/chat-noir/chat-noir.ss +++ b/collects/games/chat-noir/chat-noir.ss @@ -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))) diff --git a/collects/games/scribblings/chat-noir.scrbl b/collects/games/scribblings/chat-noir.scrbl index efb9404b40..15c4ce7e44 100644 --- a/collects/games/scribblings/chat-noir.scrbl +++ b/collects/games/scribblings/chat-noir.scrbl @@ -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[]