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.
;;
;; Performance: coins, UI, maze, key, and pause are only redrawn when their
;; underlying state changes. The draw callback tracks previous values and
;; skips unchanged elements.

(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 "PAC-MAN")))

        ((window 'set-background!) color-background)

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

        (define header-layer ((window 'new-layer!)))
        (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!)))

        ;;
        ;; Header bar — static, drawn once
        ;;

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

        ;; draw-header! :: -> /
        (define (draw-header!)
          ((header-tile 'draw-rectangle!) 0 0 width header-height color-header-bg)
          ((header-tile 'draw-text!)
           "PAC-MAN" header-title-size header-title-x header-title-y color-title))

        ;;
        ;; Maze tile
        ;;

        (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 (shown in header when taken)
        (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)

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

        (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 tile (score + time — redrawn on change)
        ;;

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

        ;;
        ;; Change tracking — skip redraws when state hasn't changed
        ;;

        (define cached-score -1)
        (define cached-time "")
        (define key-sprite-swapped? #f)
        (define cached-paused? #f)
        (define cached-game-over? #f)
        (define coins-dirty? #t)

        ;;
        ;; Draw functions
        ;;

        ;; draw-maze! :: maze -> /
        (define (draw-maze! maze)
          ((maze-tile 'clear!))
          ((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)
                 color-wall))
               ((= 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)
                 color-door))))))

        ;; draw-coins! :: 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-ellipse!)
                (+ (grid->pixel-x col) coin-inset)
                (+ (grid->pixel-y row) coin-inset)
                coin-size
                coin-size
                color-coin)))))

        ;; init-key-position! :: key -> /
        (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 -> /
        (define (draw-key! key-obj)
          (when (and (key-obj 'taken?) (not key-sprite-swapped?))
            ((key-layer 'remove-drawable!) key-sprite)
            ((key-layer 'add-drawable!) key-ui-sprite)
            (set! key-sprite-swapped? #t)))

        ;; animate-pacman! :: number -> /
        (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)))

        ;; lerp :: number, number, number -> number
        ;; Linear interpolation between a and b by factor t (0..1).
        (define (lerp a b t)
          (+ a (* t (- b a))))

        ;; draw-pacman! :: pacman, number -> /
        ;; Draws Pac-Man with smooth interpolation between tiles.
        (define (draw-pacman! pacman progress)
          (let* ((pos (pacman 'position))
                 (row (pos 'row))
                 (col (pos 'col))
                 (prev-row (pacman 'prev-row))
                 (prev-col (pacman 'prev-col))
                 (t (min progress 1))
                 (render-col (lerp prev-col col t))
                 (render-row (lerp prev-row row t))
                 (direction (pacman 'direction)))
            ((pacman-sprite 'set-x!) (grid->pixel-x render-col))
            ((pacman-sprite 'set-y!) (grid->pixel-y render-row))
            (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)))))

        ;; draw-ghosts! :: list -> /
        ;; Updates all ghost sprite positions with smooth interpolation.
        (define (draw-ghosts! ghosts)
          (for-each
           (lambda (ghost ghost-draw)
             (let* ((pos (ghost 'position))
                    (row (pos 'row))
                    (col (pos 'col))
                    (prev-row (ghost 'prev-row))
                    (prev-col (ghost 'prev-col))
                    (t (min (/ (ghost 'movement-timer) ghost-speed-ms) 1))
                    (render-row (lerp prev-row row t))
                    (render-col (lerp prev-col col t))
                    (dir (ghost 'direction)))
               ((ghost-draw 'update!) render-row render-col dir)))
           ghosts ghost-draw-states))

        ;; draw-ui! :: score, timer -> /
        (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!))
              ((ui-tile 'draw-text!)
               "SCORE" score-label-size score-label-x score-label-y color-text)
              ((ui-tile 'draw-text!)
               (number->string current-score)
               score-value-size score-value-x score-value-y color-text)
              ((ui-tile 'draw-rectangle!)
               sidebar-x 0 sidebar-width height color-wall)
              ((ui-tile 'draw-text!)
               "TIME" time-label-size time-label-x time-label-y color-text)
              ((ui-tile 'draw-text!)
               current-time
               time-value-size time-value-x time-value-y color-text)
              (set! cached-score current-score)
              (set! cached-time current-time))))

        ;; draw-game-over! :: boolean -> /
        ;; 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!)
               0 (- game-over-text-y 20) 672 100 color-background)
              ((overlay-tile 'draw-text!)
               "GAME  OVER" game-over-text-size
               game-over-text-x game-over-text-y color-game-over))
            (set! cached-game-over? #t)))

        ;; draw-pause! :: boolean -> /
        (define (draw-pause! paused?)
          (when (not (eq? paused? cached-paused?))
            ((overlay-layer 'empty!))
            (when paused?
              (let ((overlay-tile (make-tile width height)))
                ((overlay-layer 'add-drawable!) overlay-tile)
                ((overlay-tile 'draw-rectangle!)
                 0 maze-offset-y 672 (- height maze-offset-y) color-pause-bg)
                ((overlay-tile 'draw-text!)
                 "PAUSED" pause-text-size
                 pause-text-x pause-text-y color-pause-text)))
            (set! cached-paused? paused?)))

        ;; mark-coins-dirty! :: -> /
        (define (mark-coins-dirty!)
          (set! coins-dirty? #t))

        ;; mark-maze-dirty! :: -> /
        (define (mark-maze-dirty!)
          (set! coins-dirty? #t))

        ;;
        ;; Main draw function
        ;;

        ;; draw-game! :: game -> /
        (define (draw-game! game)
          (let* ((level (game 'level))
                 (timer (level 'timer))
                 (pac-progress (/ (level 'pacman-movement-timer) pacman-speed-ms)))
            ;; Always update (lightweight sprite property sets)
            (draw-pacman! (level 'pacman) pac-progress)
            (draw-ghosts! (level 'ghosts))
            ;; Only redraw when dirty / changed
            (draw-key! (level 'key))
            (when coins-dirty?
              (draw-coins! (level 'maze))
              (draw-maze! (level 'maze))
              (set! coins-dirty? #f))
            (draw-ui! (level 'score) timer)
            (draw-pause! (level 'paused?))
            (draw-game-over! (or ((timer 'time-up?)) (level 'game-over?)))))

        ;;
        ;; Callback registration
        ;;

        (define (set-game-loop! fun)
          ((window 'set-update-callback!) fun))

        (define (set-key-callback! fun)
          ((window 'set-key-callback!) fun))

        ;; start-drawing! :: game -> /
        (define (start-drawing! game)
          (let ((level (game 'level)))
            ;; Static elements (drawn once)
            (draw-header!)
            (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!)
             (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!)
                ((eq? msg 'animate-pacman!) animate-pacman!)
                ((eq? msg 'mark-coins-dirty!) mark-coins-dirty!)
                ((eq? msg 'mark-maze-dirty!) mark-maze-dirty!)
                (else (error "Draw ADT -- Unknown message:" msg))))

        dispatch-draw))))