From 9028dd031cf65eb2b0603c92fc1c37e637627b0d Mon Sep 17 00:00:00 2001 From: joren Date: Mon, 23 Mar 2026 11:42:34 +0100 Subject: [PATCH] Add ghost CPUs with original Pac-Man AI targeting Implement four ghosts (Blinky, Pinky, Inky, Clyde) with authentic Pac-Man AI: Blinky chases directly, Pinky targets 2 tiles ahead (with original up-direction bug), Inky uses vector doubling from Blinky, Clyde switches to scatter within 8-tile radius. Includes chase/scatter mode cycling, ghost house exit with staggered delays, directional sprite rendering with animation, and ghost-pacman collision detection. Co-Authored-By: Claude Opus 4.6 --- pacman-project/adt/draw.rkt | 142 ++++++++--- pacman-project/adt/ghost.rkt | 94 +++++++ pacman-project/adt/level.rkt | 372 ++++++++++++++++++++++++---- pacman-project/constants.rkt | 90 +++++++ pacman-project/tests/all-tests.rkt | 2 + pacman-project/tests/test-ghost.rkt | 97 ++++++++ 6 files changed, 714 insertions(+), 83 deletions(-) create mode 100644 pacman-project/adt/ghost.rkt create mode 100644 pacman-project/tests/test-ghost.rkt diff --git a/pacman-project/adt/draw.rkt b/pacman-project/adt/draw.rkt index 6251261..7625c7b 100644 --- a/pacman-project/adt/draw.rkt +++ b/pacman-project/adt/draw.rkt @@ -35,6 +35,7 @@ (define maze-layer ((window 'new-layer!))) (define coins-layer ((window 'new-layer!))) (define key-layer ((window 'new-layer!))) + (define ghost-layer ((window 'new-layer!))) (define pacman-layer ((window 'new-layer!))) (define ui-layer ((window 'new-layer!))) (define overlay-layer ((window 'new-layer!))) @@ -47,7 +48,6 @@ ((header-layer 'add-drawable!) header-tile) ;; draw-header! :: -> / - ;; Draws the static header with the PAC-MAN title. (define (draw-header!) ((header-tile 'draw-rectangle!) 0 0 width header-height color-header-bg) ((header-tile 'draw-text!) @@ -81,6 +81,87 @@ ((key-ui-sprite 'set-x!) key-ui-x) ((key-ui-sprite 'set-y!) key-ui-y) + ;; + ;; 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)) + + ;; + ;; Ghost sprites + ;; + + ;; load-direction-seq :: string, string -> tile-sequence + ;; Loads a 2-frame animation sequence for one direction. + (define (load-direction-seq prefix dir-name) + (let ((seq (make-tile-sequence + (list (make-bitmap-tile + (string-append prefix dir-name "-1.png")) + (make-bitmap-tile + (string-append prefix dir-name "-2.png")))))) + ((seq 'set-scale!) sprite-scale-ghost) + seq)) + + ;; make-ghost-draw-state :: string -> ghost-draw-state + ;; Creates sprite management state for one ghost. Returns a + ;; dispatch closure for updating position, direction, animation. + (define (make-ghost-draw-state name) + (let* ((prefix (string-append "pacman-sprites/" name "-")) + (up-seq (load-direction-seq prefix "up")) + (down-seq (load-direction-seq prefix "down")) + (left-seq (load-direction-seq prefix "left")) + (right-seq (load-direction-seq prefix "right")) + (active-seq left-seq) + (cached-dir 'left)) + ;; Add initial sprite to ghost layer + ((ghost-layer 'add-drawable!) active-seq) + + ;; dir->seq :: symbol -> tile-sequence + (define (dir->seq dir) + (cond ((eq? dir 'up) up-seq) + ((eq? dir 'down) down-seq) + ((eq? dir 'left) left-seq) + ((eq? dir 'right) right-seq) + (else left-seq))) + + (define (dispatch msg) + (cond + ;; update! :: number, number, symbol -> / + ;; Updates position and direction of this ghost's sprite. + ((eq? msg 'update!) + (lambda (row col direction) + ;; Swap sprite sequence if direction changed + (when (not (eq? direction cached-dir)) + (let ((old-x ((active-seq 'get-x))) + (old-y ((active-seq 'get-y)))) + ((ghost-layer 'remove-drawable!) active-seq) + (set! active-seq (dir->seq direction)) + ((active-seq 'set-x!) old-x) + ((active-seq 'set-y!) old-y) + ((ghost-layer 'add-drawable!) active-seq) + (set! cached-dir direction))) + ;; Update position + ((active-seq 'set-x!) (grid->pixel-x col)) + ((active-seq 'set-y!) (grid->pixel-y row)))) + ;; animate! :: -> / + ((eq? msg 'animate!) + (lambda () ((active-seq 'set-next!)))) + (else (error "Ghost draw state -- Unknown message:" msg)))) + dispatch)) + + ;; Create draw state for each ghost (in fixed order matching level) + (define blinky-draw (make-ghost-draw-state "blinky")) + (define pinky-draw (make-ghost-draw-state "pinky")) + (define inky-draw (make-ghost-draw-state "inky")) + (define clyde-draw (make-ghost-draw-state "clyde")) + (define ghost-draw-states (list blinky-draw pinky-draw inky-draw clyde-draw)) + ;; ;; Pac-Man sprite ;; @@ -112,27 +193,14 @@ (define cached-time "") (define key-sprite-swapped? #f) (define cached-paused? #f) - (define cached-time-up? #f) + (define cached-game-over? #f) (define coins-dirty? #t) - ;; - ;; 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-tile 'clear!)) ((maze 'for-each-cell) @@ -154,7 +222,6 @@ color-door)))))) ;; draw-coins! :: maze -> / - ;; Redraws all coins as small round dots. (define (draw-coins! maze) ((coins-tile 'clear!)) ((maze 'for-each-cell) @@ -168,14 +235,12 @@ color-coin))))) ;; init-key-position! :: key -> / - ;; Sets the key sprite to its grid position. Called once at startup. (define (init-key-position! key-obj) (let ((pos (key-obj 'position))) ((key-sprite 'set-x!) (grid->pixel-x (pos 'col))) ((key-sprite 'set-y!) (grid->pixel-y (pos 'row))))) ;; draw-key! :: key -> / - ;; Swaps the key sprite once when taken. No-op on subsequent frames. (define (draw-key! key-obj) (when (and (key-obj 'taken?) (not key-sprite-swapped?)) ((key-layer 'remove-drawable!) key-sprite) @@ -183,15 +248,15 @@ (set! key-sprite-swapped? #t))) ;; animate-pacman! :: number -> / - ;; Advances the Pac-Man sprite animation based on elapsed time. (define (animate-pacman! delta-time) (set! time-since-last-animation (+ time-since-last-animation delta-time)) (when (>= time-since-last-animation animation-interval-ms) ((pacman-sprite 'set-next!)) + ;; Also animate ghost sprites + (for-each (lambda (gds) ((gds 'animate!))) ghost-draw-states) (set! time-since-last-animation 0))) ;; draw-pacman! :: pacman -> / - ;; Updates Pac-Man position and rotation. (define (draw-pacman! pacman) (let* ((pos (pacman 'position)) (direction (pacman 'direction))) @@ -202,39 +267,44 @@ ((eq? direction 'up) ((pacman-sprite 'rotate!) rotation-up)) ((eq? direction 'down) ((pacman-sprite 'rotate!) rotation-down))))) + ;; draw-ghosts! :: list -> / + ;; Updates all ghost sprite positions and directions. + (define (draw-ghosts! ghosts) + (for-each + (lambda (ghost ghost-draw) + (let* ((pos (ghost 'position)) + (row (pos 'row)) + (col (pos 'col)) + (dir (ghost 'direction))) + ((ghost-draw 'update!) row col dir))) + ghosts ghost-draw-states)) + ;; draw-ui! :: score, timer -> / - ;; Redraws score and time only when their values have changed. (define (draw-ui! score timer) (let ((current-score (score 'points)) (current-time ((timer 'format-time)))) (when (or (not (= current-score cached-score)) (not (string=? current-time cached-time))) ((ui-tile 'clear!)) - ;; Score label ((ui-tile 'draw-text!) "SCORE" score-label-size score-label-x score-label-y color-text) - ;; Score value ((ui-tile 'draw-text!) (number->string current-score) score-value-size score-value-x score-value-y color-text) - ;; Sidebar separator ((ui-tile 'draw-rectangle!) sidebar-x 0 sidebar-width height color-wall) - ;; Time label ((ui-tile 'draw-text!) "TIME" time-label-size time-label-x time-label-y color-text) - ;; Time value ((ui-tile 'draw-text!) current-time time-value-size time-value-x time-value-y color-text) - ;; Update cache (set! cached-score current-score) (set! cached-time current-time)))) ;; draw-game-over! :: boolean -> / - ;; Shows GAME OVER when time is up. - (define (draw-game-over! time-up?) - (when (and time-up? (not cached-time-up?)) + ;; Shows GAME OVER when time is up or ghost catches Pac-Man. + (define (draw-game-over! is-over?) + (when (and is-over? (not cached-game-over?)) (let ((overlay-tile (make-tile width height))) ((overlay-layer 'add-drawable!) overlay-tile) ((overlay-tile 'draw-rectangle!) @@ -242,10 +312,9 @@ ((overlay-tile 'draw-text!) "GAME OVER" game-over-text-size game-over-text-x game-over-text-y color-game-over)) - (set! cached-time-up? #t))) + (set! cached-game-over? #t))) ;; draw-pause! :: boolean -> / - ;; Only redraws when pause state actually changes. (define (draw-pause! paused?) (when (not (eq? paused? cached-paused?)) ((overlay-layer 'empty!)) @@ -272,12 +341,12 @@ ;; ;; draw-game! :: game -> / - ;; Draws the full game. Only redraws changed elements. (define (draw-game! game) (let* ((level (game 'level)) (timer (level 'timer))) ;; Always update (lightweight sprite property sets) (draw-pacman! (level 'pacman)) + (draw-ghosts! (level 'ghosts)) ;; Only redraw when dirty / changed (draw-key! (level 'key)) (when coins-dirty? @@ -286,22 +355,19 @@ (set! coins-dirty? #f)) (draw-ui! (level 'score) timer) (draw-pause! (level 'paused?)) - (draw-game-over! ((timer 'time-up?))))) + (draw-game-over! (or ((timer 'time-up?)) (level 'game-over?))))) ;; ;; 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) (let ((level (game 'level))) ;; Static elements (drawn once) @@ -309,6 +375,8 @@ (draw-maze! (level 'maze)) (draw-coins! (level 'maze)) (init-key-position! (level 'key)) + ;; Initialize ghost positions + (draw-ghosts! (level 'ghosts)) (set! coins-dirty? #f) ;; Register draw callback ((window 'set-draw-callback!) diff --git a/pacman-project/adt/ghost.rkt b/pacman-project/adt/ghost.rkt new file mode 100644 index 0000000..8dadcc1 --- /dev/null +++ b/pacman-project/adt/ghost.rkt @@ -0,0 +1,94 @@ +#lang r7rs + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Ghost ADT ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; A ghost has a position, direction, movement mode, and type identity. +;; The targeting AI is handled by the level — this ADT only stores state. +;; Each ghost instance represents one of the four ghosts (Blinky, Inky, +;; Pinky, Clyde). Contains NO graphics code. + +(define-library (pacman-project adt ghost) + (import (scheme base) + (pacman-project adt position)) + (export make-ghost) + + (begin + + ;; make-ghost :: symbol, number, number, number, number, number -> ghost + ;; Creates a ghost of the given type at start-row/col with a scatter + ;; corner target and a house exit delay (0 = starts outside). + (define (make-ghost ghost-type start-row start-col + scatter-row scatter-col exit-delay) + (let ((position (make-position start-row start-col)) + (direction 'left) + (mode (if (= exit-delay 0) 'scatter 'in-house)) + (scatter-target (make-position scatter-row scatter-col)) + (house-timer exit-delay) + (movement-timer 0) + (reverse-queued? #f)) + + ;; direction! :: symbol -> / + (define (direction! new-dir) + (set! direction new-dir)) + + ;; mode! :: symbol -> / + ;; Sets the ghost mode. When switching between chase/scatter, + ;; the ghost must reverse direction (queued for next move). + (define (mode! new-mode) + (when (and (not (eq? mode new-mode)) + (not (eq? mode 'in-house)) + (not (eq? new-mode 'in-house))) + (set! reverse-queued? #t)) + (set! mode new-mode)) + + ;; move! :: number, number -> / + (define (move! delta-row delta-col) + ((position 'row!) (+ (position 'row) delta-row)) + ((position 'col!) (+ (position 'col) delta-col))) + + ;; consume-reverse! :: -> boolean + ;; Returns #t and clears the flag if a reverse was queued. + (define (consume-reverse!) + (if reverse-queued? + (begin (set! reverse-queued? #f) #t) + #f)) + + ;; update-house-timer! :: number -> / + ;; Decreases house timer. When it reaches 0, ghost exits. + (define (update-house-timer! delta-time) + (when (eq? mode 'in-house) + (set! house-timer (- house-timer delta-time)) + (when (<= house-timer 0) + (set! mode 'scatter)))) + + ;; reset-movement-timer! :: -> / + (define (reset-movement-timer!) + (set! movement-timer 0)) + + ;; advance-movement-timer! :: number -> number + ;; Returns updated movement timer value. + (define (advance-movement-timer! delta-time) + (set! movement-timer (+ movement-timer delta-time)) + movement-timer) + + ;; dispatch-ghost :: symbol -> any + (define (dispatch-ghost msg) + (cond ((eq? msg 'position) position) + ((eq? msg 'direction) direction) + ((eq? msg 'direction!) direction!) + ((eq? msg 'type) ghost-type) + ((eq? msg 'mode) mode) + ((eq? msg 'mode!) mode!) + ((eq? msg 'move!) move!) + ((eq? msg 'scatter-target) scatter-target) + ((eq? msg 'in-house?) (eq? mode 'in-house)) + ((eq? msg 'consume-reverse!) consume-reverse!) + ((eq? msg 'update-house-timer!) update-house-timer!) + ((eq? msg 'movement-timer) movement-timer) + ((eq? msg 'advance-movement-timer!) advance-movement-timer!) + ((eq? msg 'reset-movement-timer!) reset-movement-timer!) + (else (error "Ghost ADT -- Unknown message:" msg)))) + + dispatch-ghost)))) diff --git a/pacman-project/adt/level.rkt b/pacman-project/adt/level.rkt index db47af4..7c9bfc4 100644 --- a/pacman-project/adt/level.rkt +++ b/pacman-project/adt/level.rkt @@ -4,11 +4,13 @@ ;; Level ADT ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Contains all game logic: automatic Pac-Man movement, collision detection, -;; coin/key pickup, door opening, teleportation, pause, and time management. -;; Pac-Man moves automatically in its current direction. Arrow keys queue a -;; desired turn direction, which is applied at the next movement tick if the -;; path is clear. Contains NO graphics code. +;; Contains all game logic: automatic Pac-Man movement, ghost AI, collision +;; detection, coin/key pickup, door opening, teleportation, pause, and time +;; management. Pac-Man moves automatically in its current direction. Arrow +;; keys queue a desired turn direction, which is applied at the next movement +;; tick if the path is clear. Ghost targeting follows the original Pac-Man +;; AI: Blinky chases directly, Pinky targets ahead, Inky uses vector +;; doubling from Blinky, Clyde is shy within 8 tiles. Contains NO graphics. (define-library (pacman-project adt level) (import (scheme base) @@ -16,6 +18,7 @@ (pacman-project adt position) (pacman-project adt maze) (pacman-project adt pacman) + (pacman-project adt ghost) (pacman-project adt key) (pacman-project adt score) (pacman-project adt timer)) @@ -24,7 +27,7 @@ (begin ;; make-level :: -> level - ;; Creates a new level with all game objects. + ;; Creates a new level with all game objects including four ghosts. (define (make-level) (let ((maze (make-maze)) (pacman (make-pacman 5 2)) @@ -32,20 +35,68 @@ (score (make-score)) (timer (make-timer)) (paused? #f) + (game-over? #f) (queued-direction #f) (movement-timer 0) (on-coins-changed! (lambda () #f)) - (on-maze-changed! (lambda () #f))) + (on-maze-changed! (lambda () #f)) + (on-ghosts-changed! (lambda () #f))) ;; Initialize key after maze is created. (set! key (make-key maze)) + ;; + ;; Create four ghosts + ;; + + (define blinky + (make-ghost 'blinky + blinky-start-row blinky-start-col + blinky-scatter-row blinky-scatter-col + 0)) + + (define pinky + (make-ghost 'pinky + pinky-start-row pinky-start-col + pinky-scatter-row pinky-scatter-col + pinky-exit-delay)) + + (define inky + (make-ghost 'inky + inky-start-row inky-start-col + inky-scatter-row inky-scatter-col + inky-exit-delay)) + + (define clyde + (make-ghost 'clyde + clyde-start-row clyde-start-col + clyde-scatter-row clyde-scatter-col + clyde-exit-delay)) + + (define ghosts (list blinky pinky inky clyde)) + + ;; + ;; Ghost mode cycling + ;; + + ;; Mode schedule: alternating scatter/chase durations. + ;; After the last entry, ghosts stay in chase forever. + (define mode-schedule + (list (cons 'scatter scatter-duration-1) + (cons 'chase chase-duration-1) + (cons 'scatter scatter-duration-2) + (cons 'chase chase-duration-2) + (cons 'scatter scatter-duration-3))) + + (define current-schedule mode-schedule) + (define mode-timer (if (null? mode-schedule) 0 (cdar mode-schedule))) + (define global-mode 'scatter) + ;; ;; 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)) @@ -53,29 +104,263 @@ ((eq? direction 'down) (cons 1 0)) (else (cons 0 0)))) + ;; reverse-direction :: symbol -> symbol + (define (reverse-direction dir) + (cond ((eq? dir 'right) 'left) + ((eq? dir 'left) 'right) + ((eq? dir 'up) 'down) + ((eq? dir 'down) 'up) + (else dir))) + ;; can-move? :: symbol -> boolean - ;; Checks if Pac-Man can move in the given direction (no wall or - ;; locked door blocking the way). + ;; Checks if Pac-Man can move in the given direction. (define (can-move? direction) (let* ((delta (direction->delta direction)) (current-pos (pacman 'position)) (next-row (+ (current-pos 'row) (car delta))) (next-col (+ (current-pos 'col) (cdr delta)))) (cond - ;; Teleportation tunnels are always passable. ((or (< next-col 0) (>= next-col (maze 'cols))) #t) - ;; Walls block. (((maze 'wall?) next-row next-col) #f) - ;; Doors block unless the key has been taken. (((maze 'door?) next-row next-col) (key 'taken?)) (else #t)))) + ;; ghost-can-move? :: ghost, symbol -> boolean + ;; Checks if a ghost can move in the given direction. + ;; Active ghosts cannot re-enter the ghost house. + (define (ghost-can-move? ghost direction) + (let* ((delta (direction->delta direction)) + (pos (ghost 'position)) + (next-row (+ (pos 'row) (car delta))) + (next-col (+ (pos 'col) (cdr delta)))) + (cond + ;; Off-grid horizontally: tunnel + ((or (< next-col 0) (>= next-col (maze 'cols))) #t) + ;; Walls block + (((maze 'wall?) next-row next-col) #f) + ;; All doors block active ghosts (including ghost house door) + (((maze 'door?) next-row next-col) #f) + (else #t)))) + + ;; + ;; Distance calculation + ;; + + ;; squared-distance :: number, number, number, number -> number + (define (squared-distance r1 c1 r2 c2) + (+ (* (- r1 r2) (- r1 r2)) + (* (- c1 c2) (- c1 c2)))) + + ;; + ;; Ghost targeting AI + ;; + + ;; ghost-target :: ghost -> (number . number) + ;; Returns the target tile (row . col) for the ghost based on its + ;; current mode and type-specific AI. + (define (ghost-target ghost) + (let ((mode (ghost 'mode))) + (cond + ;; Scatter: head to assigned corner + ((eq? mode 'scatter) + (let ((st (ghost 'scatter-target))) + (cons (st 'row) (st 'col)))) + + ;; Chase: type-specific targeting + ((eq? mode 'chase) + (let* ((pac-pos (pacman 'position)) + (pac-row (pac-pos 'row)) + (pac-col (pac-pos 'col)) + (pac-dir (pacman 'direction)) + (ghost-type (ghost 'type))) + (cond + ;; Blinky: target Pac-Man directly + ((eq? ghost-type 'blinky) + (cons pac-row pac-col)) + + ;; Pinky: target 2 tiles ahead of Pac-Man + ;; Original bug: when facing up, also offset 2 left + ((eq? ghost-type 'pinky) + (let ((ahead (direction->delta pac-dir))) + (if (eq? pac-dir 'up) + (cons (+ pac-row (* (car ahead) pinky-look-ahead)) + (+ pac-col (* (cdr ahead) pinky-look-ahead) (- pinky-look-ahead))) + (cons (+ pac-row (* (car ahead) pinky-look-ahead)) + (+ pac-col (* (cdr ahead) pinky-look-ahead)))))) + + ;; Inky: double the vector from Blinky to 2-ahead-of-Pac-Man + ((eq? ghost-type 'inky) + (let* ((ahead (direction->delta pac-dir)) + (pivot-row (+ pac-row (* (car ahead) pinky-look-ahead))) + (pivot-col (+ pac-col (* (cdr ahead) pinky-look-ahead))) + (blinky-pos (blinky 'position))) + (cons (+ pivot-row (- pivot-row (blinky-pos 'row))) + (+ pivot-col (- pivot-col (blinky-pos 'col)))))) + + ;; Clyde: chase Pac-Man, but scatter when within 8 tiles + ((eq? ghost-type 'clyde) + (let* ((ghost-pos (ghost 'position)) + (dist-sq (squared-distance + (ghost-pos 'row) (ghost-pos 'col) + pac-row pac-col))) + (if (< dist-sq (* clyde-shy-distance clyde-shy-distance)) + (let ((st (ghost 'scatter-target))) + (cons (st 'row) (st 'col))) + (cons pac-row pac-col)))) + + ;; Fallback + (else (cons pac-row pac-col))))) + + ;; Default (in-house etc): stay put + (else + (let ((pos (ghost 'position))) + (cons (pos 'row) (pos 'col))))))) + + ;; choose-ghost-direction :: ghost -> symbol + ;; Picks the best direction for the ghost at its current tile. + ;; Cannot reverse; chooses direction minimizing distance to target. + ;; Tie-break order: up, left, down, right. + (define (choose-ghost-direction ghost) + (let* ((target (ghost-target ghost)) + (target-row (car target)) + (target-col (cdr target)) + (current-dir (ghost 'direction)) + (reverse-dir (reverse-direction current-dir)) + (pos (ghost 'position)) + (row (pos 'row)) + (col (pos 'col)) + (candidates '(up left down right))) + (let loop ((dirs candidates) + (best-dir current-dir) + (best-dist 999999999)) + (if (null? dirs) + ;; If no valid direction found, reverse as last resort + (if (= best-dist 999999999) reverse-dir best-dir) + (let* ((dir (car dirs)) + (delta (direction->delta dir)) + (nr (+ row (car delta))) + (nc (+ col (cdr delta)))) + (if (and (not (eq? dir reverse-dir)) + (ghost-can-move? ghost dir)) + (let ((dist (squared-distance nr nc target-row target-col))) + (if (< dist best-dist) + (loop (cdr dirs) dir dist) + (loop (cdr dirs) best-dir best-dist))) + (loop (cdr dirs) best-dir best-dist))))))) + + ;; + ;; Ghost movement + ;; + + ;; move-ghost! :: ghost -> / + ;; Moves a ghost one tile in its chosen direction. + (define (move-ghost! ghost) + (let* ((dir (ghost 'direction)) + (delta (direction->delta dir)) + (pos (ghost 'position)) + (next-row (+ (pos 'row) (car delta))) + (next-col (+ (pos 'col) (cdr delta)))) + ;; Handle tunnel teleportation + (cond + ((< next-col 0) + ((pos 'col!) (- (maze 'cols) 1))) + ((>= next-col (maze 'cols)) + ((pos 'col!) 0)) + (else + ((ghost 'move!) (car delta) (cdr delta)))))) + + ;; advance-ghost! :: ghost -> / + ;; Chooses direction and moves one ghost. + (define (advance-ghost! ghost) + (when (not (ghost 'in-house?)) + ;; Handle queued reverse from mode change + (when ((ghost 'consume-reverse!)) + ((ghost 'direction!) (reverse-direction (ghost 'direction)))) + ;; Choose best direction at current tile + (let ((new-dir (choose-ghost-direction ghost))) + ((ghost 'direction!) new-dir) + (move-ghost! ghost)) + (on-ghosts-changed!))) + + ;; exit-ghost-house! :: ghost -> / + ;; Moves a ghost from inside the house to the exit position. + (define (exit-ghost-house! ghost) + (let ((pos (ghost 'position))) + ((pos 'row!) ghost-house-exit-row) + ((pos 'col!) ghost-house-exit-col) + ((ghost 'direction!) 'left) + (on-ghosts-changed!))) + + ;; + ;; Ghost-Pacman collision + ;; + + ;; check-ghost-collision! :: -> / + ;; Checks if any ghost occupies the same tile as Pac-Man. + (define (check-ghost-collision!) + (let ((pac-pos (pacman 'position))) + (for-each + (lambda (ghost) + (when (and (not (ghost 'in-house?)) + (= ((ghost 'position) 'row) (pac-pos 'row)) + (= ((ghost 'position) 'col) (pac-pos 'col))) + (set! game-over? #t))) + ghosts))) + + ;; + ;; Mode cycling + ;; + + ;; update-ghost-mode! :: number -> / + ;; Advances the global mode timer and switches scatter/chase. + (define (update-ghost-mode! delta-time) + (when (not (null? current-schedule)) + (set! mode-timer (- mode-timer delta-time)) + (when (<= mode-timer 0) + (set! current-schedule (cdr current-schedule)) + (if (null? current-schedule) + ;; Permanent chase after schedule ends + (begin + (set! global-mode 'chase) + (for-each (lambda (g) ((g 'mode!) 'chase)) ghosts)) + (let ((next-mode (caar current-schedule)) + (next-duration (cdar current-schedule))) + (set! global-mode next-mode) + (set! mode-timer next-duration) + (for-each (lambda (g) + (when (not (g 'in-house?)) + ((g 'mode!) next-mode))) + ghosts)))))) + + ;; + ;; Update ghosts + ;; + + ;; update-ghosts! :: number -> / + ;; Updates all ghost timers, house exits, and movement. + (define (update-ghosts! delta-time) + (for-each + (lambda (ghost) + ;; Update house timer for ghosts still inside + (let ((was-in-house? (ghost 'in-house?))) + ((ghost 'update-house-timer!) delta-time) + ;; Ghost just exited house + (when (and was-in-house? (not (ghost 'in-house?))) + (exit-ghost-house! ghost) + ((ghost 'mode!) global-mode))) + ;; Movement tick for active ghosts + (when (not (ghost 'in-house?)) + (let ((mt ((ghost 'advance-movement-timer!) delta-time))) + (when (>= mt ghost-speed-ms) + (advance-ghost! ghost) + ((ghost 'reset-movement-timer!)))))) + ghosts)) + ;; ;; 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!)) @@ -87,7 +372,6 @@ ;; ;; 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!)) @@ -98,7 +382,6 @@ ;; ;; 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) @@ -113,8 +396,6 @@ ;; ;; move-pacman! :: symbol -> / - ;; Moves Pac-Man one step in the given direction, handling collisions, - ;; teleportation, and item pickup. (define (move-pacman! direction) (let* ((delta (direction->delta direction)) (delta-row (car delta)) @@ -123,25 +404,20 @@ (next-row (+ (current-pos 'row) delta-row)) (next-col (+ (current-pos 'col) delta-col))) - ;; Update facing 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: open it if key has been taken. (((maze 'door?) next-row next-col) (when (key 'taken?) ((maze 'remove-door!) next-row next-col) - (on-maze-changed!))) + (on-maze-changed!))) - ;; 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)) @@ -149,17 +425,13 @@ (eat-coin! next-row next-col)))))))) ;; advance-pacman! :: -> / - ;; Called every movement tick. Tries the queued direction first; if - ;; that path is blocked, continues in the current direction. (define (advance-pacman!) - (when (not ((timer 'time-up?))) + (when (not (or ((timer 'time-up?)) game-over?)) (let ((current-dir (pacman 'direction))) - ;; Try the queued direction first. (cond ((and queued-direction (can-move? queued-direction)) (move-pacman! queued-direction) (set! queued-direction #f)) - ;; Otherwise keep moving in the current direction. ((can-move? current-dir) (move-pacman! current-dir)))))) @@ -167,7 +439,6 @@ ;; Pause logic ;; - ;; toggle-pause! :: -> / (define (toggle-pause!) (set! paused? (not paused?))) @@ -176,7 +447,6 @@ ;; ;; key-press! :: symbol -> / - ;; Processes a key press. Arrow keys queue a desired direction. (define (key-press! pressed-key) (cond ((eq? pressed-key 'escape) (toggle-pause!)) @@ -188,45 +458,55 @@ ((eq? pressed-key 'down) (set! queued-direction 'down)))))) ;; - ;; Update (game loop function) + ;; Update (game loop) ;; ;; update! :: number -> / - ;; Called each frame with elapsed milliseconds. Advances the movement - ;; timer and moves Pac-Man automatically when the interval elapses. (define (update! delta-time) - (when (not paused?) + (when (not (or paused? game-over?)) ((timer 'decrease!) delta-time) + ;; Pac-Man movement (set! movement-timer (+ movement-timer delta-time)) (when (>= movement-timer pacman-speed-ms) (advance-pacman!) - (set! movement-timer 0)))) + (set! movement-timer 0) + (check-ghost-collision!)) + ;; Ghost mode cycling and movement + (update-ghost-mode! delta-time) + (update-ghosts! delta-time) + (check-ghost-collision!))) + + ;; + ;; Callbacks + ;; + + (define (set-on-coins-changed! callback) + (set! on-coins-changed! callback)) + + (define (set-on-maze-changed! callback) + (set! on-maze-changed! callback)) + + (define (set-on-ghosts-changed! callback) + (set! on-ghosts-changed! callback)) ;; ;; Dispatch ;; - ;; set-on-coins-changed! :: (-> /) -> / - ;; Registers a callback for when coins change (eaten or key picked up). - (define (set-on-coins-changed! callback) - (set! on-coins-changed! callback)) - - ;; set-on-maze-changed! :: (-> /) -> / - ;; Registers a callback for when the maze changes (door removed). - (define (set-on-maze-changed! callback) - (set! on-maze-changed! callback)) - (define (dispatch-level msg) (cond ((eq? msg 'maze) maze) ((eq? msg 'pacman) pacman) + ((eq? msg 'ghosts) ghosts) ((eq? msg 'key) key) ((eq? msg 'score) score) ((eq? msg 'timer) timer) ((eq? msg 'paused?) paused?) + ((eq? msg 'game-over?) game-over?) ((eq? msg 'key-press!) key-press!) ((eq? msg 'update!) update!) ((eq? msg 'set-on-coins-changed!) set-on-coins-changed!) ((eq? msg 'set-on-maze-changed!) set-on-maze-changed!) + ((eq? msg 'set-on-ghosts-changed!) set-on-ghosts-changed!) (else (error "Level ADT -- Unknown message:" msg)))) dispatch-level)))) diff --git a/pacman-project/constants.rkt b/pacman-project/constants.rkt index dbe8022..2e91832 100644 --- a/pacman-project/constants.rkt +++ b/pacman-project/constants.rkt @@ -33,9 +33,54 @@ sprite-scale-pacman sprite-scale-key sprite-scale-key-ui + sprite-scale-ghost ;; Movement pacman-speed-ms + ghost-speed-ms + + ;; Ghost house + ghost-house-door-row + ghost-house-door-col-left + ghost-house-door-col-right + ghost-house-exit-row + ghost-house-exit-col + + ;; Ghost start positions + blinky-start-row + blinky-start-col + pinky-start-row + pinky-start-col + inky-start-row + inky-start-col + clyde-start-row + clyde-start-col + + ;; Ghost scatter corners + blinky-scatter-row + blinky-scatter-col + pinky-scatter-row + pinky-scatter-col + inky-scatter-row + inky-scatter-col + clyde-scatter-row + clyde-scatter-col + + ;; Ghost house exit delays (ms) + pinky-exit-delay + inky-exit-delay + clyde-exit-delay + + ;; Ghost mode durations (ms) + scatter-duration-1 + chase-duration-1 + scatter-duration-2 + chase-duration-2 + scatter-duration-3 + + ;; Ghost AI + clyde-shy-distance + pinky-look-ahead ;; Animation animation-interval-ms @@ -123,9 +168,54 @@ (define sprite-scale-pacman 1.5) (define sprite-scale-key 1.5) (define sprite-scale-key-ui 3) + (define sprite-scale-ghost 1.5) ;; Movement speed: time between automatic movement ticks (define pacman-speed-ms 200) + (define ghost-speed-ms 220) + + ;; Ghost house position (door and exit point above door) + (define ghost-house-door-row 12) + (define ghost-house-door-col-left 13) + (define ghost-house-door-col-right 14) + (define ghost-house-exit-row 11) + (define ghost-house-exit-col 14) + + ;; Ghost start positions + (define blinky-start-row 11) + (define blinky-start-col 14) + (define pinky-start-row 14) + (define pinky-start-col 13) + (define inky-start-row 14) + (define inky-start-col 11) + (define clyde-start-row 14) + (define clyde-start-col 16) + + ;; Ghost scatter target corners + (define blinky-scatter-row 0) + (define blinky-scatter-col 27) + (define pinky-scatter-row 0) + (define pinky-scatter-col 0) + (define inky-scatter-row 30) + (define inky-scatter-col 27) + (define clyde-scatter-row 30) + (define clyde-scatter-col 0) + + ;; Ghost house exit delays (ms) — staggered release + (define pinky-exit-delay 2000) + (define inky-exit-delay 5000) + (define clyde-exit-delay 8000) + + ;; Ghost mode durations (ms) — scatter/chase alternation + (define scatter-duration-1 7000) + (define chase-duration-1 20000) + (define scatter-duration-2 7000) + (define chase-duration-2 20000) + (define scatter-duration-3 5000) + + ;; Ghost AI parameters + (define clyde-shy-distance 8) + (define pinky-look-ahead 2) ;; Animation timing (define animation-interval-ms 100) diff --git a/pacman-project/tests/all-tests.rkt b/pacman-project/tests/all-tests.rkt index 2efb134..70df01a 100644 --- a/pacman-project/tests/all-tests.rkt +++ b/pacman-project/tests/all-tests.rkt @@ -11,6 +11,7 @@ (prefix (pacman-project tests test-position) position:) (prefix (pacman-project tests test-maze) maze:) (prefix (pacman-project tests test-pacman) pacman:) + (prefix (pacman-project tests test-ghost) ghost:) (prefix (pacman-project tests test-score) score:) (prefix (pacman-project tests test-timer) timer:)) @@ -18,6 +19,7 @@ (position:test) (maze:test) (pacman:test) + (ghost:test) (score:test) (timer:test)) diff --git a/pacman-project/tests/test-ghost.rkt b/pacman-project/tests/test-ghost.rkt new file mode 100644 index 0000000..09d9a4f --- /dev/null +++ b/pacman-project/tests/test-ghost.rkt @@ -0,0 +1,97 @@ +#lang r7rs + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests: Ghost ADT ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-library (pacman-project tests test-ghost) + (import (scheme base) + (pp1 tests) + (pacman-project adt ghost)) + (export test) + + (begin + + ;; Test creation and initial state + (define (test-creation) + (define g (make-ghost 'blinky 11 14 0 27 0)) + (define pos (g 'position)) + (check-eq? (pos 'row) 11 "Start row should be 11") + (check-eq? (pos 'col) 14 "Start col should be 14") + (check-eq? (g 'type) 'blinky "Type should be blinky") + (check-eq? (g 'direction) 'left "Default direction should be left")) + + ;; Test that exit-delay 0 means ghost starts outside (scatter mode) + (define (test-blinky-starts-active) + (define g (make-ghost 'blinky 11 14 0 27 0)) + (check-eq? (g 'in-house?) #f "Blinky should start outside") + (check-eq? (g 'mode) 'scatter "Blinky should start in scatter")) + + ;; Test that non-zero exit-delay means ghost starts in house + (define (test-pinky-starts-in-house) + (define g (make-ghost 'pinky 14 13 0 0 2000)) + (check-eq? (g 'in-house?) #t "Pinky should start in house") + (check-eq? (g 'mode) 'in-house "Pinky mode should be in-house")) + + ;; Test direction change + (define (test-direction) + (define g (make-ghost 'blinky 11 14 0 27 0)) + ((g 'direction!) 'right) + (check-eq? (g 'direction) 'right "Direction should be right")) + + ;; Test mode change and reverse queuing + (define (test-mode-change-queues-reverse) + (define g (make-ghost 'blinky 11 14 0 27 0)) + ((g 'mode!) 'chase) + (check-eq? (g 'mode) 'chase "Mode should be chase") + (check-eq? ((g 'consume-reverse!)) #t "Reverse should be queued after mode change")) + + ;; Test reverse consumed only once + (define (test-consume-reverse-once) + (define g (make-ghost 'blinky 11 14 0 27 0)) + ((g 'mode!) 'chase) + ((g 'consume-reverse!)) + (check-eq? ((g 'consume-reverse!)) #f "Reverse should be consumed after first call")) + + ;; Test move + (define (test-move) + (define g (make-ghost 'blinky 11 14 0 27 0)) + ((g 'move!) 0 -1) + (define pos (g 'position)) + (check-eq? (pos 'col) 13 "Col should be 13 after move left")) + + ;; Test scatter target + (define (test-scatter-target) + (define g (make-ghost 'blinky 11 14 0 27 0)) + (define st (g 'scatter-target)) + (check-eq? (st 'row) 0 "Scatter target row should be 0") + (check-eq? (st 'col) 27 "Scatter target col should be 27")) + + ;; Test house timer expiry + (define (test-house-exit) + (define g (make-ghost 'pinky 14 13 0 0 2000)) + ((g 'update-house-timer!) 1000) + (check-eq? (g 'in-house?) #t "Still in house after 1000ms") + ((g 'update-house-timer!) 1000) + (check-eq? (g 'in-house?) #f "Should exit house after 2000ms") + (check-eq? (g 'mode) 'scatter "Should be in scatter after exiting")) + + ;; Test movement timer + (define (test-movement-timer) + (define g (make-ghost 'blinky 11 14 0 27 0)) + (check-eq? ((g 'advance-movement-timer!) 100) 100 "Timer should be 100") + (check-eq? ((g 'advance-movement-timer!) 120) 220 "Timer should be 220") + ((g 'reset-movement-timer!)) + (check-eq? (g 'movement-timer) 0 "Timer should reset to 0")) + + (define (test) + (run-test test-creation "Ghost: creation and initial state") + (run-test test-blinky-starts-active "Ghost: Blinky starts active") + (run-test test-pinky-starts-in-house "Ghost: Pinky starts in house") + (run-test test-direction "Ghost: direction change") + (run-test test-mode-change-queues-reverse "Ghost: mode change queues reverse") + (run-test test-consume-reverse-once "Ghost: consume reverse only once") + (run-test test-move "Ghost: move") + (run-test test-scatter-target "Ghost: scatter target") + (run-test test-house-exit "Ghost: house timer exit") + (run-test test-movement-timer "Ghost: movement timer"))))