Pacman-Project/pacman-project/adt/level.rkt

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