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

#lang r7rs

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                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.

(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)
            (queued-direction #f)
            (movement-timer 0)
            (on-coins-changed! (lambda () #f))
            (on-maze-changed! (lambda () #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))))

        ;; can-move? :: symbol -> boolean
        ;; Checks if Pac-Man can move in the given direction (no wall or
        ;; locked door blocking the way).
        (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))))

        ;;
        ;; 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!))
          (on-coins-changed!))

        ;;
        ;; 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!))
          (on-coins-changed!))

        ;;
        ;; 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 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))
                 (delta-col (cdr delta))
                 (current-pos (pacman 'position))
                 (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!)))

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

        ;; 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?)))
            (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))))))

        ;;
        ;; Pause logic
        ;;

        ;; toggle-pause! :: -> /
        (define (toggle-pause!)
          (set! paused? (not paused?)))

        ;;
        ;; Key handling
        ;;

        ;; 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!))
            ((not paused?)
             (cond
               ((eq? pressed-key 'right) (set! queued-direction 'right))
               ((eq? pressed-key 'left) (set! queued-direction 'left))
               ((eq? pressed-key 'up) (set! queued-direction 'up))
               ((eq? pressed-key 'down) (set! queued-direction 'down))))))

        ;;
        ;; Update (game loop function)
        ;;

        ;; 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?)
            ((timer 'decrease!) delta-time)
            (set! movement-timer (+ movement-timer delta-time))
            (when (>= movement-timer pacman-speed-ms)
              (advance-pacman!)
              (set! movement-timer 0))))

        ;;
        ;; 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 'key) key)
                ((eq? msg 'score) score)
                ((eq? msg 'timer) timer)
                ((eq? msg 'paused?) paused?)
                ((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!)
                (else (error "Level ADT -- Unknown message:" msg))))

        dispatch-level))))