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