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

#lang r7rs

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                Draw ADT                                   ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; All graphics logic is isolated in this ADT. Game logic knows nothing about
;; pixels, windows, or sprites. Grid-to-pixel conversion happens exclusively
;; here.

(define-library (pacman-project adt-draw)
  (import (scheme base)
          (pp1 graphics)
          (pacman-project constants))
  (export make-draw)

  (begin

    ;; make-draw :: number, number -> draw
    ;; Creates the draw object that handles all rendering.
    (define (make-draw width height)
      (let ((window (make-window width height "Pacman")))

        ((window 'set-background!) "black")

        ;;
        ;; Layers (order determines draw order)
        ;;

        (define maze-layer ((window 'new-layer!)))
        (define coins-layer ((window 'new-layer!)))
        (define key-layer ((window 'new-layer!)))
        (define pacman-layer ((window 'new-layer!)))
        (define ui-layer ((window 'new-layer!)))
        (define pause-layer ((window 'new-layer!)))

        ;;
        ;; Maze tiles
        ;;

        (define maze-tile (make-tile width height))
        ((maze-layer 'add-drawable!) maze-tile)

        ;;
        ;; Coins tile
        ;;

        (define coins-tile (make-tile width height))
        ((coins-layer 'add-drawable!) coins-tile)

        ;;
        ;; Key sprite (in the maze)
        ;;

        (define key-sprite (make-bitmap-tile "pacman-sprites/key.png"))
        ((key-sprite 'set-scale!) sprite-scale-key)
        ((key-layer 'add-drawable!) key-sprite)

        ;; Key UI indicator (next to the score)
        (define key-ui-sprite (make-bitmap-tile "pacman-sprites/key.png"))
        ((key-ui-sprite 'set-scale!) sprite-scale-key-ui)
        ((key-ui-sprite 'set-x!) key-ui-x)
        ((key-ui-sprite 'set-y!) key-ui-y)

        ;;
        ;; Pac-Man sprite
        ;;

        (define pacman-bitmap-tiles
          (list (make-bitmap-tile "pacman-sprites/pacman-death-1.png")
                (make-bitmap-tile "pacman-sprites/pacman-closed.png")
                (make-bitmap-tile "pacman-sprites/pacman-open.png")))

        (define pacman-sprite (make-tile-sequence pacman-bitmap-tiles))
        ((pacman-sprite 'set-scale!) sprite-scale-pacman)
        ((pacman-layer 'add-drawable!) pacman-sprite)

        ;; Animation state
        (define time-since-last-animation 0)

        ;;
        ;; UI tiles
        ;;

        (define ui-tile (make-tile width height))
        ((ui-layer 'add-drawable!) ui-tile)

        ;;
        ;; 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 'for-each-cell)
           (lambda (row col cell-type)
             (cond
               ((= cell-type cell-type-wall)
                ((maze-tile 'draw-rectangle!)
                 (grid->pixel-x col)
                 (grid->pixel-y row)
                 (- cell-size-px maze-wall-shrink)
                 (- cell-size-px maze-wall-shrink)
                 "blue"))
               ((= cell-type cell-type-door)
                ((maze-tile 'draw-rectangle!)
                 (grid->pixel-x col)
                 (grid->pixel-y row)
                 (- cell-size-px maze-wall-shrink)
                 (- cell-size-px maze-wall-shrink)
                 "pink"))))))

        ;; draw-coins! :: maze -> /
        ;; Draws all coins in the maze.
        (define (draw-coins! maze)
          ((coins-tile 'clear!))
          ((maze 'for-each-cell)
           (lambda (row col cell-type)
             (when (= cell-type cell-type-coin)
               ((coins-tile 'draw-rectangle!)
                (+ (grid->pixel-x col) coin-inset)
                (+ (grid->pixel-y row) coin-inset)
                (- cell-size-px (* 2 coin-inset) 6)
                (- cell-size-px (* 2 coin-inset) 6)
                "yellow")))))

        ;; draw-key! :: key -> /
        ;; Draws the key at its position, or shows it in UI if taken.
        (define (draw-key! key-obj)
          (if (key-obj 'taken?)
              (begin
                ((key-layer 'remove-drawable!) key-sprite)
                ((key-layer 'add-drawable!) key-ui-sprite))
              (let ((pos (key-obj 'position)))
                ((key-sprite 'set-x!) (grid->pixel-x (pos 'col)))
                ((key-sprite 'set-y!) (grid->pixel-y (pos 'row))))))

        ;; draw-pacman! :: pacman, number -> /
        ;; Draws Pac-Man at its current position with correct rotation.
        (define (draw-pacman! pacman delta-time)
          (let* ((pos (pacman 'position))
                 (direction (pacman 'direction)))
            ;; Set position
            ((pacman-sprite 'set-x!) (grid->pixel-x (pos 'col)))
            ((pacman-sprite 'set-y!) (grid->pixel-y (pos 'row)))
            ;; Set rotation based on direction
            (cond ((eq? direction 'right) ((pacman-sprite 'rotate!) rotation-right))
                  ((eq? direction 'left) ((pacman-sprite 'rotate!) rotation-left))
                  ((eq? direction 'up) ((pacman-sprite 'rotate!) rotation-up))
                  ((eq? direction 'down) ((pacman-sprite 'rotate!) rotation-down)))
            ;; Animation
            (set! time-since-last-animation (+ time-since-last-animation delta-time))
            (when (>= time-since-last-animation animation-interval-ms)
              ((pacman-sprite 'set-next!))
              (set! time-since-last-animation 0))))

        ;; draw-ui! :: score, timer -> /
        ;; Draws the score and time limit on screen.
        (define (draw-ui! score timer)
          ((ui-tile 'clear!))
          ;; Score
          ((ui-tile 'draw-text!)
           (number->string (score 'points))
           score-text-size score-text-x score-text-y "white")
          ;; Separator line
          ((ui-tile 'draw-rectangle!)
           separator-x 0 separator-width height "white")
          ;; Time limit
          ((ui-tile 'draw-text!)
           "Time remaining:" time-text-size time-label-x time-label-y "white")
          ((ui-tile 'draw-text!)
           ((timer 'format-time))
           score-text-size time-value-x time-value-y "white"))

        ;; draw-pause! :: boolean -> /
        ;; Shows or hides the pause screen.
        (define (draw-pause! paused?)
          ((pause-layer 'empty!))
          (when paused?
            (let ((pause-tile (make-tile width height)))
              ((pause-layer 'add-drawable!) pause-tile)
              ((pause-tile 'draw-rectangle!) 0 90 670 height "black")
              ((pause-tile 'draw-text!) "Game Paused" 40 200 400 "red"))))

        ;; redraw-maze! :: maze -> /
        ;; Redraws the maze (after door removal).
        (define (redraw-maze! maze)
          ((maze-tile 'clear!))
          (draw-maze! maze))

        ;;
        ;; Main draw function
        ;;

        ;; draw-game! :: game -> /
        ;; Draws the full game (registered as draw callback).
        (define (draw-game! game)
          (let ((level (game 'level)))
            (draw-pacman! (level 'pacman) 0)
            (draw-key! (level 'key))
            (draw-coins! (level 'maze))
            (draw-ui! (level 'score) (level 'timer))
            (draw-pause! (level 'paused?))))

        ;;
        ;; 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)
          ;; Initial maze and coins draw (one-time)
          (draw-maze! ((game 'level) 'maze))
          (draw-coins! ((game 'level) 'maze))
          ((window 'set-draw-callback!)
           (lambda () (draw-game! game))))

        ;;
        ;; Dispatch
        ;;

        (define (dispatch-draw msg)
          (cond ((eq? msg 'set-game-loop!) set-game-loop!)
                ((eq? msg 'set-key-callback!) set-key-callback!)
                ((eq? msg 'start-drawing!) start-drawing!)
                (else (error "Draw ADT -- Unknown message:" msg))))

        dispatch-draw))))