Joren/Pacman-Project
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Refactor(English): Rename all files and identifiers from Dutch to English

Browse Source 
Renamed files: constanten→constants, adt-positie→adt-position,
adt-doolhof→adt-maze, adt-sleutel→adt-key, adt-tijdslimiet→adt-timer,
adt-teken→adt-draw, adt-spel→adt-game. All message names, variables,
comments, and tests converted to English.

Also fixed counter location bug (time-label x/y were swapped).

Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
This commit is contained in:
joren
2026-03-23 11:06:32 +01:00
parent c3c3c6e86c
commit cd70055bc7
45 changed files with 1936 additions and 1136 deletions
Download Patch File Download Diff File Expand all files Collapse all files

118
pacman-project/adt-doolhof.rkt
View File

@@ -1,118 +0,0 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Doolhof ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Het doolhof bevat het logische grid met cellen. Elke cel heeft een type
;; (muur, muntje, leeg, sleutel, deur). Dit ADT bevat GEEN grafische code.
(define-library (pacman-project adt-doolhof)
(import (scheme base)
(pacman-project constanten))
(export maak-doolhof)
(begin
;; maak-doolhof :: -> doolhof
;; Maakt een nieuw doolhof-object aan met het volledige grid.
(define (maak-doolhof)
;; Het doolhof grid: 31 rijen x 28 kolommen.
;; vector wordt gebruikt omdat het mutable is (i.t.t. #()).
(define grid
(vector (vector 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(vector 1 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 1)
(vector 1 0 1 1 1 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 1)
(vector 1 0 1 0 0 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 1)
(vector 1 0 1 4 1 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 1)
(vector 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1)
(vector 1 0 1 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 1 0 1)
(vector 1 0 1 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 1 0 1)
(vector 1 0 0 0 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 0 0 1)
(vector 1 1 1 1 1 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 1 1 1 1 1 1)
(vector 2 2 2 2 2 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 1 2 2 2 2 2)
(vector 2 2 2 2 2 1 0 1 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 2 2 2 2 2)
(vector 2 2 2 2 2 1 0 1 1 0 1 1 1 4 4 1 1 1 0 1 1 0 1 2 2 2 2 2)
(vector 1 1 1 1 1 1 0 1 1 0 1 2 2 2 2 2 2 1 0 1 1 0 1 1 1 1 1 1)
(vector 2 0 0 0 0 0 0 0 0 0 1 2 2 2 2 2 2 1 0 0 0 0 0 0 0 0 0 2)
(vector 1 1 1 1 1 1 0 1 1 0 1 2 2 2 2 2 2 1 0 1 1 0 1 1 1 1 1 1)
(vector 2 2 2 2 2 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 2 2 2 2 2)
(vector 2 2 2 2 2 1 0 1 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 2 2 2 2 2)
(vector 2 2 2 2 2 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 2 2 2 2 2)
(vector 1 1 1 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 1 1 1)
(vector 1 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 1)
(vector 1 0 1 1 1 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 1)
(vector 1 0 1 1 1 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 1)
(vector 1 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 1)
(vector 1 1 1 0 1 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 0 1 1 1)
(vector 1 1 1 0 1 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 0 1 1 1)
(vector 1 0 0 0 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 4 1 0 0 0 0 0 0 1)
(vector 1 0 1 1 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 0 0 1 1 1 1 1 0 1)
(vector 1 0 1 1 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 1 1 0 1)
(vector 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1)
(vector 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)))
(define aantal-rijen (vector-length grid))
(define aantal-kolommen (vector-length (vector-ref grid 0)))
;; cel-ref :: number, number -> number
;; Geeft het celtype terug op de opgegeven positie.
(define (cel-ref rij kolom)
(vector-ref (vector-ref grid rij) kolom))
;; cel-set! :: number, number, number -> /
;; Past het celtype aan op de opgegeven positie.
(define (cel-set! rij kolom waarde)
(vector-set! (vector-ref grid rij) kolom waarde))
;; muur? :: number, number -> boolean
(define (muur? rij kolom)
(= (cel-ref rij kolom) cel-type-muur))
;; muntje? :: number, number -> boolean
(define (muntje? rij kolom)
(= (cel-ref rij kolom) cel-type-muntje))
;; leeg? :: number, number -> boolean
(define (leeg? rij kolom)
(= (cel-ref rij kolom) cel-type-leeg))
;; sleutel? :: number, number -> boolean
(define (sleutel? rij kolom)
(= (cel-ref rij kolom) cel-type-sleutel))
;; deur? :: number, number -> boolean
(define (deur? rij kolom)
(= (cel-ref rij kolom) cel-type-deur))
;; verwijder-deur! :: number, number -> /
;; Verwijdert een deur uit het grid (maakt de cel leeg).
(define (verwijder-deur! rij kolom)
(cel-set! rij kolom cel-type-leeg))
;; voor-elke-cel :: (number, number, number -> /) -> /
;; Itereert over alle cellen en roept de callback op met rij, kolom en celtype.
(define (voor-elke-cel callback)
(do ((rij 0 (+ rij 1)))
((= rij aantal-rijen))
(do ((kolom 0 (+ kolom 1)))
((= kolom aantal-kolommen))
(callback rij kolom (cel-ref rij kolom)))))
;; dispatch-doolhof :: symbol -> any
(define (dispatch-doolhof msg)
(cond ((eq? msg 'rijen) aantal-rijen)
((eq? msg 'kolommen) aantal-kolommen)
((eq? msg 'cel-ref) cel-ref)
((eq? msg 'cel-set!) cel-set!)
((eq? msg 'muur?) muur?)
((eq? msg 'muntje?) muntje?)
((eq? msg 'leeg?) leeg?)
((eq? msg 'sleutel?) sleutel?)
((eq? msg 'deur?) deur?)
((eq? msg 'verwijder-deur!) verwijder-deur!)
((eq? msg 'voor-elke-cel) voor-elke-cel)
(else (error "Doolhof ADT -- Onbekend bericht:" msg))))
dispatch-doolhof)))

248
pacman-project/adt-draw.rkt Normal file
View File

@@ -0,0 +1,248 @@
#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))))

48
pacman-project/adt-game.rkt Normal file
View File

@@ -0,0 +1,48 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Game ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Top-level game object that connects the level (logic) with the draw ADT
;; (graphics). Registers callbacks for the game loop, keys, and drawing.
(define-library (pacman-project adt-game)
(import (scheme base)
(pacman-project constants)
(pacman-project adt-level)
(pacman-project adt-draw))
(export make-game)
(begin
;; make-game :: -> game
(define (make-game)
(let ((level (make-level))
(draw (make-draw window-width-px window-height-px)))
;; key-handler :: symbol, any -> /
;; Processes key presses and forwards them to the level.
(define (key-handler status key)
(when (eq? status 'pressed)
((level 'key-press!) key)))
;; game-loop :: number -> /
;; Called each frame for game state updates.
(define (game-loop delta-time)
((level 'update!) delta-time))
;; start! :: -> /
;; Starts the game by registering all callbacks.
(define (start!)
((draw 'set-game-loop!) game-loop)
((draw 'set-key-callback!) key-handler)
((draw 'start-drawing!) dispatch-game))
;; dispatch-game :: symbol -> any
(define (dispatch-game msg)
(cond ((eq? msg 'start!) start!)
((eq? msg 'level) level)
(else (error "Game ADT -- Unknown message:" msg))))
dispatch-game))))

55
pacman-project/adt-key.rkt Normal file
View File

@@ -0,0 +1,55 @@
#lang r7rs
(#%require (only racket/base random))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Key ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The key is placed at a random coin position in the maze. When Pac-Man
;; picks it up, doors can be opened. Contains NO graphics code.
(define-library (pacman-project adt-key)
(import (scheme base)
(pacman-project constants)
(pacman-project adt-position))
(export make-key)
(begin
;; make-key :: maze -> key
;; Creates a key and places it at a random coin position.
(define (make-key maze)
(let ((position #f)
(taken? #f))
;; place-random! :: -> /
;; Places the key on a random cell that contains a coin.
(define (place-random!)
(let loop ((attempts 0))
(if (>= attempts max-placement-attempts)
(error "No valid position found for key")
(let ((col (random 0 (maze 'cols)))
(row (random 0 (maze 'rows))))
(if ((maze 'coin?) row col)
(begin
(set! position (make-position row col))
((maze 'cell-set!) row col cell-type-key))
(loop (+ attempts 1)))))))
;; take! :: -> /
;; Marks the key as taken.
(define (take!)
(set! taken? #t))
;; Initialization: place the key immediately on creation.
(place-random!)
;; dispatch-key :: symbol -> any
(define (dispatch-key msg)
(cond ((eq? msg 'position) position)
((eq? msg 'taken?) taken?)
((eq? msg 'take!) take!)
(else (error "Key ADT -- Unknown message:" msg))))
dispatch-key))))

211
pacman-project/adt-level.rkt
View File

@@ -4,172 +4,171 @@
;; Level ADT ;; ;; Level ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Het level bevat alle spellogica: beweging van Pac-Man, botsingsdetectie, ;; Contains all game logic: Pac-Man movement, collision detection, coin/key
;; muntjes eten, sleutel oppakken, deuren openen, teleportatie, pauze en ;; pickup, door opening, teleportation, pause, and time management.
;; tijdsbeheer. Bevat GEEN grafische code. ;; Contains NO graphics code.
(define-library (pacman-project adt-level) (define-library (pacman-project adt-level)
(import (scheme base) (import (scheme base)
(pacman-project constanten) (pacman-project constants)
(pacman-project adt-positie) (pacman-project adt-position)
(pacman-project adt-doolhof) (pacman-project adt-maze)
(pacman-project adt-pacman) (pacman-project adt-pacman)
(pacman-project adt-sleutel) (pacman-project adt-key)
(pacman-project adt-score) (pacman-project adt-score)
(pacman-project adt-tijdslimiet)) (pacman-project adt-timer))
(export maak-level) (export make-level)
(begin (begin
;; maak-level :: -> level ;; make-level :: -> level
;; Maakt een nieuw level aan met alle spelobjecten. ;; Creates a new level with all game objects.
(define (maak-level) (define (make-level)
(let ((doolhof (maak-doolhof)) (let ((maze (make-maze))
(pacman (maak-pacman 5 2)) (pacman (make-pacman 5 2))
(sleutel #f) (key #f)
(score (maak-score)) (score (make-score))
(tijdslimiet (maak-tijdslimiet)) (timer (make-timer))
(gepauzeerd? #f)) (paused? #f))
;; Initialiseer de sleutel nadat het doolhof is aangemaakt. ;; Initialize key after maze is created.
(set! sleutel (maak-sleutel doolhof)) (set! key (make-key maze))
;; ;;
;; Richting helpers ;; Direction helpers
;; ;;
;; richting->delta :: symbol -> (number . number) ;; direction->delta :: symbol -> (number . number)
;; Converteert een richting naar een (delta-rij . delta-kolom) paar. ;; Converts a direction to a (delta-row . delta-col) pair.
(define (richting->delta richting) (define (direction->delta direction)
(cond ((eq? richting 'rechts) (cons 0 1)) (cond ((eq? direction 'right) (cons 0 1))
((eq? richting 'links) (cons 0 -1)) ((eq? direction 'left) (cons 0 -1))
((eq? richting 'omhoog) (cons -1 0)) ((eq? direction 'up) (cons -1 0))
((eq? richting 'omlaag) (cons 1 0)) ((eq? direction 'down) (cons 1 0))
(else (cons 0 0)))) (else (cons 0 0))))
;; ;;
;; Muntje logica ;; Coin logic
;; ;;
;; eet-muntje! :: number, number -> / ;; eat-coin! :: number, number -> /
;; Verwijdert het muntje op de cel en past score/tijd aan. ;; Removes the coin at the cell and updates score/time.
(define (eet-muntje! rij kolom) (define (eat-coin! row col)
((doolhof 'cel-set!) rij kolom cel-type-leeg) ((maze 'cell-set!) row col cell-type-empty)
((score 'verhoog!)) ((score 'increase!))
((tijdslimiet 'verhoog!))) ((timer 'increase!)))
;; ;;
;; Sleutel logica ;; Key logic
;; ;;
;; pak-sleutel-op! :: number, number -> / ;; pick-up-key! :: number, number -> /
;; Pakt de sleutel op en maakt de cel leeg. ;; Picks up the key and clears the cell.
(define (pak-sleutel-op! rij kolom) (define (pick-up-key! row col)
((doolhof 'cel-set!) rij kolom cel-type-leeg) ((maze 'cell-set!) row col cell-type-empty)
((sleutel 'pak-op!))) ((key 'take!)))
;; ;;
;; Teleportatie logica ;; Teleportation logic
;; ;;
;; teleporteer-horizontaal! :: number, number -> / ;; teleport-horizontal! :: number, number -> /
;; Teleporteert Pac-Man naar de andere kant van het doolhof. ;; Teleports Pac-Man to the other side of the maze.
(define (teleporteer-horizontaal! rij kolom) (define (teleport-horizontal! row col)
(let ((pac-pos (pacman 'positie))) (let ((pac-pos (pacman 'position)))
(cond ((< kolom 0) (cond ((< col 0)
((pac-pos 'kolom!) (- (doolhof 'kolommen) 1)) ((pac-pos 'col!) (- (maze 'cols) 1))
((pac-pos 'rij!) rij)) ((pac-pos 'row!) row))
((>= kolom (doolhof 'kolommen)) ((>= col (maze 'cols))
((pac-pos 'kolom!) 0) ((pac-pos 'col!) 0)
((pac-pos 'rij!) rij))))) ((pac-pos 'row!) row)))))
;; ;;
;; Bewegingslogica ;; Movement logic
;; ;;
;; beweeg-pacman! :: symbol -> / ;; move-pacman! :: symbol -> /
;; Beweegt Pac-Man in de opgegeven richting met alle spelregels. ;; Moves Pac-Man in the given direction with all game rules.
(define (beweeg-pacman! richting) (define (move-pacman! direction)
(when (not ((tijdslimiet 'tijd-op?))) (when (not ((timer 'time-up?)))
(let* ((delta (richting->delta richting)) (let* ((delta (direction->delta direction))
(delta-rij (car delta)) (delta-row (car delta))
(delta-kolom (cdr delta)) (delta-col (cdr delta))
(huidige-pos (pacman 'positie)) (current-pos (pacman 'position))
(volgende-rij (+ (huidige-pos 'rij) delta-rij)) (next-row (+ (current-pos 'row) delta-row))
(volgende-kolom (+ (huidige-pos 'kolom) delta-kolom))) (next-col (+ (current-pos 'col) delta-col)))
;; Pas richting aan voor de teken-laag. ;; Update direction for the draw layer.
((pacman 'richting!) richting) ((pacman 'direction!) direction)
(cond (cond
;; Teleportatie: buiten het grid horizontaal. ;; Teleportation: outside grid horizontally.
((or (< volgende-kolom 0) (>= volgende-kolom (doolhof 'kolommen))) ((or (< next-col 0) (>= next-col (maze 'cols)))
(teleporteer-horizontaal! volgende-rij volgende-kolom)) (teleport-horizontal! next-row next-col))
;; Deur: open alleen als de sleutel opgepakt is. ;; Door: only open if key has been taken.
(((doolhof 'deur?) volgende-rij volgende-kolom) (((maze 'door?) next-row next-col)
(when (sleutel 'opgepakt?) (when (key 'taken?)
((doolhof 'verwijder-deur!) volgende-rij volgende-kolom))) ((maze 'remove-door!) next-row next-col)))
;; Normale beweging: alleen als het geen muur is. ;; Normal movement: only if not a wall.
(else (else
(when (not ((doolhof 'muur?) volgende-rij volgende-kolom)) (when (not ((maze 'wall?) next-row next-col))
((pacman 'beweeg!) delta-rij delta-kolom) ((pacman 'move!) delta-row delta-col)
;; Controleer wat er op de nieuwe positie staat. ;; Check what's at the new position.
(cond (cond
(((doolhof 'sleutel?) volgende-rij volgende-kolom) (((maze 'key?) next-row next-col)
(pak-sleutel-op! volgende-rij volgende-kolom)) (pick-up-key! next-row next-col))
(((doolhof 'muntje?) volgende-rij volgende-kolom) (((maze 'coin?) next-row next-col)
(eet-muntje! volgende-rij volgende-kolom))))))))) (eat-coin! next-row next-col)))))))))
;; ;;
;; Pauze logica ;; Pause logic
;; ;;
;; wissel-pauze! :: -> / ;; toggle-pause! :: -> /
;; Wisselt de pauzetoestand. (define (toggle-pause!)
(define (wissel-pauze!) (set! paused? (not paused?)))
(set! gepauzeerd? (not gepauzeerd?)))
;; ;;
;; Toets afhandeling ;; Key handling
;; ;;
;; toets! :: symbol -> / ;; key-press! :: symbol -> /
;; Verwerkt een toetsaanslag. ;; Processes a key press.
(define (toets! toets) (define (key-press! pressed-key)
(cond (cond
((eq? toets 'escape) (wissel-pauze!)) ((eq? pressed-key 'escape) (toggle-pause!))
((not gepauzeerd?) ((not paused?)
(cond (cond
((eq? toets 'right) (beweeg-pacman! 'rechts)) ((eq? pressed-key 'right) (move-pacman! 'right))
((eq? toets 'left) (beweeg-pacman! 'links)) ((eq? pressed-key 'left) (move-pacman! 'left))
((eq? toets 'up) (beweeg-pacman! 'omhoog)) ((eq? pressed-key 'up) (move-pacman! 'up))
((eq? toets 'down) (beweeg-pacman! 'omlaag)))))) ((eq? pressed-key 'down) (move-pacman! 'down))))))
;; ;;
;; Update (spellusfunctie) ;; Update (game loop function)
;; ;;
;; update! :: number -> / ;; update! :: number -> /
;; Wordt elk frame aangeroepen met het aantal verstreken milliseconden. ;; Called each frame with elapsed milliseconds.
(define (update! delta-tijd) (define (update! delta-time)
(when (not gepauzeerd?) (when (not paused?)
((tijdslimiet 'verlaag!) delta-tijd))) ((timer 'decrease!) delta-time)))
;; ;;
;; Dispatch ;; Dispatch
;; ;;
(define (dispatch-level msg) (define (dispatch-level msg)
(cond ((eq? msg 'doolhof) doolhof) (cond ((eq? msg 'maze) maze)
((eq? msg 'pacman) pacman) ((eq? msg 'pacman) pacman)
((eq? msg 'sleutel) sleutel) ((eq? msg 'key) key)
((eq? msg 'score) score) ((eq? msg 'score) score)
((eq? msg 'tijdslimiet) tijdslimiet) ((eq? msg 'timer) timer)
((eq? msg 'gepauzeerd?) gepauzeerd?) ((eq? msg 'paused?) paused?)
((eq? msg 'toets!) toets!) ((eq? msg 'key-press!) key-press!)
((eq? msg 'update!) update!) ((eq? msg 'update!) update!)
(else (error "Level ADT -- Onbekend bericht:" msg)))) (else (error "Level ADT -- Unknown message:" msg))))
dispatch-level)))) dispatch-level))))

118
pacman-project/adt-maze.rkt Normal file
View File

@@ -0,0 +1,118 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Maze ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The maze contains the logical grid with cells. Each cell has a type
;; (wall, coin, empty, key, door). This ADT contains NO graphics code.
(define-library (pacman-project adt-maze)
(import (scheme base)
(pacman-project constants))
(export make-maze)
(begin
;; make-maze :: -> maze
;; Creates a new maze object with the full grid.
(define (make-maze)
;; The maze grid: 31 rows x 28 columns.
;; vector is used because it is mutable (unlike #()).
(define grid
(vector (vector 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(vector 1 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 1)
(vector 1 0 1 1 1 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 1)
(vector 1 0 1 0 0 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 1)
(vector 1 0 1 4 1 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 1)
(vector 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1)
(vector 1 0 1 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 1 0 1)
(vector 1 0 1 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 1 0 1)
(vector 1 0 0 0 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 0 0 1)
(vector 1 1 1 1 1 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 1 1 1 1 1 1)
(vector 2 2 2 2 2 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 1 2 2 2 2 2)
(vector 2 2 2 2 2 1 0 1 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 2 2 2 2 2)
(vector 2 2 2 2 2 1 0 1 1 0 1 1 1 4 4 1 1 1 0 1 1 0 1 2 2 2 2 2)
(vector 1 1 1 1 1 1 0 1 1 0 1 2 2 2 2 2 2 1 0 1 1 0 1 1 1 1 1 1)
(vector 2 0 0 0 0 0 0 0 0 0 1 2 2 2 2 2 2 1 0 0 0 0 0 0 0 0 0 2)
(vector 1 1 1 1 1 1 0 1 1 0 1 2 2 2 2 2 2 1 0 1 1 0 1 1 1 1 1 1)
(vector 2 2 2 2 2 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 2 2 2 2 2)
(vector 2 2 2 2 2 1 0 1 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 2 2 2 2 2)
(vector 2 2 2 2 2 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 2 2 2 2 2)
(vector 1 1 1 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 1 1 1)
(vector 1 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 1)
(vector 1 0 1 1 1 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 1)
(vector 1 0 1 1 1 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 1)
(vector 1 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 1)
(vector 1 1 1 0 1 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 0 1 1 1)
(vector 1 1 1 0 1 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 0 1 1 1)
(vector 1 0 0 0 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 4 1 0 0 0 0 0 0 1)
(vector 1 0 1 1 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 0 0 1 1 1 1 1 0 1)
(vector 1 0 1 1 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 1 1 0 1)
(vector 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1)
(vector 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)))
(define num-rows (vector-length grid))
(define num-cols (vector-length (vector-ref grid 0)))
;; cell-ref :: number, number -> number
;; Returns the cell type at the given position.
(define (cell-ref row col)
(vector-ref (vector-ref grid row) col))
;; cell-set! :: number, number, number -> /
;; Sets the cell type at the given position.
(define (cell-set! row col value)
(vector-set! (vector-ref grid row) col value))
;; wall? :: number, number -> boolean
(define (wall? row col)
(= (cell-ref row col) cell-type-wall))
;; coin? :: number, number -> boolean
(define (coin? row col)
(= (cell-ref row col) cell-type-coin))
;; empty? :: number, number -> boolean
(define (empty? row col)
(= (cell-ref row col) cell-type-empty))
;; key? :: number, number -> boolean
(define (key? row col)
(= (cell-ref row col) cell-type-key))
;; door? :: number, number -> boolean
(define (door? row col)
(= (cell-ref row col) cell-type-door))
;; remove-door! :: number, number -> /
;; Removes a door from the grid (makes the cell empty).
(define (remove-door! row col)
(cell-set! row col cell-type-empty))
;; for-each-cell :: (number, number, number -> /) -> /
;; Iterates over all cells, calling callback with row, col, cell-type.
(define (for-each-cell callback)
(do ((row 0 (+ row 1)))
((= row num-rows))
(do ((col 0 (+ col 1)))
((= col num-cols))
(callback row col (cell-ref row col)))))
;; dispatch-maze :: symbol -> any
(define (dispatch-maze msg)
(cond ((eq? msg 'rows) num-rows)
((eq? msg 'cols) num-cols)
((eq? msg 'cell-ref) cell-ref)
((eq? msg 'cell-set!) cell-set!)
((eq? msg 'wall?) wall?)
((eq? msg 'coin?) coin?)
((eq? msg 'empty?) empty?)
((eq? msg 'key?) key?)
((eq? msg 'door?) door?)
((eq? msg 'remove-door!) remove-door!)
((eq? msg 'for-each-cell) for-each-cell)
(else (error "Maze ADT -- Unknown message:" msg))))
dispatch-maze)))

54
pacman-project/adt-pacman.rkt
View File

@@ -4,45 +4,43 @@
;; Pac-Man ADT ;; ;; Pac-Man ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Het Pac-Man ADT beheert de logische toestand van de speler: positie op het ;; Manages the logical state of the player: grid position and current
;; grid en de huidige richting. Bevat GEEN grafische code. ;; direction. Contains NO graphics code.
(define-library (pacman-project adt-pacman) (define-library (pacman-project adt-pacman)
(import (scheme base) (import (scheme base)
(pacman-project adt-positie)) (pacman-project adt-position))
(export maak-pacman) (export make-pacman)
(begin (begin
;; maak-pacman :: number, number -> pacman ;; make-pacman :: number, number -> pacman
;; Maakt een Pac-Man object aan op de opgegeven startpositie (rij, kolom). ;; Creates a Pac-Man object at the given start position (row, col).
(define (maak-pacman start-rij start-kolom) (define (make-pacman start-row start-col)
(let ((positie (maak-positie start-rij start-kolom)) (let ((position (make-position start-row start-col))
(richting 'rechts)) (direction 'right))
;; positie! :: positie -> / ;; position! :: position -> /
;; Vervangt de huidige positie. (define (position! new-position)
(define (positie! nieuwe-positie) (set! position new-position))
(set! positie nieuwe-positie))
;; richting! :: symbol -> / ;; direction! :: symbol -> /
;; Past de huidige richting aan. (define (direction! new-direction)
(define (richting! nieuwe-richting) (set! direction new-direction))
(set! richting nieuwe-richting))
;; beweeg! :: number, number -> / ;; move! :: number, number -> /
;; Verplaatst Pac-Man met een delta op het grid. ;; Moves Pac-Man by a delta on the grid.
(define (beweeg! delta-rij delta-kolom) (define (move! delta-row delta-col)
((positie 'rij!) (+ (positie 'rij) delta-rij)) ((position 'row!) (+ (position 'row) delta-row))
((positie 'kolom!) (+ (positie 'kolom) delta-kolom))) ((position 'col!) (+ (position 'col) delta-col)))
;; dispatch-pacman :: symbol -> any ;; dispatch-pacman :: symbol -> any
(define (dispatch-pacman msg) (define (dispatch-pacman msg)
(cond ((eq? msg 'positie) positie) (cond ((eq? msg 'position) position)
((eq? msg 'positie!) positie!) ((eq? msg 'position!) position!)
((eq? msg 'richting) richting) ((eq? msg 'direction) direction)
((eq? msg 'richting!) richting!) ((eq? msg 'direction!) direction!)
((eq? msg 'beweeg!) beweeg!) ((eq? msg 'move!) move!)
(else (error "Pac-Man ADT -- Onbekend bericht:" msg)))) (else (error "Pac-Man ADT -- Unknown message:" msg))))
dispatch-pacman)))) dispatch-pacman))))

52
pacman-project/adt-positie.rkt
View File

@@ -1,52 +0,0 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Positie ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Een positie stelt een locatie voor op het logische grid van het doolhof.
;; Coordinaten zijn in grid-eenheden (rij, kolom), NIET in pixels.
(define-library (pacman-project adt-positie)
(import (scheme base))
(export maak-positie)
(begin
;; maak-positie :: number, number -> positie
;; Maakt een nieuw positie-object aan met rij en kolom op het grid.
(define (maak-positie rij kolom)
;; rij! :: number -> /
;; Past de rij-coordinaat aan.
(define (rij! nieuwe-rij)
(set! rij nieuwe-rij))
;; kolom! :: number -> /
;; Past de kolom-coordinaat aan.
(define (kolom! nieuwe-kolom)
(set! kolom nieuwe-kolom))
;; vergelijk? :: positie -> boolean
;; Controleert of twee posities dezelfde coordinaten hebben.
(define (vergelijk? andere-positie)
(and (= rij (andere-positie 'rij))
(= kolom (andere-positie 'kolom))))
;; beweeg :: number, number -> positie
;; Geeft een nieuwe positie terug verschoven met delta-rij en delta-kolom.
(define (beweeg delta-rij delta-kolom)
(maak-positie (+ rij delta-rij)
(+ kolom delta-kolom)))
;; dispatch-positie :: symbol -> any
(define (dispatch-positie msg)
(cond ((eq? msg 'rij) rij)
((eq? msg 'kolom) kolom)
((eq? msg 'rij!) rij!)
((eq? msg 'kolom!) kolom!)
((eq? msg 'vergelijk?) vergelijk?)
((eq? msg 'beweeg) beweeg)
(else (error "Positie ADT -- Onbekend bericht:" msg))))
dispatch-positie)))

50
pacman-project/adt-position.rkt Normal file
View File

@@ -0,0 +1,50 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Position ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; A position represents a location on the logical maze grid.
;; Coordinates are in grid units (row, col), NOT pixels.
(define-library (pacman-project adt-position)
(import (scheme base))
(export make-position)
(begin
;; make-position :: number, number -> position
;; Creates a new position object with row and column on the grid.
(define (make-position row col)
;; row! :: number -> /
(define (row! new-row)
(set! row new-row))
;; col! :: number -> /
(define (col! new-col)
(set! col new-col))
;; equal? :: position -> boolean
;; Checks whether two positions have the same coordinates.
(define (equal? other)
(and (= row (other 'row))
(= col (other 'col))))
;; move :: number, number -> position
;; Returns a new position shifted by delta-row and delta-col.
(define (move delta-row delta-col)
(make-position (+ row delta-row)
(+ col delta-col)))
;; dispatch-position :: symbol -> any
(define (dispatch-position msg)
(cond ((eq? msg 'row) row)
((eq? msg 'col) col)
((eq? msg 'row!) row!)
((eq? msg 'col!) col!)
((eq? msg 'equal?) equal?)
((eq? msg 'move) move)
(else (error "Position ADT -- Unknown message:" msg))))
dispatch-position)))

28
pacman-project/adt-score.rkt
View File

@@ -4,29 +4,29 @@
;; Score ADT ;; ;; Score ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Houdt de score bij. Bevat GEEN grafische code. ;; Tracks the player's score. Contains NO graphics code.
(define-library (pacman-project adt-score) (define-library (pacman-project adt-score)
(import (scheme base) (import (scheme base)
(pacman-project constanten)) (pacman-project constants))
(export maak-score) (export make-score)
(begin (begin
;; maak-score :: -> score ;; make-score :: -> score
;; Maakt een nieuw score-object aan, startend bij 0. ;; Creates a new score object, starting at 0.
(define (maak-score) (define (make-score)
(let ((punten 0)) (let ((points 0))
;; verhoog! :: -> / ;; increase! :: -> /
;; Verhoogt de score met het aantal punten per muntje. ;; Increases the score by points-per-coin.
(define (verhoog!) (define (increase!)
(set! punten (+ punten punten-per-muntje))) (set! points (+ points points-per-coin)))
;; dispatch-score :: symbol -> any ;; dispatch-score :: symbol -> any
(define (dispatch-score msg) (define (dispatch-score msg)
(cond ((eq? msg 'punten) punten) (cond ((eq? msg 'points) points)
((eq? msg 'verhoog!) verhoog!) ((eq? msg 'increase!) increase!)
(else (error "Score ADT -- Onbekend bericht:" msg)))) (else (error "Score ADT -- Unknown message:" msg))))
dispatch-score)))) dispatch-score))))

56
pacman-project/adt-sleutel.rkt
View File

@@ -1,56 +0,0 @@
#lang r7rs
(#%require (only racket/base random))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Sleutel ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; De sleutel is een object dat op een willekeurige positie in het doolhof
;; geplaatst wordt. Wanneer Pac-Man de sleutel oppakt, worden deuren geopend.
;; Bevat GEEN grafische code.
(define-library (pacman-project adt-sleutel)
(import (scheme base)
(pacman-project constanten)
(pacman-project adt-positie))
(export maak-sleutel)
(begin
;; maak-sleutel :: doolhof -> sleutel
;; Maakt een sleutel aan en plaatst deze op een willekeurige muntje-positie.
(define (maak-sleutel doolhof)
(let ((positie #f)
(opgepakt? #f))
;; plaats-willekeurig! :: -> /
;; Plaatst de sleutel op een willekeurige cel waar een muntje staat.
(define (plaats-willekeurig!)
(let loop ((pogingen 0))
(if (>= pogingen max-plaatsing-pogingen)
(error "Geen geldige positie gevonden voor sleutel")
(let ((kolom (random 0 (doolhof 'kolommen)))
(rij (random 0 (doolhof 'rijen))))
(if ((doolhof 'muntje?) rij kolom)
(begin
(set! positie (maak-positie rij kolom))
((doolhof 'cel-set!) rij kolom cel-type-sleutel))
(loop (+ pogingen 1)))))))
;; pak-op! :: -> /
;; Markeert de sleutel als opgepakt.
(define (pak-op!)
(set! opgepakt? #t))
;; Initialisatie: plaats de sleutel direct bij aanmaak.
(plaats-willekeurig!)
;; dispatch-sleutel :: symbol -> any
(define (dispatch-sleutel msg)
(cond ((eq? msg 'positie) positie)
((eq? msg 'opgepakt?) opgepakt?)
((eq? msg 'pak-op!) pak-op!)
(else (error "Sleutel ADT -- Onbekend bericht:" msg))))
dispatch-sleutel))))

49
pacman-project/adt-spel.rkt
View File

@@ -1,49 +0,0 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Spel ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Het top-level spel-object dat het level verbindt met het teken-ADT.
;; Registreert de callbacks voor de spellus, toetsen en tekenen.
(define-library (pacman-project adt-spel)
(import (scheme base)
(pacman-project constanten)
(pacman-project adt-level)
(pacman-project adt-teken))
(export maak-spel)
(begin
;; maak-spel :: -> spel
;; Maakt het spel-object aan.
(define (maak-spel)
(let ((level (maak-level))
(teken (maak-teken venster-breedte-px venster-hoogte-px)))
;; toets-procedure :: symbol, any -> /
;; Verwerkt toetsaanslagen en stuurt ze door naar het level.
(define (toets-procedure status toets)
(when (eq? status 'pressed)
((level 'toets!) toets)))
;; spel-lus-procedure :: number -> /
;; Wordt elk frame aangeroepen voor game-state updates.
(define (spel-lus-procedure delta-tijd)
((level 'update!) delta-tijd))
;; start! :: -> /
;; Start het spel door alle callbacks te registreren.
(define (start!)
((teken 'set-spel-lus-functie!) spel-lus-procedure)
((teken 'set-toets-functie!) toets-procedure)
((teken 'start-tekenen!) dispatch-spel))
;; dispatch-spel :: symbol -> any
(define (dispatch-spel msg)
(cond ((eq? msg 'start!) start!)
((eq? msg 'level) level)
(else (error "Spel ADT -- Onbekend bericht:" msg))))
dispatch-spel))))

252
pacman-project/adt-teken.rkt
View File

@@ -1,252 +0,0 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Teken ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Alle grafische logica is geisoleerd in dit ADT. De spellogica kent niets
;; over pixels, vensters of sprites. De omzetting van grid-coordinaten naar
;; schermcoordinaten gebeurt uitsluitend hier.
(define-library (pacman-project adt-teken)
(import (scheme base)
(pp1 graphics)
(pacman-project constanten))
(export maak-teken)
(begin
;; maak-teken :: number, number -> teken
;; Maakt het teken-object aan dat alle grafische weergave verzorgt.
(define (maak-teken breedte hoogte)
(let ((venster (make-window breedte hoogte "Pacman")))
((venster 'set-background!) "black")
;;
;; Lagen aanmaken (volgorde bepaalt tekenvolgorde)
;;
(define doolhof-laag ((venster 'new-layer!)))
(define muntjes-laag ((venster 'new-layer!)))
(define sleutel-laag ((venster 'new-layer!)))
(define pacman-laag ((venster 'new-layer!)))
(define ui-laag ((venster 'new-layer!)))
(define pauze-laag ((venster 'new-layer!)))
;;
;; Doolhof tiles
;;
(define doolhof-tile (make-tile breedte hoogte))
((doolhof-laag 'add-drawable!) doolhof-tile)
;;
;; Muntjes tile
;;
(define muntjes-tile (make-tile breedte hoogte))
((muntjes-laag 'add-drawable!) muntjes-tile)
;;
;; Sleutel sprite (in het doolhof)
;;
(define sleutel-sprite (make-bitmap-tile "pacman-sprites/key.png"))
((sleutel-sprite 'set-scale!) sprite-schaal-sleutel)
((sleutel-laag 'add-drawable!) sleutel-sprite)
;; Sleutel UI indicator (naast de score)
(define sleutel-ui-sprite (make-bitmap-tile "pacman-sprites/key.png"))
((sleutel-ui-sprite 'set-scale!) sprite-schaal-sleutel-ui)
((sleutel-ui-sprite 'set-x!) sleutel-ui-x)
((sleutel-ui-sprite 'set-y!) sleutel-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-schaal-pacman)
((pacman-laag 'add-drawable!) pacman-sprite)
;; Animatie state
(define tijd-sinds-laatste-animatie 0)
;;
;; UI tiles
;;
(define ui-tile (make-tile breedte hoogte))
((ui-laag 'add-drawable!) ui-tile)
;;
;; Coordinaat conversie
;;
;; grid->pixel-x :: number -> number
;; Converteert een grid kolom naar een pixel x-coordinaat.
(define (grid->pixel-x kolom)
(* cel-grootte-px kolom))
;; grid->pixel-y :: number -> number
;; Converteert een grid rij naar een pixel y-coordinaat.
(define (grid->pixel-y rij)
(+ (* rij cel-grootte-px) doolhof-offset-y))
;;
;; Teken functies
;;
;; teken-doolhof! :: doolhof -> /
;; Tekent alle muren en deuren van het doolhof.
(define (teken-doolhof! doolhof)
((doolhof 'voor-elke-cel)
(lambda (rij kolom celtype)
(cond
((= celtype cel-type-muur)
((doolhof-tile 'draw-rectangle!)
(grid->pixel-x kolom)
(grid->pixel-y rij)
(- cel-grootte-px doolhof-muur-krimp)
(- cel-grootte-px doolhof-muur-krimp)
"blue"))
((= celtype cel-type-deur)
((doolhof-tile 'draw-rectangle!)
(grid->pixel-x kolom)
(grid->pixel-y rij)
(- cel-grootte-px doolhof-muur-krimp)
(- cel-grootte-px doolhof-muur-krimp)
"pink"))))))
;; teken-muntjes! :: doolhof -> /
;; Tekent alle muntjes in het doolhof.
(define (teken-muntjes! doolhof)
((muntjes-tile 'clear!))
((doolhof 'voor-elke-cel)
(lambda (rij kolom celtype)
(when (= celtype cel-type-muntje)
((muntjes-tile 'draw-rectangle!)
(+ (grid->pixel-x kolom) muntje-inset)
(+ (grid->pixel-y rij) muntje-inset)
(- cel-grootte-px (* 2 muntje-inset) 6)
(- cel-grootte-px (* 2 muntje-inset) 6)
"yellow")))))
;; teken-sleutel! :: sleutel -> /
;; Tekent de sleutel op haar positie, of verbergt ze als opgepakt.
(define (teken-sleutel! sleutel)
(if (sleutel 'opgepakt?)
(begin
((sleutel-laag 'remove-drawable!) sleutel-sprite)
((sleutel-laag 'add-drawable!) sleutel-ui-sprite))
(let ((pos (sleutel 'positie)))
((sleutel-sprite 'set-x!) (grid->pixel-x (pos 'kolom)))
((sleutel-sprite 'set-y!) (grid->pixel-y (pos 'rij))))))
;; teken-pacman! :: pacman, number -> /
;; Tekent Pac-Man op zijn huidige positie met de juiste rotatie.
(define (teken-pacman! pacman delta-tijd)
(let* ((pos (pacman 'positie))
(richting (pacman 'richting)))
;; Positie instellen
((pacman-sprite 'set-x!) (grid->pixel-x (pos 'kolom)))
((pacman-sprite 'set-y!) (grid->pixel-y (pos 'rij)))
;; Rotatie instellen op basis van richting
(cond ((eq? richting 'rechts) ((pacman-sprite 'rotate!) rotatie-rechts))
((eq? richting 'links) ((pacman-sprite 'rotate!) rotatie-links))
((eq? richting 'omhoog) ((pacman-sprite 'rotate!) rotatie-omhoog))
((eq? richting 'omlaag) ((pacman-sprite 'rotate!) rotatie-omlaag)))
;; Animatie
(set! tijd-sinds-laatste-animatie (+ tijd-sinds-laatste-animatie delta-tijd))
(when (>= tijd-sinds-laatste-animatie animatie-interval-ms)
((pacman-sprite 'set-next!))
(set! tijd-sinds-laatste-animatie 0))))
;; teken-ui! :: score, tijdslimiet -> /
;; Tekent de score en de tijdslimiet op het scherm.
(define (teken-ui! score tijdslimiet)
((ui-tile 'clear!))
;; Score
((ui-tile 'draw-text!)
(number->string (score 'punten))
score-tekst-grootte score-tekst-x score-tekst-y "white")
;; Scheidingslijn
((ui-tile 'draw-rectangle!)
scheidingslijn-x 0 scheidingslijn-breedte hoogte "white")
;; Tijdslimiet
((ui-tile 'draw-text!)
"Time remaining:" tijd-tekst-grootte tijd-label-x tijd-label-y "white")
((ui-tile 'draw-text!)
((tijdslimiet 'formatteer-tijd))
score-tekst-grootte tijd-waarde-x tijd-waarde-y "white"))
;; teken-pauze! :: boolean -> /
;; Toont of verbergt het pauzescherm.
(define (teken-pauze! gepauzeerd?)
((pauze-laag 'empty!))
(when gepauzeerd?
(let ((pauze-tile (make-tile breedte hoogte)))
((pauze-laag 'add-drawable!) pauze-tile)
((pauze-tile 'draw-rectangle!) 0 90 670 hoogte "black")
((pauze-tile 'draw-text!) "Game Paused" 40 200 400 "red"))))
;; herteken-doolhof! :: doolhof -> /
;; Hertekent het doolhof (na deur verwijdering).
(define (herteken-doolhof! doolhof)
((doolhof-tile 'clear!))
(teken-doolhof! doolhof))
;;
;; Hoofdtekenfunctie
;;
;; teken-spel! :: spel -> /
;; Tekent het volledige spel (wordt als draw-callback geregistreerd).
(define (teken-spel! spel)
(let ((level (spel 'level)))
(teken-pacman! (level 'pacman) 0)
(teken-sleutel! (level 'sleutel))
(teken-muntjes! (level 'doolhof))
(teken-ui! (level 'score) (level 'tijdslimiet))
(teken-pauze! (level 'gepauzeerd?))))
;;
;; Callbacks instellen
;;
;; set-spel-lus-functie! :: (number -> /) -> /
;; Registreert de update-callback.
(define (set-spel-lus-functie! fun)
((venster 'set-update-callback!) fun))
;; set-toets-functie! :: (symbol, any -> /) -> /
;; Registreert de keyboard-callback.
(define (set-toets-functie! fun)
((venster 'set-key-callback!) fun))
;; start-tekenen! :: spel -> /
;; Start het tekenen door de draw-callback in te stellen.
(define (start-tekenen! spel)
;; Initieel doolhof en muntjes tekenen (eenmalig)
(teken-doolhof! ((spel 'level) 'doolhof))
(teken-muntjes! ((spel 'level) 'doolhof))
((venster 'set-draw-callback!)
(lambda () (teken-spel! spel))))
;;
;; Dispatch
;;
(define (dispatch-teken msg)
(cond ((eq? msg 'set-spel-lus-functie!) set-spel-lus-functie!)
((eq? msg 'set-toets-functie!) set-toets-functie!)
((eq? msg 'start-tekenen!) start-tekenen!)
(else (error "Teken ADT -- Onbekend bericht:" msg))))
dispatch-teken))))

63
pacman-project/adt-tijdslimiet.rkt
View File

@@ -1,63 +0,0 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tijdslimiet ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Beheert de aftellende tijdslimiet van het spel. Bevat GEEN grafische code.
(define-library (pacman-project adt-tijdslimiet)
(import (scheme base)
(pacman-project constanten))
(export maak-tijdslimiet)
(begin
;; maak-tijdslimiet :: -> tijdslimiet
;; Maakt een nieuw tijdslimiet-object aan.
(define (maak-tijdslimiet)
(let ((resterende-tijd start-tijd-seconden)
(tijd-sinds-laatste-tick 0))
;; verlaag! :: number -> /
;; Verlaagt de tijd op basis van het aantal verstreken milliseconden.
(define (verlaag! ms)
(set! tijd-sinds-laatste-tick (+ tijd-sinds-laatste-tick ms))
(when (>= tijd-sinds-laatste-tick ms-per-seconde)
(set! tijd-sinds-laatste-tick 0)
(when (> resterende-tijd 0)
(set! resterende-tijd (- resterende-tijd 1)))))
;; verhoog! :: -> /
;; Verhoogt de resterende tijd met een bonus (bij het eten van een muntje).
(define (verhoog!)
(set! resterende-tijd (+ resterende-tijd tijd-bonus-per-muntje)))
;; tijd-op? :: -> boolean
;; Controleert of de tijd verstreken is.
(define (tijd-op?)
(= resterende-tijd 0))
;; formatteer-tijd :: -> string
;; Geeft de resterende tijd terug als "m:ss" string.
(define (formatteer-tijd)
(let* ((minuten (quotient resterende-tijd 60))
(seconden (remainder resterende-tijd 60))
(min-str (number->string minuten))
(sec-str (number->string seconden)))
(string-append min-str
":"
(if (< seconden 10)
(string-append "0" sec-str)
sec-str))))
;; dispatch-tijdslimiet :: symbol -> any
(define (dispatch-tijdslimiet msg)
(cond ((eq? msg 'resterende-tijd) resterende-tijd)
((eq? msg 'verlaag!) verlaag!)
((eq? msg 'verhoog!) verhoog!)
((eq? msg 'tijd-op?) tijd-op?)
((eq? msg 'formatteer-tijd) formatteer-tijd)
(else (error "Tijdslimiet ADT -- Onbekend bericht:" msg))))
dispatch-tijdslimiet))))

62
pacman-project/adt-timer.rkt Normal file
View File

@@ -0,0 +1,62 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Timer ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Manages the countdown time limit. Contains NO graphics code.
(define-library (pacman-project adt-timer)
(import (scheme base)
(pacman-project constants))
(export make-timer)
(begin
;; make-timer :: -> timer
;; Creates a new timer object.
(define (make-timer)
(let ((remaining-time start-time-seconds)
(time-since-last-tick 0))
;; decrease! :: number -> /
;; Decreases time based on elapsed milliseconds.
(define (decrease! ms)
(set! time-since-last-tick (+ time-since-last-tick ms))
(when (>= time-since-last-tick ms-per-second)
(set! time-since-last-tick 0)
(when (> remaining-time 0)
(set! remaining-time (- remaining-time 1)))))
;; increase! :: -> /
;; Adds a time bonus (when eating a coin).
(define (increase!)
(set! remaining-time (+ remaining-time time-bonus-per-coin)))
;; time-up? :: -> boolean
(define (time-up?)
(= remaining-time 0))
;; format-time :: -> string
;; Returns remaining time as "m:ss" string.
(define (format-time)
(let* ((minutes (quotient remaining-time 60))
(seconds (remainder remaining-time 60))
(min-str (number->string minutes))
(sec-str (number->string seconds)))
(string-append min-str
":"
(if (< seconds 10)
(string-append "0" sec-str)
sec-str))))
;; dispatch-timer :: symbol -> any
(define (dispatch-timer msg)
(cond ((eq? msg 'remaining-time) remaining-time)
((eq? msg 'decrease!) decrease!)
((eq? msg 'increase!) increase!)
((eq? msg 'time-up?) time-up?)
((eq? msg 'format-time) format-time)
(else (error "Timer ADT -- Unknown message:" msg))))
dispatch-timer))))

135
pacman-project/constanten.rkt
View File

@@ -1,135 +0,0 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Constanten ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Alle configuratieconstanten voor het Pac-Man spel worden hier gedefinieerd.
;; Dit voorkomt "magic constants" doorheen de code en maakt het spel flexibel
;; aanpasbaar.
(define-library (pacman-project constanten)
(import (scheme base))
(export ;; Venster
venster-breedte-px
venster-hoogte-px
;; Doolhof grid
cel-grootte-px
doolhof-offset-y
doolhof-muur-krimp
;; Cel types
cel-type-muntje
cel-type-muur
cel-type-leeg
cel-type-sleutel
cel-type-deur
;; Muntje weergave
muntje-inset
;; Sprites
sprite-schaal-pacman
sprite-schaal-sleutel
sprite-schaal-sleutel-ui
;; Animatie
animatie-interval-ms
;; Score
punten-per-muntje
;; Tijdslimiet
start-tijd-seconden
ms-per-seconde
tijd-bonus-per-muntje
;; Sleutel plaatsing
max-plaatsing-pogingen
;; Rotatie hoeken
rotatie-rechts
rotatie-links
rotatie-omhoog
rotatie-omlaag
;; UI posities
score-tekst-grootte
score-tekst-x
score-tekst-y
tijd-tekst-grootte
tijd-label-x
tijd-label-y
tijd-waarde-x
tijd-waarde-y
scheidingslijn-x
scheidingslijn-breedte
sleutel-ui-x
sleutel-ui-y)
(begin
;; Venster dimensies
(define venster-breedte-px 1000)
(define venster-hoogte-px 830)
;; Doolhof grid configuratie
(define cel-grootte-px 24)
(define doolhof-offset-y 97)
(define doolhof-muur-krimp 6)
;; Cel type encodering voor het doolhof grid
(define cel-type-muntje 0)
(define cel-type-muur 1)
(define cel-type-leeg 2)
(define cel-type-sleutel 3)
(define cel-type-deur 4)
;; Muntje weergave: inset in pixels ten opzichte van cel rand
(define muntje-inset 7)
;; Sprite schaalfactoren
(define sprite-schaal-pacman 1.5)
(define sprite-schaal-sleutel 1.5)
(define sprite-schaal-sleutel-ui 3)
;; Animatie timing
(define animatie-interval-ms 100)
;; Score configuratie
(define punten-per-muntje 10)
;; Tijdslimiet configuratie
(define start-tijd-seconden 60)
(define ms-per-seconde 1000)
(define tijd-bonus-per-muntje 1)
;; Sleutel plaatsing
(define max-plaatsing-pogingen 1000)
;; Rotatie hoeken (graden)
(define rotatie-rechts 0)
(define rotatie-links 180)
(define rotatie-omhoog 90)
(define rotatie-omlaag -90)
;; UI posities voor score weergave
(define score-tekst-grootte 40)
(define score-tekst-x 560)
(define score-tekst-y 20)
;; UI posities voor tijd weergave
(define tijd-tekst-grootte 35)
(define tijd-label-x 300)
(define tijd-label-y 710)
(define tijd-waarde-x 400)
(define tijd-waarde-y 800)
;; Scheidingslijn tussen speelveld en UI
(define scheidingslijn-x 670)
(define scheidingslijn-breedte 24)
;; Sleutel UI positie (naast score)
(define sleutel-ui-x 20)
(define sleutel-ui-y 35)))

134
pacman-project/constants.rkt Normal file
View File

@@ -0,0 +1,134 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Constants ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; All configuration constants for the Pac-Man game. Prevents magic numbers
;; throughout the codebase and makes the game easily configurable.
(define-library (pacman-project constants)
(import (scheme base))
(export ;; Window
window-width-px
window-height-px
;; Maze grid
cell-size-px
maze-offset-y
maze-wall-shrink
;; Cell types
cell-type-coin
cell-type-wall
cell-type-empty
cell-type-key
cell-type-door
;; Coin rendering
coin-inset
;; Sprites
sprite-scale-pacman
sprite-scale-key
sprite-scale-key-ui
;; Animation
animation-interval-ms
;; Score
points-per-coin
;; Time limit
start-time-seconds
ms-per-second
time-bonus-per-coin
;; Key placement
max-placement-attempts
;; Rotation angles
rotation-right
rotation-left
rotation-up
rotation-down
;; UI positions
score-text-size
score-text-x
score-text-y
time-text-size
time-label-x
time-label-y
time-value-x
time-value-y
separator-x
separator-width
key-ui-x
key-ui-y)
(begin
;; Window dimensions
(define window-width-px 1000)
(define window-height-px 830)
;; Maze grid configuration
(define cell-size-px 24)
(define maze-offset-y 97)
(define maze-wall-shrink 6)
;; Cell type encoding for the maze grid
(define cell-type-coin 0)
(define cell-type-wall 1)
(define cell-type-empty 2)
(define cell-type-key 3)
(define cell-type-door 4)
;; Coin rendering: inset in pixels from cell edge
(define coin-inset 7)
;; Sprite scale factors
(define sprite-scale-pacman 1.5)
(define sprite-scale-key 1.5)
(define sprite-scale-key-ui 3)
;; Animation timing
(define animation-interval-ms 100)
;; Score configuration
(define points-per-coin 10)
;; Time limit configuration
(define start-time-seconds 60)
(define ms-per-second 1000)
(define time-bonus-per-coin 1)
;; Key placement
(define max-placement-attempts 1000)
;; Rotation angles (degrees)
(define rotation-right 0)
(define rotation-left 180)
(define rotation-up 90)
(define rotation-down -90)
;; UI positions for score display
(define score-text-size 40)
(define score-text-x 560)
(define score-text-y 20)
;; UI positions for time display (right side of separator)
(define time-text-size 35)
(define time-label-x 710)
(define time-label-y 300)
(define time-value-x 800)
(define time-value-y 400)
;; Separator line between play field and UI
(define separator-x 670)
(define separator-width 24)
;; Key UI position (next to score)
(define key-ui-x 20)
(define key-ui-y 35)))

8
pacman-project/spel.rkt
View File

@@ -1,11 +1,11 @@
#lang r7rs #lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Spel Opstarten ;; ;; Start Game ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(import (scheme base) (import (scheme base)
(pacman-project adt-spel)) (pacman-project adt-game))
(define spel (maak-spel)) (define game (make-game))
((spel 'start!)) ((game 'start!))

24
pacman-project/tests/all-tests.rkt Normal file
View File

@@ -0,0 +1,24 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; All Tests ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Runs all ADT tests. Open this file and evaluate to run everything.
(import (scheme base)
(pp1 tests)
(prefix (pacman-project tests test-position) position:)
(prefix (pacman-project tests test-maze) maze:)
(prefix (pacman-project tests test-pacman) pacman:)
(prefix (pacman-project tests test-score) score:)
(prefix (pacman-project tests test-timer) timer:))
(define (test-all)
(position:test)
(maze:test)
(pacman:test)
(score:test)
(timer:test))
(test-all)

25
pacman-project/tests/alle-testen.rkt
View File

@@ -1,25 +0,0 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Alle Testen ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Voert alle ADT-testen uit. Open dit bestand en evalueer om alle testen
;; tegelijkertijd te draaien.
(import (scheme base)
(pp1 tests)
(prefix (pacman-project tests test-positie) positie:)
(prefix (pacman-project tests test-doolhof) doolhof:)
(prefix (pacman-project tests test-pacman) pacman:)
(prefix (pacman-project tests test-score) score:)
(prefix (pacman-project tests test-tijdslimiet) tijdslimiet:))
(define (test-alles)
(positie:test)
(doolhof:test)
(pacman:test)
(score:test)
(tijdslimiet:test))
(test-alles)

59
pacman-project/tests/test-doolhof.rkt
View File

@@ -1,59 +0,0 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests: Doolhof ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-library (pacman-project tests test-doolhof)
(import (scheme base)
(pp1 tests)
(pacman-project constanten)
(pacman-project adt-doolhof))
(export test)
(begin
;; Test dimensies
(define (test-dimensies)
(define d (maak-doolhof))
(check-eq? (d 'rijen) 31 "Doolhof moet 31 rijen hebben")
(check-eq? (d 'kolommen) 28 "Doolhof moet 28 kolommen hebben"))
;; Test muur detectie (rij 0 is volledig muur)
(define (test-muur)
(define d (maak-doolhof))
(check ((d 'muur?) 0 0) "Cel (0,0) moet een muur zijn")
(check ((d 'muur?) 0 14) "Cel (0,14) moet een muur zijn"))
;; Test muntje detectie
(define (test-muntje)
(define d (maak-doolhof))
(check ((d 'muntje?) 1 1) "Cel (1,1) moet een muntje zijn")
(check (not ((d 'muntje?) 0 0)) "Cel (0,0) mag geen muntje zijn"))
;; Test deur detectie
(define (test-deur)
(define d (maak-doolhof))
(check ((d 'deur?) 4 3) "Cel (4,3) moet een deur zijn")
(check (not ((d 'deur?) 1 1)) "Cel (1,1) mag geen deur zijn"))
;; Test cel-set! en verwijder-deur!
(define (test-mutatie)
(define d (maak-doolhof))
((d 'verwijder-deur!) 4 3)
(check ((d 'leeg?) 4 3) "Cel (4,3) moet leeg zijn na verwijder-deur!")
(check (not ((d 'deur?) 4 3)) "Cel (4,3) mag geen deur meer zijn"))
;; Test dat Pac-Man niet door muur kan (muur blokkeert)
(define (test-muur-blokkade)
(define d (maak-doolhof))
;; Pac-Man staat op (1,1) en wil naar links (1,0) -> dat is een muur
(check ((d 'muur?) 1 0) "Cel (1,0) is een muur, Pac-Man kan niet door"))
(define (test)
(run-test test-dimensies "Doolhof: dimensies")
(run-test test-muur "Doolhof: muur detectie")
(run-test test-muntje "Doolhof: muntje detectie")
(run-test test-deur "Doolhof: deur detectie")
(run-test test-mutatie "Doolhof: cel mutatie")
(run-test test-muur-blokkade "Doolhof: muur blokkeert beweging"))))

58
pacman-project/tests/test-maze.rkt Normal file
View File

@@ -0,0 +1,58 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests: Maze ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-library (pacman-project tests test-maze)
(import (scheme base)
(pp1 tests)
(pacman-project constants)
(pacman-project adt-maze))
(export test)
(begin
;; Test dimensions
(define (test-dimensions)
(define m (make-maze))
(check-eq? (m 'rows) 31 "Maze should have 31 rows")
(check-eq? (m 'cols) 28 "Maze should have 28 cols"))
;; Test wall detection (row 0 is all walls)
(define (test-wall)
(define m (make-maze))
(check ((m 'wall?) 0 0) "Cell (0,0) should be a wall")
(check ((m 'wall?) 0 14) "Cell (0,14) should be a wall"))
;; Test coin detection
(define (test-coin)
(define m (make-maze))
(check ((m 'coin?) 1 1) "Cell (1,1) should be a coin")
(check (not ((m 'coin?) 0 0)) "Cell (0,0) should not be a coin"))
;; Test door detection
(define (test-door)
(define m (make-maze))
(check ((m 'door?) 4 3) "Cell (4,3) should be a door")
(check (not ((m 'door?) 1 1)) "Cell (1,1) should not be a door"))
;; Test cell-set! and remove-door!
(define (test-mutation)
(define m (make-maze))
((m 'remove-door!) 4 3)
(check ((m 'empty?) 4 3) "Cell (4,3) should be empty after remove-door!")
(check (not ((m 'door?) 4 3)) "Cell (4,3) should no longer be a door"))
;; Test that wall blocks movement
(define (test-wall-blocks)
(define m (make-maze))
(check ((m 'wall?) 1 0) "Cell (1,0) is a wall, Pac-Man cannot pass"))
(define (test)
(run-test test-dimensions "Maze: dimensions")
(run-test test-wall "Maze: wall detection")
(run-test test-coin "Maze: coin detection")
(run-test test-door "Maze: door detection")
(run-test test-mutation "Maze: cell mutation")
(run-test test-wall-blocks "Maze: wall blocks movement"))))

66
pacman-project/tests/test-pacman.rkt
View File

@@ -1,51 +1,51 @@
#lang r7rs #lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests: Pac-Man ADT ;; ;; Tests: Pac-Man ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-library (pacman-project tests test-pacman) (define-library (pacman-project tests test-pacman)
(import (scheme base) (import (scheme base)
(pp1 tests) (pp1 tests)
(pacman-project adt-positie) (pacman-project adt-position)
(pacman-project adt-pacman)) (pacman-project adt-pacman))
(export test) (export test)
(begin (begin
;; Test aanmaak en startpositie ;; Test creation and start position
(define (test-aanmaak) (define (test-creation)
(define pac (maak-pacman 5 2)) (define pac (make-pacman 5 2))
(define pos (pac 'positie)) (define pos (pac 'position))
(check-eq? (pos 'rij) 5 "Start rij moet 5 zijn") (check-eq? (pos 'row) 5 "Start row should be 5")
(check-eq? (pos 'kolom) 2 "Start kolom moet 2 zijn")) (check-eq? (pos 'col) 2 "Start col should be 2"))
;; Test richting ;; Test direction
(define (test-richting) (define (test-direction)
(define pac (maak-pacman 5 2)) (define pac (make-pacman 5 2))
(check-eq? (pac 'richting) 'rechts "Startrichting moet rechts zijn") (check-eq? (pac 'direction) 'right "Start direction should be right")
((pac 'richting!) 'links) ((pac 'direction!) 'left)
(check-eq? (pac 'richting) 'links "Richting moet links zijn na richting!")) (check-eq? (pac 'direction) 'left "Direction should be left after direction!"))
;; Test beweeg! ;; Test move!
(define (test-beweeg) (define (test-move)
(define pac (maak-pacman 5 2)) (define pac (make-pacman 5 2))
((pac 'beweeg!) 0 1) ((pac 'move!) 0 1)
(define pos (pac 'positie)) (define pos (pac 'position))
(check-eq? (pos 'kolom) 3 "Kolom moet 3 zijn na 1 stap rechts") (check-eq? (pos 'col) 3 "Col should be 3 after 1 step right")
(check-eq? (pos 'rij) 5 "Rij ongewijzigd na horizontale beweging")) (check-eq? (pos 'row) 5 "Row unchanged after horizontal move"))
;; Test meerdere bewegingen ;; Test multiple moves
(define (test-meerdere-bewegingen) (define (test-multiple-moves)
(define pac (maak-pacman 5 5)) (define pac (make-pacman 5 5))
((pac 'beweeg!) -1 0) ((pac 'move!) -1 0)
((pac 'beweeg!) 0 1) ((pac 'move!) 0 1)
(define pos (pac 'positie)) (define pos (pac 'position))
(check-eq? (pos 'rij) 4 "Rij moet 4 zijn na omhoog") (check-eq? (pos 'row) 4 "Row should be 4 after up")
(check-eq? (pos 'kolom) 6 "Kolom moet 6 zijn na rechts")) (check-eq? (pos 'col) 6 "Col should be 6 after right"))
(define (test) (define (test)
(run-test test-aanmaak "Pac-Man: aanmaak en startpositie") (run-test test-creation "Pac-Man: creation and start position")
(run-test test-richting "Pac-Man: richting") (run-test test-direction "Pac-Man: direction")
(run-test test-beweeg "Pac-Man: beweeg!") (run-test test-move "Pac-Man: move!")
(run-test test-meerdere-bewegingen "Pac-Man: meerdere bewegingen")))) (run-test test-multiple-moves "Pac-Man: multiple moves"))))

57
pacman-project/tests/test-positie.rkt
View File

@@ -1,57 +0,0 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests: Positie ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-library (pacman-project tests test-positie)
(import (scheme base)
(pp1 tests)
(pacman-project adt-positie))
(export test)
(begin
;; Test aanmaak en getters
(define (test-aanmaak)
(define pos (maak-positie 5 10))
(check-eq? (pos 'rij) 5 "Rij moet 5 zijn")
(check-eq? (pos 'kolom) 10 "Kolom moet 10 zijn"))
;; Test mutators
(define (test-mutators)
(define pos (maak-positie 0 0))
((pos 'rij!) 3)
((pos 'kolom!) 7)
(check-eq? (pos 'rij) 3 "Rij moet 3 zijn na rij!")
(check-eq? (pos 'kolom) 7 "Kolom moet 7 zijn na kolom!"))
;; Test vergelijk?
(define (test-vergelijk)
(define p1 (maak-positie 5 10))
(define p2 (maak-positie 5 10))
(define p3 (maak-positie 5 11))
(check ((p1 'vergelijk?) p2) "Gelijke posities moeten gelijk zijn")
(check (not ((p1 'vergelijk?) p3)) "Verschillende posities mogen niet gelijk zijn"))
;; Test beweeg
(define (test-beweeg)
(define pos (maak-positie 5 10))
(define nieuwe-pos ((pos 'beweeg) -1 0))
(check-eq? (nieuwe-pos 'rij) 4 "Rij moet 4 zijn na beweeg omhoog")
(check-eq? (nieuwe-pos 'kolom) 10 "Kolom ongewijzigd na beweeg omhoog")
;; Originele positie mag niet gewijzigd zijn
(check-eq? (pos 'rij) 5 "Originele rij mag niet wijzigen"))
;; Test dat twee objecten niet eq? zijn
(define (test-identiteit)
(define p1 (maak-positie 1 1))
(define p2 (maak-positie 1 1))
(check (not (eq? p1 p2)) "Twee positie-objecten mogen niet eq? zijn"))
(define (test)
(run-test test-aanmaak "Positie: aanmaak en getters")
(run-test test-mutators "Positie: mutators")
(run-test test-vergelijk "Positie: vergelijk?")
(run-test test-beweeg "Positie: beweeg")
(run-test test-identiteit "Positie: identiteit"))))

57
pacman-project/tests/test-position.rkt Normal file
View File

@@ -0,0 +1,57 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests: Position ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-library (pacman-project tests test-position)
(import (scheme base)
(pp1 tests)
(pacman-project adt-position))
(export test)
(begin
;; Test creation and getters
(define (test-creation)
(define pos (make-position 5 10))
(check-eq? (pos 'row) 5 "Row should be 5")
(check-eq? (pos 'col) 10 "Col should be 10"))
;; Test mutators
(define (test-mutators)
(define pos (make-position 0 0))
((pos 'row!) 3)
((pos 'col!) 7)
(check-eq? (pos 'row) 3 "Row should be 3 after row!")
(check-eq? (pos 'col) 7 "Col should be 7 after col!"))
;; Test equal?
(define (test-equal)
(define p1 (make-position 5 10))
(define p2 (make-position 5 10))
(define p3 (make-position 5 11))
(check ((p1 'equal?) p2) "Equal positions should match")
(check (not ((p1 'equal?) p3)) "Different positions should not match"))
;; Test move
(define (test-move)
(define pos (make-position 5 10))
(define new-pos ((pos 'move) -1 0))
(check-eq? (new-pos 'row) 4 "Row should be 4 after move up")
(check-eq? (new-pos 'col) 10 "Col unchanged after move up")
;; Original position must not change
(check-eq? (pos 'row) 5 "Original row must not change"))
;; Test that two objects are not eq?
(define (test-identity)
(define p1 (make-position 1 1))
(define p2 (make-position 1 1))
(check (not (eq? p1 p2)) "Two position objects must not be eq?"))
(define (test)
(run-test test-creation "Position: creation and getters")
(run-test test-mutators "Position: mutators")
(run-test test-equal "Position: equal?")
(run-test test-move "Position: move")
(run-test test-identity "Position: identity"))))

30
pacman-project/tests/test-score.rkt
View File

@@ -1,30 +0,0 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests: Score ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-library (pacman-project tests test-score)
(import (scheme base)
(pp1 tests)
(pacman-project adt-score))
(export test)
(begin
;; Test startscore
(define (test-startscore)
(define s (maak-score))
(check-eq? (s 'punten) 0 "Startscore moet 0 zijn"))
;; Test score verhoging
(define (test-verhoog)
(define s (maak-score))
((s 'verhoog!))
(check-eq? (s 'punten) 10 "Score moet 10 zijn na 1 muntje")
((s 'verhoog!))
(check-eq? (s 'punten) 20 "Score moet 20 zijn na 2 muntjes"))
(define (test)
(run-test test-startscore "Score: startscore")
(run-test test-verhoog "Score: verhoging"))))

55
pacman-project/tests/test-tijdslimiet.rkt
View File

@@ -1,55 +0,0 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests: Tijdslimiet ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-library (pacman-project tests test-tijdslimiet)
(import (scheme base)
(pp1 tests)
(pacman-project adt-tijdslimiet))
(export test)
(begin
;; Test starttijd
(define (test-starttijd)
(define t (maak-tijdslimiet))
(check-eq? (t 'resterende-tijd) 60 "Starttijd moet 60 seconden zijn")
(check (not ((t 'tijd-op?))) "Tijd mag niet op zijn bij start"))
;; Test verlaag na 1 seconde
(define (test-verlaag)
(define t (maak-tijdslimiet))
((t 'verlaag!) 1000)
(check-eq? (t 'resterende-tijd) 59 "Tijd moet 59 zijn na 1 seconde"))
;; Test verhoog (muntje bonus)
(define (test-verhoog)
(define t (maak-tijdslimiet))
((t 'verlaag!) 1000)
((t 'verhoog!))
(check-eq? (t 'resterende-tijd) 60 "Tijd moet 60 zijn na verlaag + verhoog"))
;; Test formatteer-tijd
(define (test-formatteer)
(define t (maak-tijdslimiet))
(check-eq? ((t 'formatteer-tijd)) "1:00" "60 seconden = 1:00")
((t 'verlaag!) 1000)
(check-eq? ((t 'formatteer-tijd)) "0:59" "59 seconden = 0:59"))
;; Test tijd-op?
(define (test-tijd-op)
(define t (maak-tijdslimiet))
;; 60 keer verlagen met 1 seconde
(do ((i 0 (+ i 1)))
((= i 60))
((t 'verlaag!) 1000))
(check ((t 'tijd-op?)) "Tijd moet op zijn na 60 seconden"))
(define (test)
(run-test test-starttijd "Tijdslimiet: starttijd")
(run-test test-verlaag "Tijdslimiet: verlaag")
(run-test test-verhoog "Tijdslimiet: verhoog")
(run-test test-formatteer "Tijdslimiet: formatteer-tijd")
(run-test test-tijd-op "Tijdslimiet: tijd-op?"))))

55
pacman-project/tests/test-timer.rkt Normal file
View File

@@ -0,0 +1,55 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests: Timer ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-library (pacman-project tests test-timer)
(import (scheme base)
(pp1 tests)
(pacman-project adt-timer))
(export test)
(begin
;; Test initial time
(define (test-initial)
(define t (make-timer))
(check-eq? (t 'remaining-time) 60 "Initial time should be 60 seconds")
(check (not ((t 'time-up?))) "Time should not be up at start"))
;; Test decrease after 1 second
(define (test-decrease)
(define t (make-timer))
((t 'decrease!) 1000)
(check-eq? (t 'remaining-time) 59 "Time should be 59 after 1 second"))
;; Test increase (coin bonus)
(define (test-increase)
(define t (make-timer))
((t 'decrease!) 1000)
((t 'increase!))
(check-eq? (t 'remaining-time) 60 "Time should be 60 after decrease + increase"))
;; Test format-time
(define (test-format)
(define t (make-timer))
(check-eq? ((t 'format-time)) "1:00" "60 seconds = 1:00")
((t 'decrease!) 1000)
(check-eq? ((t 'format-time)) "0:59" "59 seconds = 0:59"))
;; Test time-up?
(define (test-time-up)
(define t (make-timer))
;; Decrease 60 times by 1 second
(do ((i 0 (+ i 1)))
((= i 60))
((t 'decrease!) 1000))
(check ((t 'time-up?)) "Time should be up after 60 seconds"))
(define (test)
(run-test test-initial "Timer: initial time")
(run-test test-decrease "Timer: decrease")
(run-test test-increase "Timer: increase")
(run-test test-format "Timer: format-time")
(run-test test-time-up "Timer: time-up?"))))

40
snake-wpo/adt-appel.rkt Normal file
View File

@@ -0,0 +1,40 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Appel ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-library ()
(import (scheme base))
(export maak-appel)
(begin
;; ADT Appel
;; maak-appel :: positie -> appel
;; positie :: appel -> positie
;; positie! :: appel, positie -> /
;; maak-appel :: positie -> appel
(define (maak-appel positie)
;; positie! :: positie -> /
(define (positie! nieuwe-positie)
(set! positie nieuwe-positie))
(define (dispatch-appel msg)
(cond ((eq? msg 'positie) positie)
((eq? msg 'positie!) positie!)
(else (error "Appel ADT -- Onbekend bericht:" msg))))
dispatch-appel)
;; Merk op dat de `dispatch-appel` procedure niet in de beschrijving van het ADT
;; staat! Deze procedure wordt gebruikt om het ADT in een object-gebaseerde
;; stijl te implementeren. De beschrijving van het ADT bevat alleen de operaties
;; die beschikbaar zijn in de dispatch-procedure. Dat betekent dat een procedure
;; die niet beschikbaar gesteld wordt in de dispatch-procedure, geen deel
;; uitmaakt van de beschrijving van het ADT.
))

182
snake-wpo/adt-level.rkt Normal file
View File

@@ -0,0 +1,182 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Level ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-library ()
(import (scheme base)
(snake-wpo adt-appel)
(snake-wpo adt-positie)
(snake-wpo adt-slang)
(snake-wpo hulp-procedures)
(snake-wpo constanten))
(export maak-level)
(begin
;; Dit voorbeeldspel bestaat uit slechts 1 level. We zouden de appel en slang
;; rechtstreeks in het Spel ADT kunnen geïmplementeerd hebben. Maar, als we
;; later echter zouden beslissen om een nieuw soort level toe te voegen dan moet
;; niet heel het Spel ADT aangepast worden. Door deze opsplitsing te maken moet
;; alleen de implementatie van het Level ADT aangepast worden.
;; maak-level :: number, number -> level
(define (maak-level aantal-cellen-breedte aantal-cellen-hoogte)
(let* ((slang-start-positie
(maak-positie (quotient aantal-cellen-breedte 2)
(quotient aantal-cellen-hoogte 2)))
(slang-object (maak-slang slang-start-positie))
(appel-object #f)
(appel-tijd 0)
(slang-tijd 0))
;;
;; Hulpprocedures
;;
;; Deze procedures genereren een random positie in de spelwereld.
;; In dit eenvoudig spel is er geen check om te controleren of er al een
;; object op de gegenereerde locatie is.
;; random-x-waarde :: / -> number
(define (random-x-waarde)
(random aantal-cellen-breedte))
;; random-y-waarde :: / -> number
(define (random-y-waarde)
(random aantal-cellen-hoogte))
;;
;; Logica Appel
;;
;; Deze is hier geïmplementeerd omdat voor een appel op een nieuwe positie
;; te zetten, de afmetingen van het spelbord geweten moeten worden.
;; Als dit geïmplementeerd zou zijn in het Appel ADT, dan zou het Appel ADT
;; ook afhankelijk zijn van het Level ADT. Om deze afhankelijkheid te
;; vermijden is deze logica hier geïmplementeerd.
;; random-positie :: / -> positie
(define (random-positie)
(let ((x (random-x-waarde))
(y (random-y-waarde)))
(maak-positie x y)))
;; randomise-appel! :: / -> /
(define (randomise-appel!)
(if appel-object
(let ((nieuwe-positie (random-positie))
(appel-positie (appel-object 'positie)))
;; Verplaats de appel naar een nieuwe positie!
((appel-positie 'x!) (nieuwe-positie 'x))
((appel-positie 'y!) (nieuwe-positie 'y))
;; Reset de timer
(set! appel-tijd 0))))
;; nieuwe-appel! :: / -> /
(define (nieuwe-appel!)
(set! appel-object (maak-appel (random-positie)))
;; Vergeet ook niet om de `adt-appel`-library te importeren (zie bovenaan).
;; Alternatieve oplossing:
;; Je kan ook in de `let*` bovenaan (lijn 17) de `appel-object` variabele
;; initialiseren met `(maak-appel (maak-positie 2 2))`. Merk op dat
;; de `(random-positie)` procedure hier nog niet gedefinieërd is en je deze
;; dus elders moet implementeren.
(set! appel-tijd 0))
;; beweeg-appel! :: / -> /
(define (beweeg-appel! delta-tijd)
(set! appel-tijd (+ appel-tijd delta-tijd))
(if (> appel-tijd appel-refresh-rate)
(randomise-appel!)))
;;
;; Logica Slang
;;
;; We hebben ervoor gekozen om alle logica dat te maken heeft met het
;; bewegen van de slang in het Level ADT zelf te implementeren. Dit omdat
;; een deel van de logica voor het bewegen afhankelijk is van de positie
;; van de appel. We zouden er ook voor gekozen kunnen hebben om deze in het
;; Slang ADT zelf te implementeren, maar dan moet het Slang ADT toegang
;; krijgen tot informatie dat bij het level hoort.
;; Het voordeel van dit hier te implementeren is dat we geen complexiteit
;; toevoegen om die data te delen. Het nadeel is dat een deel van de logica
;; die conceptueel bij het Slang ADT zou moeten horen, niet in het Slang ADT
;; geïmplementeerd is.
;; Bepaal in je eigen project wanneer je welke methode toepast! Je gemaakte
;; keuzes moeten zorgen tot een goede codekwaliteit.
;; beweeg-slang! :: / -> /
(define (beweeg-slang!)
(if (> slang-tijd slang-snelheid)
(begin
;; Laat de slang 1 eenheid "vooruit" bewegen
(slang-object 'beweeg!)
;; Kijk of de slang botst met de appel.
(if appel-object
(let* ((appel-positie (appel-object 'positie))
(overlappingen ((slang-object 'voor-alle-stukken)
(lambda (stuk)
((appel-positie 'vergelijk?) (stuk 'positie))))))
(if (member #t overlappingen)
(begin (slang-object 'verleng!)
(nieuwe-appel!)))))
;; Reset de timer.
(set! slang-tijd 0))))
;; draai-slang! :: symbol -> /
(define (draai-slang! toets)
(cond
((eq? toets 'right)
((slang-object 'richting!) 'rechts))
((eq? toets 'left)
((slang-object 'richting!) 'links))
((eq? toets 'up)
((slang-object 'richting!) 'omhoog))
((eq? toets 'down)
((slang-object 'richting!) 'omlaag))))
;;
;; Algemene Logica
;;
;; update! :: number -> /
(define (update! delta-tijd)
(set! slang-tijd (+ slang-tijd delta-tijd))
(beweeg-appel! delta-tijd)
(beweeg-slang!))
;; toets :: any -> /
(define (toets! toets)
(draai-slang! toets))
;;
;; Initialisatie
;;
(nieuwe-appel!)
;;
;; Dispatch
;;
(define (dispatch-level msg)
(cond ((eq? msg 'update!) update!)
((eq? msg 'toets!) toets!)
((eq? msg 'appel) appel-object)
((eq? msg 'slang) slang-object)
(else (error "Level ADT -- Onbekend bericht:" msg))))
dispatch-level))))

91
snake-wpo/adt-positie.rkt Normal file
View File

@@ -0,0 +1,91 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Positie ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-library ()
(import (scheme base))
(export maak-positie)
(begin
;; maak-positie :: number, number -> position
(define (maak-positie x y)
;; We voorzien twee soorten "beweeg" procedures: een functionele (zonder
;; assignments, die dus een nieuw objectje teruggeeft), en destructieve (met
;; assignments, die de interne variabelen van het objectje aanpast).
;; In deze oplossing worden beiden manieren gebruikt omdat beiden op
;; verschillende plaatsen in het spel gebruikt worden.
;; x! :: number -> /
(define (x! nieuwe-x)
(set! x nieuwe-x))
;; y! :: number -> /
(define (y! nieuwe-y)
(set! y nieuwe-y))
;; vergelijk? :: positie -> boolean
(define (vergelijk? andere-positie)
(and (= x (andere-positie 'x))
(= y (andere-positie 'y))))
;; Merk volgende eigenaardigheid op bij onderstaande code...
;;
;; (define pos1 (maak-positie 10 20))
;; (define pos2 (maak-positie 10 20))
;; (eq? pos1 pos2) ; -> #f
;; ((pos1 'vergelijk?) pos2) ; -> #t
;;
;; De ingebouwde `eq?` van Scheme vergelijkt of twee waardes identiek
;; hetzelfde zijn. `pos1` en `pos2` wijzen naar verschillende procedures (want
;; elk hebben een andere omgeving). Daarom geeft `eq?` #f terug in deze
;; situatie.
;;
;; Merk ook op dat deze implementatie gebruik maakt van `=` want zowel van de
;; variabele `x` als de variabele `y` wordt verwacht dat deze numbers zijn.
;; Als je zeker bent dat twee values number zijn, maak dan altijd gebruik van
;; `=` en niet van `eq?`. Kijk naar de documentatie van R7RS voor meer
;; informatie over het verschil tussen `=`, `eq?` maar ook tussen `equal?` en
;; `eqv?`.
(define (beweeg richting)
(cond ((eq? richting 'omhoog) (maak-positie x (- y 1)))
((eq? richting 'omlaag) (maak-positie x (+ y 1)))
((eq? richting 'links) (maak-positie (- x 1) y))
((eq? richting 'rechts) (maak-positie (+ x 1) y))))
;; Er zijn meerdere manieren om een positie te veranderen. Ofwel pas je met
;; behulp van `x!` en `y!` de waarde van een positie-object aan, ofwel
;; genereer je een nieuw positie-object (zoals `beweeg`) die je dan vervolgens
;; aan een ander object kan toewijzen (bijvoorbeeld met `positie!`)
;; Beiden zijn goede methodes voor je spellogica (of zelfs tekenlogica) te
;; implementeren. Documenteer goed welke keuzes je maakt in jouw spel.
;; In dit spel worden beiden gebruikt: de logica voor een slang te laten
;; bewegen maakt gebruik van `beweeg`, maar de logica om een appel op een
;; nieuwe positie te plaatsen maakt gebruik van `x!` en `y!`.
;; Merk op dat we bij de conditional hierboven een `else` tak geplaatst
;; hebben. Mocht deze procedure opgeroepen worden met een foutief symbool (of
;; andere type van waarde) zal er onmiddellijk een foutmelding gegenereerd
;; worden. Hierdoor kan je sneller bepaalde bugs mee oplossen en bespaar je
;; onnodig debugging-werk. Indien je geen else-tak voorziet zal Scheme een
;; #<void> teruggeven als resultaat.
(define (dispatch-positie msg)
(cond ((eq? msg 'x) x)
((eq? msg 'y) y)
((eq? msg 'x!) x!)
((eq? msg 'y!) y!)
((eq? msg 'beweeg) beweeg)
((eq? msg 'vergelijk?) vergelijk?)
(else (error "Positie ADT -- Onbekend bericht:" msg))))
dispatch-positie)))

33
snake-wpo/adt-slang-stuk.rkt Normal file
View File

@@ -0,0 +1,33 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Slang Stuk ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-library ()
(import (scheme base))
(export maak-slang-stuk)
(begin
;; We willen een slang voorstellen. Dit doen we natuurlijk door meerdere
;; lichaamsdelen te tekenen. We hebben een hoofd en de rest van de staart die
;; bestaat uit verschillende blokjes. Om het gemakkelijk te maken stellen we het
;; hoofd hetzelfde voor als het lichaam. Dit wil zeggen dat de slang
;; uiteindelijk zal bestaan uit een lijst van objectjes van het Slang Stuk ADT.
;; maak-slang-stuk :: positie -> slang-stuk
(define (maak-slang-stuk positie)
;; positie! :: positie -> /
(define (positie! nieuwe-positie)
(set! positie nieuwe-positie))
;; Dispatch functie
(define (dispatch-slang-stuk msg)
(cond ((eq? msg 'positie) positie)
((eq? msg 'positie!) positie!)
(else (error "Slang Stuk ADT -- Onbekend bericht:" msg))))
dispatch-slang-stuk)))

77
snake-wpo/adt-slang.rkt Normal file
View File

@@ -0,0 +1,77 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Slang ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-library ()
(import (scheme base)
(snake-wpo adt-slang-stuk))
(export maak-slang)
(begin
(define (maak-slang start-positie)
(let ((stukken (list (maak-slang-stuk start-positie)))
(richting 'omhoog))
;; Deze procedure voegt een stuk toe aan de slang. Namelijk aan de
;; voorkant van de slang. Dit doen we om twee redenen. Enerzijds omdat
;; `cons` de snelste manier is om dit te doen, maar anderzijds ook omdat
;; dit het updaten van de slang gemakkelijker maakt. Alle andere stukken
;; mogen blijven staan. Dit zal duidelijk worden bij het updaten van de
;; positie.
;; maak-langer! :: / -> /
(define (maak-langer!)
(let* ((hoofd (car stukken))
(nieuwe-positie (((hoofd 'positie) 'beweeg) richting))
(nieuw-stuk (maak-slang-stuk nieuwe-positie)))
(set! stukken (cons nieuw-stuk stukken))))
;; Deze procedure laat de slang bewegen. Dit doet hij door de positie van
;; het hoofd-object te nemen, en aan de hand van de huidige richting een
;; nieuwe positie te berekenen. Daarna wordt de positie van elk deeltje één
;; plaats opgeschoven zodanig dat het eerste deeltje op de nieuwe positie
;; staat, en het tweede deeltje op de oude positie van het eerste deeltje
;; en zo verder...
;; beweeg! :: / -> /
(define (beweeg!)
(define (iter lst new-pos)
(let* ((first (car lst))
(rest (cdr lst))
(old-pos (first 'positie)))
((first 'positie!) new-pos)
(if (not (null? rest))
(iter rest old-pos))))
(let* ((hoofd (car stukken))
(volgende-positie (((hoofd 'positie) 'beweeg) richting)))
(iter stukken volgende-positie)))
;; set-richting! :: symbol -> /
(define (set-richting! r)
(set! richting r))
;; voor-alle-stukken :: (slang-stuk -> any) -> list
(define (voor-alle-stukken f)
(map f stukken))
;; Merk op dat het signatuur van de `voor-alle-stukken` procedure een
;; genest signatuur bevat: dat is namelijk het signatuur van de procedure
;; die aan de `voor-alle-stukken` procedure zelf meegegeven wordt.
;; Het signatuur zegt dus dat de `voor-alle-stukken` procedure zelf een
;; procedure binnenneemt en een lijst teruggeeft, en dat die procedure een
;; procedure moet zijn die van een slang-stuk objectje naar eender welke
;; andere waarde gaat.
(define (dispatch-slang msg)
(cond ((eq? msg 'verleng!) (maak-langer!))
((eq? msg 'richting!) set-richting!)
((eq? msg 'beweeg!) (beweeg!))
((eq? msg 'voor-alle-stukken) voor-alle-stukken)
(else (error "Slang ADT -- Onbekend bericht:" msg))))
dispatch-slang))))

52
snake-wpo/adt-spel.rkt Normal file
View File

@@ -0,0 +1,52 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Spel ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-library ()
(import (scheme base)
(snake-wpo adt-level)
(snake-wpo constanten)
(snake-wpo adt-teken))
(export maak-spel)
(begin
;; maak-spel :: / -> spel
(define (maak-spel)
;; Dit is het eigenlijk spel object.
(let ((level (maak-level spel-breedte spel-hoogte))
(teken (maak-teken venster-breedte-px venster-hoogte-px)))
;; toets-procedure :: symbol, any -> /
(define (toets-procedure status toets)
;; status is ofwel gelijk aan ...
;; - 'pressed: wanneer de toets ingedrukt wordt
;; - 'released: wanneer de toets losgelaten wordt
;; Wanneer de toets voor lange tijd ingedrukt wordt, dan wordt deze
;; procedure meermaals aangeroepen waarbij status gelijk is aan 'pressed
;; voor dezelfde toets!
(if (eq? status 'pressed)
((level 'toets!) toets)))
;; spel-lus-procedure :: number -> /
(define (spel-lus-procedure delta-tijd)
((level 'update!) delta-tijd))
(define (teken-procedure)
((teken 'teken-spel!) dispatch-spel))
(define (start!)
;; Stel de callbacks in voor het teken ADT: implementatie van de spellus.
((teken 'set-spel-lus-functie!) spel-lus-procedure)
((teken 'set-toets-functie!) toets-procedure)
((teken 'start-tekenen!) dispatch-spel))
;; Dispatch functie
(define (dispatch-spel msg)
(cond ((eq? msg 'start!) start!)
((eq? msg 'level) level)
(else (error "Spel ADT -- Onbekend bericht:" msg))))
dispatch-spel))))

188
snake-wpo/adt-teken.rkt Normal file
View File

@@ -0,0 +1,188 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Teken ADT ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-library ()
(import (scheme base)
(pp1 graphics)
(snake-wpo constanten))
(export maak-teken)
(begin
;; maak-teken :: number, number -> teken
(define (maak-teken pixels-horizontaal pixels-verticaal)
(let ((venster (make-window pixels-horizontaal pixels-verticaal "Snake")))
;;
;; Configureren van het spelvenster
;;
((venster 'set-background!) "black")
;;
;; Slang stukken tiles beheren
;; Voor een slang te tekenen moeten we een dynamisch aantal stukken
;; tekenen. Het is dus onmogelijk om op voorhand deze 'tiles' te
;; definieren. Daarom gaan we dus een associatie-lijst bijhouden van tiles.
;; Elk element in die lijst zal dus een cons-cell zijn waarbij de car gelijk
;; is aan het object, en de cdr die tile is die gebruikt wordt om dat object
;; op het scherm te tekenen.
;;
(define slang-laag ((venster 'new-layer!)))
(define slang-tiles '())
;; voeg-slang-stuk-toe! :: slang-stuk -> tile
(define (voeg-slang-stuk-toe! slang-stuk)
(let ((nieuwe-tile
(make-bitmap-tile "images/snake.png" "images/snake-mask.png")))
(set! slang-tiles (cons (cons slang-stuk nieuwe-tile) slang-tiles))
((slang-laag 'add-drawable!) nieuwe-tile)
nieuwe-tile))
;; neem-slang-stuk :: slang-stuk -> tile
(define (neem-slang-stuk slang-stuk)
(let ((result (assoc slang-stuk slang-tiles)))
(if result
(cdr result)
(voeg-slang-stuk-toe! slang-stuk))))
;; OPGELET: Merk op dat er geen code aanwezig is om tiles te verwijderen.
;; In dit voorbeeldspel was dit niet nodig. Maar in een complex spel zal je
;; ook tiles moeten verwijderen als ze niet meer nodig zijn. Hou hier
;; rekening mee wanneer je jouw spel implementeert!
;;
;; Appel tiles beheren
;; In dit voorbeeldspel is er slechts 1 appel, dus 1 vaste tile in het Teken
;; ADT is voldoende.
;;
(define appel-laag ((venster 'new-layer!)))
(define appel-tile
(make-bitmap-tile "images/apple.png" "images/apple-mask.png"))
((appel-laag 'add-drawable!) appel-tile)
;; OPGELET: Omdat er in dit spel slechts één appel zichtbaar is hebben wij
;; de implementatie van het tekenen van appels eenvoudig gemaakt door
;; slechts één tile aan te maken die steeds hergebruikt wordt. Denk na wat
;; er gebeurd als er meerdere appels tegelijkertijd moeten verschijnen als
;; er maar één tile is... Hoe is dit probleem opgelost bij
;; OPGELET: Merk op dat de volgorde waarin lagen aangemaakt worden een
;; invloed hebben op hoe je spel getekend wordt. Lagen worden op het scherm
;; getekend van oud-naar-nieuw. Dat betekent dat de tiles op de appel-laag
;; getekend zullen worden bovenop de tiles op de slang-laag.
;;
;; Teken Functies
;;
;; Generieke teken procedure
;; teken-object! :: any tile -> /
(define (teken-object! obj tile)
(let* ((obj-x ((obj 'positie) 'x))
(obj-y ((obj 'positie) 'y))
(screen-x (* cel-breedte-px obj-x))
(screen-y (* cel-hoogte-px obj-y)))
((tile 'set-x!) screen-x)
((tile 'set-y!) screen-y)))
;; Schrijf je spellogica nooit in pixels. Dit zorgt ervoor dat je spel kan
;; werken ongeacht de specifieke resolutie of hardware (denk aan een matrix
;; van LED-lichtjes t.o.v. pixels op een computerscherm). De omzetting van
;; spellogica naar tekenlogica gebeurt hier door de coördinaten in de
;; spellogica te vermenigvuldigen met de afmetingen (in pixels) van een cel.
;;
;; Informatie over werken met tiles en lagen kan teruggevonden worden in de
;; documentatie van de grafische bibliotheek en wordt dus niet hier in
;; detail besproken.
;; Appel
;; teken-appel! :: appel -> /
(define (teken-appel! appel)
(if appel
(teken-object! appel appel-tile)))
;; Slang
;; teken-slang-stuk! :: slang-stuk -> /
(define (teken-slang-stuk! slang-stuk)
(let ((tile (neem-slang-stuk slang-stuk)))
(teken-object! slang-stuk tile)))
;; Spel
;; teken-spel! :: spel -> /
(define (teken-spel! spel)
(teken-level! (spel 'level)))
;; Level
;; teken-level! :: level -> /
(define (teken-level! level)
(teken-appel! (level 'appel))
(teken-slang! (level 'slang)))
;; Slang
;; teken-slang! :: slang -> /
(define (teken-slang! slang)
((slang 'voor-alle-stukken) teken-slang-stuk!))
;;
;; Callbacks instellen
;;
;; set-spel-lus-functie! :: (number -> /) -> /
(define (set-spel-lus-functie! fun)
((venster 'set-update-callback!) fun))
;; set-toets-functie! :: (symbol, any -> /) -> /
(define (set-toets-functie! fun)
((venster 'set-key-callback!) fun))
;; set-klik-functie! :: (symbol, symbol, number, number -> /) -> /
(define (set-klik-functie! fun)
(define (aangepaste-functie btn evt x y)
(let ((grid-x (quotient x cel-breedte-px))
(grid-y (quotient y cel-hoogte-px)))
(fun btn evt grid-x grid-y)))
((venster 'set-mouse-click-callback!) aangepaste-functie))
;; Merk op dat deze procedure, net zoals de `teken-object!` procedure
;; hierboven een omzetting doet van het coördinatensysteem. Dit gaat van
;; teken-coördinaat naar spel-coördinaat, dus in plaats van te
;; vermenigvuldigen moeten we hier delen (`quotient` is deling zonder rest).
;; start-tekenen! :: / -> /
(define (start-tekenen! spel)
((venster 'set-draw-callback!) (lambda ()
(teken-spel! spel))))
;;
;; Dispatch
;;
(define (dispatch-teken msg)
(cond ((eq? msg 'set-toets-functie!) set-toets-functie!)
((eq? msg 'set-spel-lus-functie!) set-spel-lus-functie!)
((eq? msg 'set-klik-functie!) set-klik-functie!)
((eq? msg 'start-tekenen!) start-tekenen!)
(else (error "Teken ADT -- Onbekend bericht:" msg))))
dispatch-teken))))

53
snake-wpo/constanten.rkt Normal file
View File

@@ -0,0 +1,53 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Constanten ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; We maken eerst een lijstje met variabelen die ons spel zullen
;; configureren. Uiteraard willen we niet dat deze "magic constants" doorheen
;; het hele programma verspreid staan. Dit heeft als gevolg dat wanneer je
;; bijvoorbeeld het formaat van het spel wil aanpassen je dan doorheen je hele
;; code moet graven en zoeken om dit te doen. Het abstraheren van deze waardes
;; in variabelen zorgt voor heel flexibele code.
(define-library ()
(import (scheme base))
(export cel-breedte-px
cel-hoogte-px
spel-breedte
spel-hoogte
venster-breedte-px
venster-hoogte-px
appel-refresh-rate
slang-snelheid)
(begin
(define cel-breedte-px 20)
(define cel-hoogte-px 20)
(define spel-breedte 20)
(define spel-hoogte 20)
(define venster-breedte-px (* cel-breedte-px spel-breedte))
(define venster-hoogte-px (* cel-hoogte-px spel-hoogte))
;; Hoe lang een appel op dezelfde plaats blijft staan...
(define appel-refresh-rate 20000) ;; 20000 milliseconden = 20 seconden
;; Aan welke snelheid de slang ongeveer beweegt...
(define slang-snelheid 200) ;; 200 milliseconden = 0.2 seconden
;; De code in dit bestand moet abstractie maken van hoe of wat de elementen
;; (de appel en de slang) getekend worden. Deze taken zijn namelijk uitbesteed
;; aan het teken-ADT (en zo aan de Graphics.rkt library). Vermits de code hier
;; niet weet of het teken-ADT gaat tekenen naar een computerscherm, of elke
;; frame naar een kleurenprinter gaat sturen, of gaat uitbeelden in kiezeltjes
;; op de grond, of... mag de code in dit bestand niet geschreven worden in
;; functie van pixels (of punten/kiezels/etc.) In plaats daarvan werken we met
;; een abstract grid dat het speelvenster voorstelt. De volgende berekeningen
;; zijn nodig voor het Teken ADT. Het is jouw taak om de spellogica zodanig te
;; schrijven dat deze onafhankelijk is van de tekenlogica.
))

39
snake-wpo/hulp-procedures.rkt Normal file
View File

@@ -0,0 +1,39 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Hulp Procedures ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Het schrijven van algemene hulpprocedures die niet specifiek bij een ADT
;; horen kan vaak nuttig zijn. Dit kan gaan van procedures voor het eenvoudiger
;; om iets te debuggen, of om een bepaald patroon op standaard datatypes van
;; Scheme te voorzien dat niet standaard aanwezig is. E.g., als je in je
;; implementatie regelmatig, en op verschillende plaatsen, de som van een lijst
;; getallen nodig hebt kan je in de globale omgeving daar een procedure voor
;; voorzien. De juiste hulpprocedures ondersteunen hierbij de rest van je
;; implementatie.
(define-library ()
(import (scheme base)
(scheme write))
(export debug random)
(begin
;; We bieden de `random` van Racket simpel opnieuw aan.
;; De `#%require`-syntax is speciaal aan de Racket-implementatie van R7RS en
;; is gelijkaardig aan de `import` van R7RS (maar mag ook elders gebruikt
;; worden).
;; Voor je eigen project is het gebruiken van `random` op deze manier
;; uiteraard ook toegestaan. Het importeren van andere procedures uit
;; Racket, die niet beschikbaar zijn in R7RS, is ook toegelaten, maar
;; sommige procedures kunnen niet toegepast worden op enkele datastructuren
;; die R7RS gebruikt (bv. lijsten). Gebruik `#%require` dus op eigen risico.
(#%require (only racket random))
;; Een hulpprocedure om eenvoudig mee te debuggen (door de boolean op `#f` te zetten wordt er niets meer geprint).
(define debugging? #t)
(define (debug . msg)
(if debugging?
(begin (display msg)
(newline))))))

BIN
snake-wpo/images/apple-mask.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 649 B

BIN
snake-wpo/images/apple.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 673 B

BIN
snake-wpo/images/snake-mask.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 5.1 KiB

BIN
snake-wpo/images/snake.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 4.5 KiB

16
snake-wpo/spel.rkt Normal file
View File

@@ -0,0 +1,16 @@
#lang r7rs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Spel Opstarten ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Om dit spel op te starten zal je de `snake-wpo` map eerst moeten uitpakken en
;; vervolgens moeten installeren. Vervolgens kan je jouw aanpassingen maken door
;; de bestanden in deze map aan te passen: je moet niet opnieuw de map
;; installeren.
(import (scheme base)
(snake-wpo adt-spel))
(define spel (maak-spel))
((spel 'start!))

19
snake-wpo/tests/alle-testen.rkt Normal file
View File

@@ -0,0 +1,19 @@
#lang r7rs
(import (scheme base)
(pp1 tests)
(prefix (snake-wpo tests test-positie) positie:)
(prefix (snake-wpo tests test-appel) appel:))
;; Omdat dit project onvolledig is hebben we enkel testcode voorzien
;; voor enkele oefeningen uit het WPO. Voor je eigen project raden we
;; je aan om voor elk ADT minstens één test te voorzien. Een apart
;; bestand waarin je alle testen combineert, zoals dit, helpt
;; om snel alle functionaliteit van je project (waar een test voor
;; geschreven is) te controleren.
(define (test-alles)
(positie:test)
(appel:test))
(test-alles)

27
snake-wpo/tests/test-appel.rkt Normal file
View File

@@ -0,0 +1,27 @@
#lang r7rs
(define-library ()
(import (scheme base)
(scheme write)
(pp1 tests)
(snake-wpo adt-positie)
(snake-wpo adt-appel))
(export test)
(begin
(define (test-oefening-4)
;; We maken twee aparte positie-objecten die een verschillende y-oordinaat hebben
(define p1 (maak-positie 5 5))
(define p2 (maak-positie 10 5))
(define appel (maak-appel p1))
(check-eq? (appel 'positie) p1 "Verwacht dat de positie ingesteld is")
((appel 'positie!) p2)
(check-not-eq? (appel 'positie) p1 "Verwacht dat de positie aangepast is")
(check-eq? (appel 'positie) p2 "Verwacht dat de positie aangepast is"))
(define (test)
(run-test test-oefening-4 "Oefening 4"))))
;; Voor de test uit te voeren voer je onderstaande code uit in de REPL:
;;
;; (test)

28
snake-wpo/tests/test-positie.rkt Normal file
View File

@@ -0,0 +1,28 @@
#lang r7rs
(define-library ()
(import (scheme base)
(pp1 tests)
(snake-wpo adt-positie))
(export test)
(begin
(define (test-oefening-1)
;; We maken twee aparte positie-objecten die een verschillende y-oordinaat hebben
(define p1 (maak-positie 100 200))
(define p2 (maak-positie 100 600))
;; We controleren eerst dat beiden een apart object zijn
(check (not (eq? p1 p2)) "Beide positie-objecten mogen niet eq?-gelijk zijn")
;; We controleren of ze verschillend zijn met de eigen 'vergelijk?-operatie...
(check (not ((p1 'vergelijk?) p2)) "Beide posities mogen niet gelijk zijn aan elkaar!")
;; We object `p2` aan zodanig dat `p1` en `p2` dezelfde `x` en `y` hebben.
((p2 'y!) 200)
;; En we doen de controle met de 'vergelijk?-operatie opnieuw, maar deze keer moeten ze gelijk zijn aan elkaar
(check ((p1 'vergelijk?) p2) "Beide posities moeten gelijk zijn aan elkaar!"))
(define (test)
(run-test test-oefening-1 "Oefening 1"))))
;; Voor de test uit te voeren voer je onderstaande code uit in de REPL:
;;
;; (test)