Joren/Pacman-Project
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add ghost CPUs with original Pac-Man AI targeting

Browse Source 
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 <noreply@anthropic.com>
This commit is contained in:
joren
2026-03-23 11:42:34 +01:00
parent 91b548e0bf
commit 9028dd031c
6 changed files with 714 additions and 83 deletions
Download Patch File Download Diff File Expand all files Collapse all files

142
pacman-project/adt/draw.rkt
View File

@@ -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!)

94
pacman-project/adt/ghost.rkt Normal file
View File

@@ -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))))

372
pacman-project/adt/level.rkt
View File

@@ -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))))