#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)))))) ;; animate-pacman! :: number -> / ;; Advances the Pac-Man sprite animation based on elapsed time. (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!)) (set! time-since-last-animation 0))) ;; draw-pacman! :: pacman -> / ;; Draws Pac-Man at its current position with correct rotation. (define (draw-pacman! pacman) (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))))) ;; 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")))) ;; ;; 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)) (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!) ((eq? msg 'animate-pacman!) animate-pacman!) (else (error "Draw ADT -- Unknown message:" msg)))) dispatch-draw))))