Refactor(Structure): Move ADTs into adt/ folder, rename spel.rkt to main.rkt
New structure groups all ADT modules under adt/ directory, removing redundant adt- prefix from filenames. Library names now read as (pacman-project adt position) etc. All imports updated accordingly. Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
This commit is contained in:
joren
242
pacman-project/adt/draw.rkt
Normal file
242
pacman-project/adt/draw.rkt
Normal file
@@ -0,0 +1,242 @@
|
||||
#lang r7rs
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Draw ADT ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; All graphics logic is isolated in this ADT. Game logic knows nothing about
|
||||
;; pixels, windows, or sprites. Grid-to-pixel conversion happens exclusively
|
||||
;; here.
|
||||
|
||||
(define-library (pacman-project adt draw)
|
||||
(import (scheme base)
|
||||
(pp1 graphics)
|
||||
(pacman-project constants))
|
||||
(export make-draw)
|
||||
|
||||
(begin
|
||||
|
||||
;; make-draw :: number, number -> draw
|
||||
;; Creates the draw object that handles all rendering.
|
||||
(define (make-draw width height)
|
||||
(let ((window (make-window width height "Pacman")))
|
||||
|
||||
((window 'set-background!) "black")
|
||||
|
||||
;;
|
||||
;; Layers (order determines draw order)
|
||||
;;
|
||||
|
||||
(define maze-layer ((window 'new-layer!)))
|
||||
(define coins-layer ((window 'new-layer!)))
|
||||
(define key-layer ((window 'new-layer!)))
|
||||
(define pacman-layer ((window 'new-layer!)))
|
||||
(define ui-layer ((window 'new-layer!)))
|
||||
(define pause-layer ((window 'new-layer!)))
|
||||
|
||||
;;
|
||||
;; Maze tiles
|
||||
;;
|
||||
|
||||
(define maze-tile (make-tile width height))
|
||||
((maze-layer 'add-drawable!) maze-tile)
|
||||
|
||||
;;
|
||||
;; Coins tile
|
||||
;;
|
||||
|
||||
(define coins-tile (make-tile width height))
|
||||
((coins-layer 'add-drawable!) coins-tile)
|
||||
|
||||
;;
|
||||
;; Key sprite (in the maze)
|
||||
;;
|
||||
|
||||
(define key-sprite (make-bitmap-tile "pacman-sprites/key.png"))
|
||||
((key-sprite 'set-scale!) sprite-scale-key)
|
||||
((key-layer 'add-drawable!) key-sprite)
|
||||
|
||||
;; Key UI indicator (next to the score)
|
||||
(define key-ui-sprite (make-bitmap-tile "pacman-sprites/key.png"))
|
||||
((key-ui-sprite 'set-scale!) sprite-scale-key-ui)
|
||||
((key-ui-sprite 'set-x!) key-ui-x)
|
||||
((key-ui-sprite 'set-y!) key-ui-y)
|
||||
|
||||
;;
|
||||
;; Pac-Man sprite
|
||||
;;
|
||||
|
||||
(define pacman-bitmap-tiles
|
||||
(list (make-bitmap-tile "pacman-sprites/pacman-death-1.png")
|
||||
(make-bitmap-tile "pacman-sprites/pacman-closed.png")
|
||||
(make-bitmap-tile "pacman-sprites/pacman-open.png")))
|
||||
|
||||
(define pacman-sprite (make-tile-sequence pacman-bitmap-tiles))
|
||||
((pacman-sprite 'set-scale!) sprite-scale-pacman)
|
||||
((pacman-layer 'add-drawable!) pacman-sprite)
|
||||
|
||||
;; Animation state
|
||||
(define time-since-last-animation 0)
|
||||
|
||||
;;
|
||||
;; UI tiles
|
||||
;;
|
||||
|
||||
(define ui-tile (make-tile width height))
|
||||
((ui-layer 'add-drawable!) ui-tile)
|
||||
|
||||
;;
|
||||
;; Coordinate conversion
|
||||
;;
|
||||
|
||||
;; grid->pixel-x :: number -> number
|
||||
(define (grid->pixel-x col)
|
||||
(* cell-size-px col))
|
||||
|
||||
;; grid->pixel-y :: number -> number
|
||||
(define (grid->pixel-y row)
|
||||
(+ (* row cell-size-px) maze-offset-y))
|
||||
|
||||
;;
|
||||
;; Draw functions
|
||||
;;
|
||||
|
||||
;; draw-maze! :: maze -> /
|
||||
;; Draws all walls and doors.
|
||||
(define (draw-maze! maze)
|
||||
((maze 'for-each-cell)
|
||||
(lambda (row col cell-type)
|
||||
(cond
|
||||
((= cell-type cell-type-wall)
|
||||
((maze-tile 'draw-rectangle!)
|
||||
(grid->pixel-x col)
|
||||
(grid->pixel-y row)
|
||||
(- cell-size-px maze-wall-shrink)
|
||||
(- cell-size-px maze-wall-shrink)
|
||||
"blue"))
|
||||
((= cell-type cell-type-door)
|
||||
((maze-tile 'draw-rectangle!)
|
||||
(grid->pixel-x col)
|
||||
(grid->pixel-y row)
|
||||
(- cell-size-px maze-wall-shrink)
|
||||
(- cell-size-px maze-wall-shrink)
|
||||
"pink"))))))
|
||||
|
||||
;; draw-coins! :: maze -> /
|
||||
;; Draws all coins in the maze.
|
||||
(define (draw-coins! maze)
|
||||
((coins-tile 'clear!))
|
||||
((maze 'for-each-cell)
|
||||
(lambda (row col cell-type)
|
||||
(when (= cell-type cell-type-coin)
|
||||
((coins-tile 'draw-rectangle!)
|
||||
(+ (grid->pixel-x col) coin-inset)
|
||||
(+ (grid->pixel-y row) coin-inset)
|
||||
(- cell-size-px (* 2 coin-inset) 6)
|
||||
(- cell-size-px (* 2 coin-inset) 6)
|
||||
"yellow")))))
|
||||
|
||||
;; draw-key! :: key -> /
|
||||
;; Draws the key at its position, or shows it in UI if taken.
|
||||
(define (draw-key! key-obj)
|
||||
(if (key-obj 'taken?)
|
||||
(begin
|
||||
((key-layer 'remove-drawable!) key-sprite)
|
||||
((key-layer 'add-drawable!) key-ui-sprite))
|
||||
(let ((pos (key-obj 'position)))
|
||||
((key-sprite 'set-x!) (grid->pixel-x (pos 'col)))
|
||||
((key-sprite 'set-y!) (grid->pixel-y (pos 'row))))))
|
||||
|
||||
;; draw-pacman! :: pacman, number -> /
|
||||
;; Draws Pac-Man at its current position with correct rotation.
|
||||
(define (draw-pacman! pacman delta-time)
|
||||
(let* ((pos (pacman 'position))
|
||||
(direction (pacman 'direction)))
|
||||
;; Set position
|
||||
((pacman-sprite 'set-x!) (grid->pixel-x (pos 'col)))
|
||||
((pacman-sprite 'set-y!) (grid->pixel-y (pos 'row)))
|
||||
;; Set rotation based on direction
|
||||
(cond ((eq? direction 'right) ((pacman-sprite 'rotate!) rotation-right))
|
||||
((eq? direction 'left) ((pacman-sprite 'rotate!) rotation-left))
|
||||
((eq? direction 'up) ((pacman-sprite 'rotate!) rotation-up))
|
||||
((eq? direction 'down) ((pacman-sprite 'rotate!) rotation-down)))
|
||||
;; Animation
|
||||
(set! time-since-last-animation (+ time-since-last-animation delta-time))
|
||||
(when (>= time-since-last-animation animation-interval-ms)
|
||||
((pacman-sprite 'set-next!))
|
||||
(set! time-since-last-animation 0))))
|
||||
|
||||
;; draw-ui! :: score, timer -> /
|
||||
;; Draws the score and time limit on screen.
|
||||
(define (draw-ui! score timer)
|
||||
((ui-tile 'clear!))
|
||||
;; Score
|
||||
((ui-tile 'draw-text!)
|
||||
(number->string (score 'points))
|
||||
score-text-size score-text-x score-text-y "white")
|
||||
;; Separator line
|
||||
((ui-tile 'draw-rectangle!)
|
||||
separator-x 0 separator-width height "white")
|
||||
;; Time limit
|
||||
((ui-tile 'draw-text!)
|
||||
"Time remaining:" time-text-size time-label-x time-label-y "white")
|
||||
((ui-tile 'draw-text!)
|
||||
((timer 'format-time))
|
||||
score-text-size time-value-x time-value-y "white"))
|
||||
|
||||
;; draw-pause! :: boolean -> /
|
||||
;; Shows or hides the pause screen.
|
||||
(define (draw-pause! paused?)
|
||||
((pause-layer 'empty!))
|
||||
(when paused?
|
||||
(let ((pause-tile (make-tile width height)))
|
||||
((pause-layer 'add-drawable!) pause-tile)
|
||||
((pause-tile 'draw-rectangle!) 0 90 670 height "black")
|
||||
((pause-tile 'draw-text!) "Game Paused" 40 200 400 "red"))))
|
||||
|
||||
;;
|
||||
;; Main draw function
|
||||
;;
|
||||
|
||||
;; draw-game! :: game -> /
|
||||
;; Draws the full game (registered as draw callback).
|
||||
(define (draw-game! game)
|
||||
(let ((level (game 'level)))
|
||||
(draw-pacman! (level 'pacman) 0)
|
||||
(draw-key! (level 'key))
|
||||
(draw-coins! (level 'maze))
|
||||
(draw-ui! (level 'score) (level 'timer))
|
||||
(draw-pause! (level 'paused?))))
|
||||
|
||||
;;
|
||||
;; Callback registration
|
||||
;;
|
||||
|
||||
;; set-game-loop! :: (number -> /) -> /
|
||||
(define (set-game-loop! fun)
|
||||
((window 'set-update-callback!) fun))
|
||||
|
||||
;; set-key-callback! :: (symbol, any -> /) -> /
|
||||
(define (set-key-callback! fun)
|
||||
((window 'set-key-callback!) fun))
|
||||
|
||||
;; start-drawing! :: game -> /
|
||||
;; Starts drawing by setting the draw callback.
|
||||
(define (start-drawing! game)
|
||||
;; Initial maze and coins draw (one-time)
|
||||
(draw-maze! ((game 'level) 'maze))
|
||||
(draw-coins! ((game 'level) 'maze))
|
||||
((window 'set-draw-callback!)
|
||||
(lambda () (draw-game! game))))
|
||||
|
||||
;;
|
||||
;; Dispatch
|
||||
;;
|
||||
|
||||
(define (dispatch-draw msg)
|
||||
(cond ((eq? msg 'set-game-loop!) set-game-loop!)
|
||||
((eq? msg 'set-key-callback!) set-key-callback!)
|
||||
((eq? msg 'start-drawing!) start-drawing!)
|
||||
(else (error "Draw ADT -- Unknown message:" msg))))
|
||||
|
||||
dispatch-draw))))
|
||||
48
pacman-project/adt/game.rkt
Normal file
48
pacman-project/adt/game.rkt
Normal file
@@ -0,0 +1,48 @@
|
||||
#lang r7rs
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Game ADT ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; Top-level game object that connects the level (logic) with the draw ADT
|
||||
;; (graphics). Registers callbacks for the game loop, keys, and drawing.
|
||||
|
||||
(define-library (pacman-project adt game)
|
||||
(import (scheme base)
|
||||
(pacman-project constants)
|
||||
(pacman-project adt level)
|
||||
(pacman-project adt draw))
|
||||
(export make-game)
|
||||
|
||||
(begin
|
||||
|
||||
;; make-game :: -> game
|
||||
(define (make-game)
|
||||
(let ((level (make-level))
|
||||
(draw (make-draw window-width-px window-height-px)))
|
||||
|
||||
;; key-handler :: symbol, any -> /
|
||||
;; Processes key presses and forwards them to the level.
|
||||
(define (key-handler status key)
|
||||
(when (eq? status 'pressed)
|
||||
((level 'key-press!) key)))
|
||||
|
||||
;; game-loop :: number -> /
|
||||
;; Called each frame for game state updates.
|
||||
(define (game-loop delta-time)
|
||||
((level 'update!) delta-time))
|
||||
|
||||
;; start! :: -> /
|
||||
;; Starts the game by registering all callbacks.
|
||||
(define (start!)
|
||||
((draw 'set-game-loop!) game-loop)
|
||||
((draw 'set-key-callback!) key-handler)
|
||||
((draw 'start-drawing!) dispatch-game))
|
||||
|
||||
;; dispatch-game :: symbol -> any
|
||||
(define (dispatch-game msg)
|
||||
(cond ((eq? msg 'start!) start!)
|
||||
((eq? msg 'level) level)
|
||||
(else (error "Game ADT -- Unknown message:" msg))))
|
||||
|
||||
dispatch-game))))
|
||||
55
pacman-project/adt/key.rkt
Normal file
55
pacman-project/adt/key.rkt
Normal file
@@ -0,0 +1,55 @@
|
||||
#lang r7rs
|
||||
|
||||
(#%require (only racket/base random))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Key ADT ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; The key is placed at a random coin position in the maze. When Pac-Man
|
||||
;; picks it up, doors can be opened. Contains NO graphics code.
|
||||
|
||||
(define-library (pacman-project adt key)
|
||||
(import (scheme base)
|
||||
(pacman-project constants)
|
||||
(pacman-project adt position))
|
||||
(export make-key)
|
||||
|
||||
(begin
|
||||
|
||||
;; make-key :: maze -> key
|
||||
;; Creates a key and places it at a random coin position.
|
||||
(define (make-key maze)
|
||||
(let ((position #f)
|
||||
(taken? #f))
|
||||
|
||||
;; place-random! :: -> /
|
||||
;; Places the key on a random cell that contains a coin.
|
||||
(define (place-random!)
|
||||
(let loop ((attempts 0))
|
||||
(if (>= attempts max-placement-attempts)
|
||||
(error "No valid position found for key")
|
||||
(let ((col (random 0 (maze 'cols)))
|
||||
(row (random 0 (maze 'rows))))
|
||||
(if ((maze 'coin?) row col)
|
||||
(begin
|
||||
(set! position (make-position row col))
|
||||
((maze 'cell-set!) row col cell-type-key))
|
||||
(loop (+ attempts 1)))))))
|
||||
|
||||
;; take! :: -> /
|
||||
;; Marks the key as taken.
|
||||
(define (take!)
|
||||
(set! taken? #t))
|
||||
|
||||
;; Initialization: place the key immediately on creation.
|
||||
(place-random!)
|
||||
|
||||
;; dispatch-key :: symbol -> any
|
||||
(define (dispatch-key msg)
|
||||
(cond ((eq? msg 'position) position)
|
||||
((eq? msg 'taken?) taken?)
|
||||
((eq? msg 'take!) take!)
|
||||
(else (error "Key ADT -- Unknown message:" msg))))
|
||||
|
||||
dispatch-key))))
|
||||
174
pacman-project/adt/level.rkt
Normal file
174
pacman-project/adt/level.rkt
Normal file
@@ -0,0 +1,174 @@
|
||||
#lang r7rs
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Level ADT ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; Contains all game logic: Pac-Man movement, collision detection, coin/key
|
||||
;; pickup, door opening, teleportation, pause, and time management.
|
||||
;; Contains NO graphics code.
|
||||
|
||||
(define-library (pacman-project adt level)
|
||||
(import (scheme base)
|
||||
(pacman-project constants)
|
||||
(pacman-project adt position)
|
||||
(pacman-project adt maze)
|
||||
(pacman-project adt pacman)
|
||||
(pacman-project adt key)
|
||||
(pacman-project adt score)
|
||||
(pacman-project adt timer))
|
||||
(export make-level)
|
||||
|
||||
(begin
|
||||
|
||||
;; make-level :: -> level
|
||||
;; Creates a new level with all game objects.
|
||||
(define (make-level)
|
||||
(let ((maze (make-maze))
|
||||
(pacman (make-pacman 5 2))
|
||||
(key #f)
|
||||
(score (make-score))
|
||||
(timer (make-timer))
|
||||
(paused? #f))
|
||||
|
||||
;; Initialize key after maze is created.
|
||||
(set! key (make-key maze))
|
||||
|
||||
;;
|
||||
;; Direction helpers
|
||||
;;
|
||||
|
||||
;; direction->delta :: symbol -> (number . number)
|
||||
;; Converts a direction to a (delta-row . delta-col) pair.
|
||||
(define (direction->delta direction)
|
||||
(cond ((eq? direction 'right) (cons 0 1))
|
||||
((eq? direction 'left) (cons 0 -1))
|
||||
((eq? direction 'up) (cons -1 0))
|
||||
((eq? direction 'down) (cons 1 0))
|
||||
(else (cons 0 0))))
|
||||
|
||||
;;
|
||||
;; Coin logic
|
||||
;;
|
||||
|
||||
;; eat-coin! :: number, number -> /
|
||||
;; Removes the coin at the cell and updates score/time.
|
||||
(define (eat-coin! row col)
|
||||
((maze 'cell-set!) row col cell-type-empty)
|
||||
((score 'increase!))
|
||||
((timer 'increase!)))
|
||||
|
||||
;;
|
||||
;; Key logic
|
||||
;;
|
||||
|
||||
;; pick-up-key! :: number, number -> /
|
||||
;; Picks up the key and clears the cell.
|
||||
(define (pick-up-key! row col)
|
||||
((maze 'cell-set!) row col cell-type-empty)
|
||||
((key 'take!)))
|
||||
|
||||
;;
|
||||
;; Teleportation logic
|
||||
;;
|
||||
|
||||
;; teleport-horizontal! :: number, number -> /
|
||||
;; Teleports Pac-Man to the other side of the maze.
|
||||
(define (teleport-horizontal! row col)
|
||||
(let ((pac-pos (pacman 'position)))
|
||||
(cond ((< col 0)
|
||||
((pac-pos 'col!) (- (maze 'cols) 1))
|
||||
((pac-pos 'row!) row))
|
||||
((>= col (maze 'cols))
|
||||
((pac-pos 'col!) 0)
|
||||
((pac-pos 'row!) row)))))
|
||||
|
||||
;;
|
||||
;; Movement logic
|
||||
;;
|
||||
|
||||
;; move-pacman! :: symbol -> /
|
||||
;; Moves Pac-Man in the given direction with all game rules.
|
||||
(define (move-pacman! direction)
|
||||
(when (not ((timer 'time-up?)))
|
||||
(let* ((delta (direction->delta direction))
|
||||
(delta-row (car delta))
|
||||
(delta-col (cdr delta))
|
||||
(current-pos (pacman 'position))
|
||||
(next-row (+ (current-pos 'row) delta-row))
|
||||
(next-col (+ (current-pos 'col) delta-col)))
|
||||
|
||||
;; Update direction for the draw layer.
|
||||
((pacman 'direction!) direction)
|
||||
|
||||
(cond
|
||||
;; Teleportation: outside grid horizontally.
|
||||
((or (< next-col 0) (>= next-col (maze 'cols)))
|
||||
(teleport-horizontal! next-row next-col))
|
||||
|
||||
;; Door: only open if key has been taken.
|
||||
(((maze 'door?) next-row next-col)
|
||||
(when (key 'taken?)
|
||||
((maze 'remove-door!) next-row next-col)))
|
||||
|
||||
;; Normal movement: only if not a wall.
|
||||
(else
|
||||
(when (not ((maze 'wall?) next-row next-col))
|
||||
((pacman 'move!) delta-row delta-col)
|
||||
;; Check what's at the new position.
|
||||
(cond
|
||||
(((maze 'key?) next-row next-col)
|
||||
(pick-up-key! next-row next-col))
|
||||
(((maze 'coin?) next-row next-col)
|
||||
(eat-coin! next-row next-col)))))))))
|
||||
|
||||
;;
|
||||
;; Pause logic
|
||||
;;
|
||||
|
||||
;; toggle-pause! :: -> /
|
||||
(define (toggle-pause!)
|
||||
(set! paused? (not paused?)))
|
||||
|
||||
;;
|
||||
;; Key handling
|
||||
;;
|
||||
|
||||
;; key-press! :: symbol -> /
|
||||
;; Processes a key press.
|
||||
(define (key-press! pressed-key)
|
||||
(cond
|
||||
((eq? pressed-key 'escape) (toggle-pause!))
|
||||
((not paused?)
|
||||
(cond
|
||||
((eq? pressed-key 'right) (move-pacman! 'right))
|
||||
((eq? pressed-key 'left) (move-pacman! 'left))
|
||||
((eq? pressed-key 'up) (move-pacman! 'up))
|
||||
((eq? pressed-key 'down) (move-pacman! 'down))))))
|
||||
|
||||
;;
|
||||
;; Update (game loop function)
|
||||
;;
|
||||
|
||||
;; update! :: number -> /
|
||||
;; Called each frame with elapsed milliseconds.
|
||||
(define (update! delta-time)
|
||||
(when (not paused?)
|
||||
((timer 'decrease!) delta-time)))
|
||||
|
||||
;;
|
||||
;; Dispatch
|
||||
;;
|
||||
|
||||
(define (dispatch-level msg)
|
||||
(cond ((eq? msg 'maze) maze)
|
||||
((eq? msg 'pacman) pacman)
|
||||
((eq? msg 'key) key)
|
||||
((eq? msg 'score) score)
|
||||
((eq? msg 'timer) timer)
|
||||
((eq? msg 'paused?) paused?)
|
||||
((eq? msg 'key-press!) key-press!)
|
||||
((eq? msg 'update!) update!)
|
||||
(else (error "Level ADT -- Unknown message:" msg))))
|
||||
|
||||
dispatch-level))))
|
||||
118
pacman-project/adt/maze.rkt
Normal file
118
pacman-project/adt/maze.rkt
Normal file
@@ -0,0 +1,118 @@
|
||||
#lang r7rs
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Maze ADT ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; The maze contains the logical grid with cells. Each cell has a type
|
||||
;; (wall, coin, empty, key, door). This ADT contains NO graphics code.
|
||||
|
||||
(define-library (pacman-project adt maze)
|
||||
(import (scheme base)
|
||||
(pacman-project constants))
|
||||
(export make-maze)
|
||||
|
||||
(begin
|
||||
|
||||
;; make-maze :: -> maze
|
||||
;; Creates a new maze object with the full grid.
|
||||
(define (make-maze)
|
||||
|
||||
;; The maze grid: 31 rows x 28 columns.
|
||||
;; vector is used because it is mutable (unlike #()).
|
||||
(define grid
|
||||
(vector (vector 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(vector 1 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 1)
|
||||
(vector 1 0 1 1 1 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 1)
|
||||
(vector 1 0 1 0 0 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 1)
|
||||
(vector 1 0 1 4 1 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 1)
|
||||
(vector 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1)
|
||||
(vector 1 0 1 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 1 0 1)
|
||||
(vector 1 0 1 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 1 0 1)
|
||||
(vector 1 0 0 0 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 0 0 1)
|
||||
(vector 1 1 1 1 1 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 1 1 1 1 1 1)
|
||||
(vector 2 2 2 2 2 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 1 2 2 2 2 2)
|
||||
(vector 2 2 2 2 2 1 0 1 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 2 2 2 2 2)
|
||||
(vector 2 2 2 2 2 1 0 1 1 0 1 1 1 4 4 1 1 1 0 1 1 0 1 2 2 2 2 2)
|
||||
(vector 1 1 1 1 1 1 0 1 1 0 1 2 2 2 2 2 2 1 0 1 1 0 1 1 1 1 1 1)
|
||||
(vector 2 0 0 0 0 0 0 0 0 0 1 2 2 2 2 2 2 1 0 0 0 0 0 0 0 0 0 2)
|
||||
(vector 1 1 1 1 1 1 0 1 1 0 1 2 2 2 2 2 2 1 0 1 1 0 1 1 1 1 1 1)
|
||||
(vector 2 2 2 2 2 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 2 2 2 2 2)
|
||||
(vector 2 2 2 2 2 1 0 1 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 2 2 2 2 2)
|
||||
(vector 2 2 2 2 2 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 2 2 2 2 2)
|
||||
(vector 1 1 1 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 1 1 1)
|
||||
(vector 1 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 1)
|
||||
(vector 1 0 1 1 1 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 1)
|
||||
(vector 1 0 1 1 1 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 1)
|
||||
(vector 1 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 1)
|
||||
(vector 1 1 1 0 1 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 0 1 1 1)
|
||||
(vector 1 1 1 0 1 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 0 1 1 1)
|
||||
(vector 1 0 0 0 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 4 1 0 0 0 0 0 0 1)
|
||||
(vector 1 0 1 1 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 0 0 1 1 1 1 1 0 1)
|
||||
(vector 1 0 1 1 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 1 1 0 1)
|
||||
(vector 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1)
|
||||
(vector 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)))
|
||||
|
||||
(define num-rows (vector-length grid))
|
||||
(define num-cols (vector-length (vector-ref grid 0)))
|
||||
|
||||
;; cell-ref :: number, number -> number
|
||||
;; Returns the cell type at the given position.
|
||||
(define (cell-ref row col)
|
||||
(vector-ref (vector-ref grid row) col))
|
||||
|
||||
;; cell-set! :: number, number, number -> /
|
||||
;; Sets the cell type at the given position.
|
||||
(define (cell-set! row col value)
|
||||
(vector-set! (vector-ref grid row) col value))
|
||||
|
||||
;; wall? :: number, number -> boolean
|
||||
(define (wall? row col)
|
||||
(= (cell-ref row col) cell-type-wall))
|
||||
|
||||
;; coin? :: number, number -> boolean
|
||||
(define (coin? row col)
|
||||
(= (cell-ref row col) cell-type-coin))
|
||||
|
||||
;; empty? :: number, number -> boolean
|
||||
(define (empty? row col)
|
||||
(= (cell-ref row col) cell-type-empty))
|
||||
|
||||
;; key? :: number, number -> boolean
|
||||
(define (key? row col)
|
||||
(= (cell-ref row col) cell-type-key))
|
||||
|
||||
;; door? :: number, number -> boolean
|
||||
(define (door? row col)
|
||||
(= (cell-ref row col) cell-type-door))
|
||||
|
||||
;; remove-door! :: number, number -> /
|
||||
;; Removes a door from the grid (makes the cell empty).
|
||||
(define (remove-door! row col)
|
||||
(cell-set! row col cell-type-empty))
|
||||
|
||||
;; for-each-cell :: (number, number, number -> /) -> /
|
||||
;; Iterates over all cells, calling callback with row, col, cell-type.
|
||||
(define (for-each-cell callback)
|
||||
(do ((row 0 (+ row 1)))
|
||||
((= row num-rows))
|
||||
(do ((col 0 (+ col 1)))
|
||||
((= col num-cols))
|
||||
(callback row col (cell-ref row col)))))
|
||||
|
||||
;; dispatch-maze :: symbol -> any
|
||||
(define (dispatch-maze msg)
|
||||
(cond ((eq? msg 'rows) num-rows)
|
||||
((eq? msg 'cols) num-cols)
|
||||
((eq? msg 'cell-ref) cell-ref)
|
||||
((eq? msg 'cell-set!) cell-set!)
|
||||
((eq? msg 'wall?) wall?)
|
||||
((eq? msg 'coin?) coin?)
|
||||
((eq? msg 'empty?) empty?)
|
||||
((eq? msg 'key?) key?)
|
||||
((eq? msg 'door?) door?)
|
||||
((eq? msg 'remove-door!) remove-door!)
|
||||
((eq? msg 'for-each-cell) for-each-cell)
|
||||
(else (error "Maze ADT -- Unknown message:" msg))))
|
||||
|
||||
dispatch-maze)))
|
||||
46
pacman-project/adt/pacman.rkt
Normal file
46
pacman-project/adt/pacman.rkt
Normal file
@@ -0,0 +1,46 @@
|
||||
#lang r7rs
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Pac-Man ADT ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; Manages the logical state of the player: grid position and current
|
||||
;; direction. Contains NO graphics code.
|
||||
|
||||
(define-library (pacman-project adt pacman)
|
||||
(import (scheme base)
|
||||
(pacman-project adt position))
|
||||
(export make-pacman)
|
||||
|
||||
(begin
|
||||
|
||||
;; make-pacman :: number, number -> pacman
|
||||
;; Creates a Pac-Man object at the given start position (row, col).
|
||||
(define (make-pacman start-row start-col)
|
||||
(let ((position (make-position start-row start-col))
|
||||
(direction 'right))
|
||||
|
||||
;; position! :: position -> /
|
||||
(define (position! new-position)
|
||||
(set! position new-position))
|
||||
|
||||
;; direction! :: symbol -> /
|
||||
(define (direction! new-direction)
|
||||
(set! direction new-direction))
|
||||
|
||||
;; move! :: number, number -> /
|
||||
;; Moves Pac-Man by a delta on the grid.
|
||||
(define (move! delta-row delta-col)
|
||||
((position 'row!) (+ (position 'row) delta-row))
|
||||
((position 'col!) (+ (position 'col) delta-col)))
|
||||
|
||||
;; dispatch-pacman :: symbol -> any
|
||||
(define (dispatch-pacman msg)
|
||||
(cond ((eq? msg 'position) position)
|
||||
((eq? msg 'position!) position!)
|
||||
((eq? msg 'direction) direction)
|
||||
((eq? msg 'direction!) direction!)
|
||||
((eq? msg 'move!) move!)
|
||||
(else (error "Pac-Man ADT -- Unknown message:" msg))))
|
||||
|
||||
dispatch-pacman))))
|
||||
50
pacman-project/adt/position.rkt
Normal file
50
pacman-project/adt/position.rkt
Normal file
@@ -0,0 +1,50 @@
|
||||
#lang r7rs
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Position ADT ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; A position represents a location on the logical maze grid.
|
||||
;; Coordinates are in grid units (row, col), NOT pixels.
|
||||
|
||||
(define-library (pacman-project adt position)
|
||||
(import (scheme base))
|
||||
(export make-position)
|
||||
|
||||
(begin
|
||||
|
||||
;; make-position :: number, number -> position
|
||||
;; Creates a new position object with row and column on the grid.
|
||||
(define (make-position row col)
|
||||
|
||||
;; row! :: number -> /
|
||||
(define (row! new-row)
|
||||
(set! row new-row))
|
||||
|
||||
;; col! :: number -> /
|
||||
(define (col! new-col)
|
||||
(set! col new-col))
|
||||
|
||||
;; equal? :: position -> boolean
|
||||
;; Checks whether two positions have the same coordinates.
|
||||
(define (equal? other)
|
||||
(and (= row (other 'row))
|
||||
(= col (other 'col))))
|
||||
|
||||
;; move :: number, number -> position
|
||||
;; Returns a new position shifted by delta-row and delta-col.
|
||||
(define (move delta-row delta-col)
|
||||
(make-position (+ row delta-row)
|
||||
(+ col delta-col)))
|
||||
|
||||
;; dispatch-position :: symbol -> any
|
||||
(define (dispatch-position msg)
|
||||
(cond ((eq? msg 'row) row)
|
||||
((eq? msg 'col) col)
|
||||
((eq? msg 'row!) row!)
|
||||
((eq? msg 'col!) col!)
|
||||
((eq? msg 'equal?) equal?)
|
||||
((eq? msg 'move) move)
|
||||
(else (error "Position ADT -- Unknown message:" msg))))
|
||||
|
||||
dispatch-position)))
|
||||
32
pacman-project/adt/score.rkt
Normal file
32
pacman-project/adt/score.rkt
Normal file
@@ -0,0 +1,32 @@
|
||||
#lang r7rs
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Score ADT ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; Tracks the player's score. Contains NO graphics code.
|
||||
|
||||
(define-library (pacman-project adt score)
|
||||
(import (scheme base)
|
||||
(pacman-project constants))
|
||||
(export make-score)
|
||||
|
||||
(begin
|
||||
|
||||
;; make-score :: -> score
|
||||
;; Creates a new score object, starting at 0.
|
||||
(define (make-score)
|
||||
(let ((points 0))
|
||||
|
||||
;; increase! :: -> /
|
||||
;; Increases the score by points-per-coin.
|
||||
(define (increase!)
|
||||
(set! points (+ points points-per-coin)))
|
||||
|
||||
;; dispatch-score :: symbol -> any
|
||||
(define (dispatch-score msg)
|
||||
(cond ((eq? msg 'points) points)
|
||||
((eq? msg 'increase!) increase!)
|
||||
(else (error "Score ADT -- Unknown message:" msg))))
|
||||
|
||||
dispatch-score))))
|
||||
62
pacman-project/adt/timer.rkt
Normal file
62
pacman-project/adt/timer.rkt
Normal file
@@ -0,0 +1,62 @@
|
||||
#lang r7rs
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Timer ADT ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; Manages the countdown time limit. Contains NO graphics code.
|
||||
|
||||
(define-library (pacman-project adt timer)
|
||||
(import (scheme base)
|
||||
(pacman-project constants))
|
||||
(export make-timer)
|
||||
|
||||
(begin
|
||||
|
||||
;; make-timer :: -> timer
|
||||
;; Creates a new timer object.
|
||||
(define (make-timer)
|
||||
(let ((remaining-time start-time-seconds)
|
||||
(time-since-last-tick 0))
|
||||
|
||||
;; decrease! :: number -> /
|
||||
;; Decreases time based on elapsed milliseconds.
|
||||
(define (decrease! ms)
|
||||
(set! time-since-last-tick (+ time-since-last-tick ms))
|
||||
(when (>= time-since-last-tick ms-per-second)
|
||||
(set! time-since-last-tick 0)
|
||||
(when (> remaining-time 0)
|
||||
(set! remaining-time (- remaining-time 1)))))
|
||||
|
||||
;; increase! :: -> /
|
||||
;; Adds a time bonus (when eating a coin).
|
||||
(define (increase!)
|
||||
(set! remaining-time (+ remaining-time time-bonus-per-coin)))
|
||||
|
||||
;; time-up? :: -> boolean
|
||||
(define (time-up?)
|
||||
(= remaining-time 0))
|
||||
|
||||
;; format-time :: -> string
|
||||
;; Returns remaining time as "m:ss" string.
|
||||
(define (format-time)
|
||||
(let* ((minutes (quotient remaining-time 60))
|
||||
(seconds (remainder remaining-time 60))
|
||||
(min-str (number->string minutes))
|
||||
(sec-str (number->string seconds)))
|
||||
(string-append min-str
|
||||
":"
|
||||
(if (< seconds 10)
|
||||
(string-append "0" sec-str)
|
||||
sec-str))))
|
||||
|
||||
;; dispatch-timer :: symbol -> any
|
||||
(define (dispatch-timer msg)
|
||||
(cond ((eq? msg 'remaining-time) remaining-time)
|
||||
((eq? msg 'decrease!) decrease!)
|
||||
((eq? msg 'increase!) increase!)
|
||||
((eq? msg 'time-up?) time-up?)
|
||||
((eq? msg 'format-time) format-time)
|
||||
(else (error "Timer ADT -- Unknown message:" msg))))
|
||||
|
||||
dispatch-timer))))
|
||||
Reference in New Issue
Block a user