420 lines
16 KiB
Racket
420 lines
16 KiB
Racket
#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 backward interpolation. Uses
|
|
;; lerp(prev, current, t) so the visual smoothly transitions
|
|
;; from the previous tile strictly to the current tile by t=1.
|
|
(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 (max 0 (min progress 1)))
|
|
(render-row (lerp prev-row row t))
|
|
(render-col (lerp prev-col col 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 backward 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 (max 0 (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))))
|