Compare commits
16 Commits
c3c3c6e86c
...
fix/ghost-
| Author | SHA1 | Date | |
|---|---|---|---|
f2cb49ad2b
|
|||
|
0e14140db9 | ||
|
|
5e7456eba9 | ||
|
|
f251478dd6 | ||
|
|
9028dd031c | ||
|
|
91b548e0bf | ||
|
|
b18aa49e8b | ||
|
|
3f12a740da | ||
|
|
eb309b74b1 | ||
|
|
55f1c2a382 | ||
|
|
5b43b3c8d5 | ||
|
|
4c98ca61c5 | ||
|
|
39a91a5aa0 | ||
|
|
1ac72f03a7 | ||
|
|
caac996acd | ||
|
|
cd70055bc7 |
@@ -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)))
|
|
||||||
@@ -1,175 +0,0 @@
|
|||||||
#lang r7rs
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;; Level ADT ;;
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
;; Het level bevat alle spellogica: beweging van Pac-Man, botsingsdetectie,
|
|
||||||
;; muntjes eten, sleutel oppakken, deuren openen, teleportatie, pauze en
|
|
||||||
;; tijdsbeheer. Bevat GEEN grafische code.
|
|
||||||
|
|
||||||
(define-library (pacman-project adt-level)
|
|
||||||
(import (scheme base)
|
|
||||||
(pacman-project constanten)
|
|
||||||
(pacman-project adt-positie)
|
|
||||||
(pacman-project adt-doolhof)
|
|
||||||
(pacman-project adt-pacman)
|
|
||||||
(pacman-project adt-sleutel)
|
|
||||||
(pacman-project adt-score)
|
|
||||||
(pacman-project adt-tijdslimiet))
|
|
||||||
(export maak-level)
|
|
||||||
|
|
||||||
(begin
|
|
||||||
|
|
||||||
;; maak-level :: -> level
|
|
||||||
;; Maakt een nieuw level aan met alle spelobjecten.
|
|
||||||
(define (maak-level)
|
|
||||||
(let ((doolhof (maak-doolhof))
|
|
||||||
(pacman (maak-pacman 5 2))
|
|
||||||
(sleutel #f)
|
|
||||||
(score (maak-score))
|
|
||||||
(tijdslimiet (maak-tijdslimiet))
|
|
||||||
(gepauzeerd? #f))
|
|
||||||
|
|
||||||
;; Initialiseer de sleutel nadat het doolhof is aangemaakt.
|
|
||||||
(set! sleutel (maak-sleutel doolhof))
|
|
||||||
|
|
||||||
;;
|
|
||||||
;; Richting helpers
|
|
||||||
;;
|
|
||||||
|
|
||||||
;; richting->delta :: symbol -> (number . number)
|
|
||||||
;; Converteert een richting naar een (delta-rij . delta-kolom) paar.
|
|
||||||
(define (richting->delta richting)
|
|
||||||
(cond ((eq? richting 'rechts) (cons 0 1))
|
|
||||||
((eq? richting 'links) (cons 0 -1))
|
|
||||||
((eq? richting 'omhoog) (cons -1 0))
|
|
||||||
((eq? richting 'omlaag) (cons 1 0))
|
|
||||||
(else (cons 0 0))))
|
|
||||||
|
|
||||||
;;
|
|
||||||
;; Muntje logica
|
|
||||||
;;
|
|
||||||
|
|
||||||
;; eet-muntje! :: number, number -> /
|
|
||||||
;; Verwijdert het muntje op de cel en past score/tijd aan.
|
|
||||||
(define (eet-muntje! rij kolom)
|
|
||||||
((doolhof 'cel-set!) rij kolom cel-type-leeg)
|
|
||||||
((score 'verhoog!))
|
|
||||||
((tijdslimiet 'verhoog!)))
|
|
||||||
|
|
||||||
;;
|
|
||||||
;; Sleutel logica
|
|
||||||
;;
|
|
||||||
|
|
||||||
;; pak-sleutel-op! :: number, number -> /
|
|
||||||
;; Pakt de sleutel op en maakt de cel leeg.
|
|
||||||
(define (pak-sleutel-op! rij kolom)
|
|
||||||
((doolhof 'cel-set!) rij kolom cel-type-leeg)
|
|
||||||
((sleutel 'pak-op!)))
|
|
||||||
|
|
||||||
;;
|
|
||||||
;; Teleportatie logica
|
|
||||||
;;
|
|
||||||
|
|
||||||
;; teleporteer-horizontaal! :: number, number -> /
|
|
||||||
;; Teleporteert Pac-Man naar de andere kant van het doolhof.
|
|
||||||
(define (teleporteer-horizontaal! rij kolom)
|
|
||||||
(let ((pac-pos (pacman 'positie)))
|
|
||||||
(cond ((< kolom 0)
|
|
||||||
((pac-pos 'kolom!) (- (doolhof 'kolommen) 1))
|
|
||||||
((pac-pos 'rij!) rij))
|
|
||||||
((>= kolom (doolhof 'kolommen))
|
|
||||||
((pac-pos 'kolom!) 0)
|
|
||||||
((pac-pos 'rij!) rij)))))
|
|
||||||
|
|
||||||
;;
|
|
||||||
;; Bewegingslogica
|
|
||||||
;;
|
|
||||||
|
|
||||||
;; beweeg-pacman! :: symbol -> /
|
|
||||||
;; Beweegt Pac-Man in de opgegeven richting met alle spelregels.
|
|
||||||
(define (beweeg-pacman! richting)
|
|
||||||
(when (not ((tijdslimiet 'tijd-op?)))
|
|
||||||
(let* ((delta (richting->delta richting))
|
|
||||||
(delta-rij (car delta))
|
|
||||||
(delta-kolom (cdr delta))
|
|
||||||
(huidige-pos (pacman 'positie))
|
|
||||||
(volgende-rij (+ (huidige-pos 'rij) delta-rij))
|
|
||||||
(volgende-kolom (+ (huidige-pos 'kolom) delta-kolom)))
|
|
||||||
|
|
||||||
;; Pas richting aan voor de teken-laag.
|
|
||||||
((pacman 'richting!) richting)
|
|
||||||
|
|
||||||
(cond
|
|
||||||
;; Teleportatie: buiten het grid horizontaal.
|
|
||||||
((or (< volgende-kolom 0) (>= volgende-kolom (doolhof 'kolommen)))
|
|
||||||
(teleporteer-horizontaal! volgende-rij volgende-kolom))
|
|
||||||
|
|
||||||
;; Deur: open alleen als de sleutel opgepakt is.
|
|
||||||
(((doolhof 'deur?) volgende-rij volgende-kolom)
|
|
||||||
(when (sleutel 'opgepakt?)
|
|
||||||
((doolhof 'verwijder-deur!) volgende-rij volgende-kolom)))
|
|
||||||
|
|
||||||
;; Normale beweging: alleen als het geen muur is.
|
|
||||||
(else
|
|
||||||
(when (not ((doolhof 'muur?) volgende-rij volgende-kolom))
|
|
||||||
((pacman 'beweeg!) delta-rij delta-kolom)
|
|
||||||
;; Controleer wat er op de nieuwe positie staat.
|
|
||||||
(cond
|
|
||||||
(((doolhof 'sleutel?) volgende-rij volgende-kolom)
|
|
||||||
(pak-sleutel-op! volgende-rij volgende-kolom))
|
|
||||||
(((doolhof 'muntje?) volgende-rij volgende-kolom)
|
|
||||||
(eet-muntje! volgende-rij volgende-kolom)))))))))
|
|
||||||
|
|
||||||
;;
|
|
||||||
;; Pauze logica
|
|
||||||
;;
|
|
||||||
|
|
||||||
;; wissel-pauze! :: -> /
|
|
||||||
;; Wisselt de pauzetoestand.
|
|
||||||
(define (wissel-pauze!)
|
|
||||||
(set! gepauzeerd? (not gepauzeerd?)))
|
|
||||||
|
|
||||||
;;
|
|
||||||
;; Toets afhandeling
|
|
||||||
;;
|
|
||||||
|
|
||||||
;; toets! :: symbol -> /
|
|
||||||
;; Verwerkt een toetsaanslag.
|
|
||||||
(define (toets! toets)
|
|
||||||
(cond
|
|
||||||
((eq? toets 'escape) (wissel-pauze!))
|
|
||||||
((not gepauzeerd?)
|
|
||||||
(cond
|
|
||||||
((eq? toets 'right) (beweeg-pacman! 'rechts))
|
|
||||||
((eq? toets 'left) (beweeg-pacman! 'links))
|
|
||||||
((eq? toets 'up) (beweeg-pacman! 'omhoog))
|
|
||||||
((eq? toets 'down) (beweeg-pacman! 'omlaag))))))
|
|
||||||
|
|
||||||
;;
|
|
||||||
;; Update (spellusfunctie)
|
|
||||||
;;
|
|
||||||
|
|
||||||
;; update! :: number -> /
|
|
||||||
;; Wordt elk frame aangeroepen met het aantal verstreken milliseconden.
|
|
||||||
(define (update! delta-tijd)
|
|
||||||
(when (not gepauzeerd?)
|
|
||||||
((tijdslimiet 'verlaag!) delta-tijd)))
|
|
||||||
|
|
||||||
;;
|
|
||||||
;; Dispatch
|
|
||||||
;;
|
|
||||||
|
|
||||||
(define (dispatch-level msg)
|
|
||||||
(cond ((eq? msg 'doolhof) doolhof)
|
|
||||||
((eq? msg 'pacman) pacman)
|
|
||||||
((eq? msg 'sleutel) sleutel)
|
|
||||||
((eq? msg 'score) score)
|
|
||||||
((eq? msg 'tijdslimiet) tijdslimiet)
|
|
||||||
((eq? msg 'gepauzeerd?) gepauzeerd?)
|
|
||||||
((eq? msg 'toets!) toets!)
|
|
||||||
((eq? msg 'update!) update!)
|
|
||||||
(else (error "Level ADT -- Onbekend bericht:" msg))))
|
|
||||||
|
|
||||||
dispatch-level))))
|
|
||||||
@@ -1,48 +0,0 @@
|
|||||||
#lang r7rs
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;; Pac-Man ADT ;;
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
;; Het Pac-Man ADT beheert de logische toestand van de speler: positie op het
|
|
||||||
;; grid en de huidige richting. Bevat GEEN grafische code.
|
|
||||||
|
|
||||||
(define-library (pacman-project adt-pacman)
|
|
||||||
(import (scheme base)
|
|
||||||
(pacman-project adt-positie))
|
|
||||||
(export maak-pacman)
|
|
||||||
|
|
||||||
(begin
|
|
||||||
|
|
||||||
;; maak-pacman :: number, number -> pacman
|
|
||||||
;; Maakt een Pac-Man object aan op de opgegeven startpositie (rij, kolom).
|
|
||||||
(define (maak-pacman start-rij start-kolom)
|
|
||||||
(let ((positie (maak-positie start-rij start-kolom))
|
|
||||||
(richting 'rechts))
|
|
||||||
|
|
||||||
;; positie! :: positie -> /
|
|
||||||
;; Vervangt de huidige positie.
|
|
||||||
(define (positie! nieuwe-positie)
|
|
||||||
(set! positie nieuwe-positie))
|
|
||||||
|
|
||||||
;; richting! :: symbol -> /
|
|
||||||
;; Past de huidige richting aan.
|
|
||||||
(define (richting! nieuwe-richting)
|
|
||||||
(set! richting nieuwe-richting))
|
|
||||||
|
|
||||||
;; beweeg! :: number, number -> /
|
|
||||||
;; Verplaatst Pac-Man met een delta op het grid.
|
|
||||||
(define (beweeg! delta-rij delta-kolom)
|
|
||||||
((positie 'rij!) (+ (positie 'rij) delta-rij))
|
|
||||||
((positie 'kolom!) (+ (positie 'kolom) delta-kolom)))
|
|
||||||
|
|
||||||
;; dispatch-pacman :: symbol -> any
|
|
||||||
(define (dispatch-pacman msg)
|
|
||||||
(cond ((eq? msg 'positie) positie)
|
|
||||||
((eq? msg 'positie!) positie!)
|
|
||||||
((eq? msg 'richting) richting)
|
|
||||||
((eq? msg 'richting!) richting!)
|
|
||||||
((eq? msg 'beweeg!) beweeg!)
|
|
||||||
(else (error "Pac-Man ADT -- Onbekend bericht:" msg))))
|
|
||||||
|
|
||||||
dispatch-pacman))))
|
|
||||||
@@ -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)))
|
|
||||||
@@ -1,32 +0,0 @@
|
|||||||
#lang r7rs
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;; Score ADT ;;
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
;; Houdt de score bij. Bevat GEEN grafische code.
|
|
||||||
|
|
||||||
(define-library (pacman-project adt-score)
|
|
||||||
(import (scheme base)
|
|
||||||
(pacman-project constanten))
|
|
||||||
(export maak-score)
|
|
||||||
|
|
||||||
(begin
|
|
||||||
|
|
||||||
;; maak-score :: -> score
|
|
||||||
;; Maakt een nieuw score-object aan, startend bij 0.
|
|
||||||
(define (maak-score)
|
|
||||||
(let ((punten 0))
|
|
||||||
|
|
||||||
;; verhoog! :: -> /
|
|
||||||
;; Verhoogt de score met het aantal punten per muntje.
|
|
||||||
(define (verhoog!)
|
|
||||||
(set! punten (+ punten punten-per-muntje)))
|
|
||||||
|
|
||||||
;; dispatch-score :: symbol -> any
|
|
||||||
(define (dispatch-score msg)
|
|
||||||
(cond ((eq? msg 'punten) punten)
|
|
||||||
((eq? msg 'verhoog!) verhoog!)
|
|
||||||
(else (error "Score ADT -- Onbekend bericht:" msg))))
|
|
||||||
|
|
||||||
dispatch-score))))
|
|
||||||
@@ -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))))
|
|
||||||
@@ -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))))
|
|
||||||
@@ -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))))
|
|
||||||
@@ -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))))
|
|
||||||
419
pacman-project/adt/draw.rkt
Normal file
419
pacman-project/adt/draw.rkt
Normal file
@@ -0,0 +1,419 @@
|
|||||||
|
#lang r7rs
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Draw ADT ;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
;; All graphics logic is isolated in this ADT. Game logic knows nothing about
|
||||||
|
;; pixels, windows, or sprites. Grid-to-pixel conversion happens exclusively
|
||||||
|
;; here.
|
||||||
|
;;
|
||||||
|
;; Performance: coins, UI, maze, key, and pause are only redrawn when their
|
||||||
|
;; underlying state changes. The draw callback tracks previous values and
|
||||||
|
;; skips unchanged elements.
|
||||||
|
|
||||||
|
(define-library (pacman-project adt draw)
|
||||||
|
(import (scheme base)
|
||||||
|
(pp1 graphics)
|
||||||
|
(pacman-project constants))
|
||||||
|
(export make-draw)
|
||||||
|
|
||||||
|
(begin
|
||||||
|
|
||||||
|
;; make-draw :: number, number -> draw
|
||||||
|
;; Creates the draw object that handles all rendering.
|
||||||
|
(define (make-draw width height)
|
||||||
|
(let ((window (make-window width height "PAC-MAN")))
|
||||||
|
|
||||||
|
((window 'set-background!) color-background)
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Layers (order determines draw order)
|
||||||
|
;;
|
||||||
|
|
||||||
|
(define header-layer ((window 'new-layer!)))
|
||||||
|
(define maze-layer ((window 'new-layer!)))
|
||||||
|
(define coins-layer ((window 'new-layer!)))
|
||||||
|
(define key-layer ((window 'new-layer!)))
|
||||||
|
(define ghost-layer ((window 'new-layer!)))
|
||||||
|
(define pacman-layer ((window 'new-layer!)))
|
||||||
|
(define ui-layer ((window 'new-layer!)))
|
||||||
|
(define overlay-layer ((window 'new-layer!)))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Header bar — static, drawn once
|
||||||
|
;;
|
||||||
|
|
||||||
|
(define header-tile (make-tile width header-height))
|
||||||
|
((header-layer 'add-drawable!) header-tile)
|
||||||
|
|
||||||
|
;; draw-header! :: -> /
|
||||||
|
(define (draw-header!)
|
||||||
|
((header-tile 'draw-rectangle!) 0 0 width header-height color-header-bg)
|
||||||
|
((header-tile 'draw-text!)
|
||||||
|
"PAC-MAN" header-title-size header-title-x header-title-y color-title))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Maze tile
|
||||||
|
;;
|
||||||
|
|
||||||
|
(define maze-tile (make-tile width height))
|
||||||
|
((maze-layer 'add-drawable!) maze-tile)
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Coins tile
|
||||||
|
;;
|
||||||
|
|
||||||
|
(define coins-tile (make-tile width height))
|
||||||
|
((coins-layer 'add-drawable!) coins-tile)
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Key sprite (in the maze)
|
||||||
|
;;
|
||||||
|
|
||||||
|
(define key-sprite (make-bitmap-tile "pacman-sprites/key.png"))
|
||||||
|
((key-sprite 'set-scale!) sprite-scale-key)
|
||||||
|
((key-layer 'add-drawable!) key-sprite)
|
||||||
|
|
||||||
|
;; Key UI indicator (shown in header when taken)
|
||||||
|
(define key-ui-sprite (make-bitmap-tile "pacman-sprites/key.png"))
|
||||||
|
((key-ui-sprite 'set-scale!) sprite-scale-key-ui)
|
||||||
|
((key-ui-sprite 'set-x!) key-ui-x)
|
||||||
|
((key-ui-sprite 'set-y!) key-ui-y)
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Coordinate conversion
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; grid->pixel-x :: number -> number
|
||||||
|
(define (grid->pixel-x col)
|
||||||
|
(* cell-size-px col))
|
||||||
|
|
||||||
|
;; grid->pixel-y :: number -> number
|
||||||
|
(define (grid->pixel-y row)
|
||||||
|
(+ (* row cell-size-px) maze-offset-y))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Ghost sprites
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; load-direction-seq :: string, string -> tile-sequence
|
||||||
|
;; Loads a 2-frame animation sequence for one direction.
|
||||||
|
(define (load-direction-seq prefix dir-name)
|
||||||
|
(let ((seq (make-tile-sequence
|
||||||
|
(list (make-bitmap-tile
|
||||||
|
(string-append prefix dir-name "-1.png"))
|
||||||
|
(make-bitmap-tile
|
||||||
|
(string-append prefix dir-name "-2.png"))))))
|
||||||
|
((seq 'set-scale!) sprite-scale-ghost)
|
||||||
|
seq))
|
||||||
|
|
||||||
|
;; make-ghost-draw-state :: string -> ghost-draw-state
|
||||||
|
;; Creates sprite management state for one ghost. Returns a
|
||||||
|
;; dispatch closure for updating position, direction, animation.
|
||||||
|
(define (make-ghost-draw-state name)
|
||||||
|
(let* ((prefix (string-append "pacman-sprites/" name "-"))
|
||||||
|
(up-seq (load-direction-seq prefix "up"))
|
||||||
|
(down-seq (load-direction-seq prefix "down"))
|
||||||
|
(left-seq (load-direction-seq prefix "left"))
|
||||||
|
(right-seq (load-direction-seq prefix "right"))
|
||||||
|
(active-seq left-seq)
|
||||||
|
(cached-dir 'left))
|
||||||
|
;; Add initial sprite to ghost layer
|
||||||
|
((ghost-layer 'add-drawable!) active-seq)
|
||||||
|
|
||||||
|
;; dir->seq :: symbol -> tile-sequence
|
||||||
|
(define (dir->seq dir)
|
||||||
|
(cond ((eq? dir 'up) up-seq)
|
||||||
|
((eq? dir 'down) down-seq)
|
||||||
|
((eq? dir 'left) left-seq)
|
||||||
|
((eq? dir 'right) right-seq)
|
||||||
|
(else left-seq)))
|
||||||
|
|
||||||
|
(define (dispatch msg)
|
||||||
|
(cond
|
||||||
|
;; update! :: number, number, symbol -> /
|
||||||
|
;; Updates position and direction of this ghost's sprite.
|
||||||
|
((eq? msg 'update!)
|
||||||
|
(lambda (row col direction)
|
||||||
|
;; Swap sprite sequence if direction changed
|
||||||
|
(when (not (eq? direction cached-dir))
|
||||||
|
(let ((old-x ((active-seq 'get-x)))
|
||||||
|
(old-y ((active-seq 'get-y))))
|
||||||
|
((ghost-layer 'remove-drawable!) active-seq)
|
||||||
|
(set! active-seq (dir->seq direction))
|
||||||
|
((active-seq 'set-x!) old-x)
|
||||||
|
((active-seq 'set-y!) old-y)
|
||||||
|
((ghost-layer 'add-drawable!) active-seq)
|
||||||
|
(set! cached-dir direction)))
|
||||||
|
;; Update position
|
||||||
|
((active-seq 'set-x!) (grid->pixel-x col))
|
||||||
|
((active-seq 'set-y!) (grid->pixel-y row))))
|
||||||
|
;; animate! :: -> /
|
||||||
|
((eq? msg 'animate!)
|
||||||
|
(lambda () ((active-seq 'set-next!))))
|
||||||
|
(else (error "Ghost draw state -- Unknown message:" msg))))
|
||||||
|
dispatch))
|
||||||
|
|
||||||
|
;; Create draw state for each ghost (in fixed order matching level)
|
||||||
|
(define blinky-draw (make-ghost-draw-state "blinky"))
|
||||||
|
(define pinky-draw (make-ghost-draw-state "pinky"))
|
||||||
|
(define inky-draw (make-ghost-draw-state "inky"))
|
||||||
|
(define clyde-draw (make-ghost-draw-state "clyde"))
|
||||||
|
(define ghost-draw-states (list blinky-draw pinky-draw inky-draw clyde-draw))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Pac-Man sprite
|
||||||
|
;;
|
||||||
|
|
||||||
|
(define pacman-bitmap-tiles
|
||||||
|
(list (make-bitmap-tile "pacman-sprites/pacman-death-1.png")
|
||||||
|
(make-bitmap-tile "pacman-sprites/pacman-closed.png")
|
||||||
|
(make-bitmap-tile "pacman-sprites/pacman-open.png")))
|
||||||
|
|
||||||
|
(define pacman-sprite (make-tile-sequence pacman-bitmap-tiles))
|
||||||
|
((pacman-sprite 'set-scale!) sprite-scale-pacman)
|
||||||
|
((pacman-layer 'add-drawable!) pacman-sprite)
|
||||||
|
|
||||||
|
;; Animation state
|
||||||
|
(define time-since-last-animation 0)
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; UI tile (score + time — redrawn on change)
|
||||||
|
;;
|
||||||
|
|
||||||
|
(define ui-tile (make-tile width height))
|
||||||
|
((ui-layer 'add-drawable!) ui-tile)
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Change tracking — skip redraws when state hasn't changed
|
||||||
|
;;
|
||||||
|
|
||||||
|
(define cached-score -1)
|
||||||
|
(define cached-time "")
|
||||||
|
(define key-sprite-swapped? #f)
|
||||||
|
(define cached-paused? #f)
|
||||||
|
(define cached-game-over? #f)
|
||||||
|
(define coins-dirty? #t)
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Draw functions
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; draw-maze! :: maze -> /
|
||||||
|
(define (draw-maze! maze)
|
||||||
|
((maze-tile 'clear!))
|
||||||
|
((maze 'for-each-cell)
|
||||||
|
(lambda (row col cell-type)
|
||||||
|
(cond
|
||||||
|
((= cell-type cell-type-wall)
|
||||||
|
((maze-tile 'draw-rectangle!)
|
||||||
|
(grid->pixel-x col)
|
||||||
|
(grid->pixel-y row)
|
||||||
|
(- cell-size-px maze-wall-shrink)
|
||||||
|
(- cell-size-px maze-wall-shrink)
|
||||||
|
color-wall))
|
||||||
|
((= cell-type cell-type-door)
|
||||||
|
((maze-tile 'draw-rectangle!)
|
||||||
|
(grid->pixel-x col)
|
||||||
|
(grid->pixel-y row)
|
||||||
|
(- cell-size-px maze-wall-shrink)
|
||||||
|
(- cell-size-px maze-wall-shrink)
|
||||||
|
color-door))))))
|
||||||
|
|
||||||
|
;; draw-coins! :: maze -> /
|
||||||
|
(define (draw-coins! maze)
|
||||||
|
((coins-tile 'clear!))
|
||||||
|
((maze 'for-each-cell)
|
||||||
|
(lambda (row col cell-type)
|
||||||
|
(when (= cell-type cell-type-coin)
|
||||||
|
((coins-tile 'draw-ellipse!)
|
||||||
|
(+ (grid->pixel-x col) coin-inset)
|
||||||
|
(+ (grid->pixel-y row) coin-inset)
|
||||||
|
coin-size
|
||||||
|
coin-size
|
||||||
|
color-coin)))))
|
||||||
|
|
||||||
|
;; init-key-position! :: key -> /
|
||||||
|
(define (init-key-position! key-obj)
|
||||||
|
(let ((pos (key-obj 'position)))
|
||||||
|
((key-sprite 'set-x!) (grid->pixel-x (pos 'col)))
|
||||||
|
((key-sprite 'set-y!) (grid->pixel-y (pos 'row)))))
|
||||||
|
|
||||||
|
;; draw-key! :: key -> /
|
||||||
|
(define (draw-key! key-obj)
|
||||||
|
(when (and (key-obj 'taken?) (not key-sprite-swapped?))
|
||||||
|
((key-layer 'remove-drawable!) key-sprite)
|
||||||
|
((key-layer 'add-drawable!) key-ui-sprite)
|
||||||
|
(set! key-sprite-swapped? #t)))
|
||||||
|
|
||||||
|
;; animate-pacman! :: number -> /
|
||||||
|
(define (animate-pacman! delta-time)
|
||||||
|
(set! time-since-last-animation (+ time-since-last-animation delta-time))
|
||||||
|
(when (>= time-since-last-animation animation-interval-ms)
|
||||||
|
((pacman-sprite 'set-next!))
|
||||||
|
;; Also animate ghost sprites
|
||||||
|
(for-each (lambda (gds) ((gds 'animate!))) ghost-draw-states)
|
||||||
|
(set! time-since-last-animation 0)))
|
||||||
|
|
||||||
|
;; lerp :: number, number, number -> number
|
||||||
|
;; Linear interpolation between a and b by factor t (0..1).
|
||||||
|
(define (lerp a b t)
|
||||||
|
(+ a (* t (- b a))))
|
||||||
|
|
||||||
|
;; draw-pacman! :: pacman, number -> /
|
||||||
|
;; Draws Pac-Man with smooth backward interpolation. Uses
|
||||||
|
;; lerp(prev, current, t) so the visual smoothly transitions
|
||||||
|
;; from the previous tile strictly to the current tile by t=1.
|
||||||
|
(define (draw-pacman! pacman progress)
|
||||||
|
(let* ((pos (pacman 'position))
|
||||||
|
(row (pos 'row))
|
||||||
|
(col (pos 'col))
|
||||||
|
(prev-row (pacman 'prev-row))
|
||||||
|
(prev-col (pacman 'prev-col))
|
||||||
|
(t (max 0 (min progress 1)))
|
||||||
|
(render-row (lerp prev-row row t))
|
||||||
|
(render-col (lerp prev-col col t))
|
||||||
|
(direction (pacman 'direction)))
|
||||||
|
((pacman-sprite 'set-x!) (grid->pixel-x render-col))
|
||||||
|
((pacman-sprite 'set-y!) (grid->pixel-y render-row))
|
||||||
|
(cond ((eq? direction 'right) ((pacman-sprite 'rotate!) rotation-right))
|
||||||
|
((eq? direction 'left) ((pacman-sprite 'rotate!) rotation-left))
|
||||||
|
((eq? direction 'up) ((pacman-sprite 'rotate!) rotation-up))
|
||||||
|
((eq? direction 'down) ((pacman-sprite 'rotate!) rotation-down)))))
|
||||||
|
|
||||||
|
;; draw-ghosts! :: list -> /
|
||||||
|
;; Updates all ghost sprite positions with smooth backward interpolation.
|
||||||
|
(define (draw-ghosts! ghosts)
|
||||||
|
(for-each
|
||||||
|
(lambda (ghost ghost-draw)
|
||||||
|
(let* ((pos (ghost 'position))
|
||||||
|
(row (pos 'row))
|
||||||
|
(col (pos 'col))
|
||||||
|
(prev-row (ghost 'prev-row))
|
||||||
|
(prev-col (ghost 'prev-col))
|
||||||
|
(t (max 0 (min (/ (ghost 'movement-timer) ghost-speed-ms) 1)))
|
||||||
|
(render-row (lerp prev-row row t))
|
||||||
|
(render-col (lerp prev-col col t))
|
||||||
|
(dir (ghost 'direction)))
|
||||||
|
((ghost-draw 'update!) render-row render-col dir)))
|
||||||
|
ghosts ghost-draw-states))
|
||||||
|
|
||||||
|
;; draw-ui! :: score, timer -> /
|
||||||
|
(define (draw-ui! score timer)
|
||||||
|
(let ((current-score (score 'points))
|
||||||
|
(current-time ((timer 'format-time))))
|
||||||
|
(when (or (not (= current-score cached-score))
|
||||||
|
(not (string=? current-time cached-time)))
|
||||||
|
((ui-tile 'clear!))
|
||||||
|
((ui-tile 'draw-text!)
|
||||||
|
"SCORE" score-label-size score-label-x score-label-y color-text)
|
||||||
|
((ui-tile 'draw-text!)
|
||||||
|
(number->string current-score)
|
||||||
|
score-value-size score-value-x score-value-y color-text)
|
||||||
|
((ui-tile 'draw-rectangle!)
|
||||||
|
sidebar-x 0 sidebar-width height color-wall)
|
||||||
|
((ui-tile 'draw-text!)
|
||||||
|
"TIME" time-label-size time-label-x time-label-y color-text)
|
||||||
|
((ui-tile 'draw-text!)
|
||||||
|
current-time
|
||||||
|
time-value-size time-value-x time-value-y color-text)
|
||||||
|
(set! cached-score current-score)
|
||||||
|
(set! cached-time current-time))))
|
||||||
|
|
||||||
|
;; draw-game-over! :: boolean -> /
|
||||||
|
;; Shows GAME OVER when time is up or ghost catches Pac-Man.
|
||||||
|
(define (draw-game-over! is-over?)
|
||||||
|
(when (and is-over? (not cached-game-over?))
|
||||||
|
(let ((overlay-tile (make-tile width height)))
|
||||||
|
((overlay-layer 'add-drawable!) overlay-tile)
|
||||||
|
((overlay-tile 'draw-rectangle!)
|
||||||
|
0 (- game-over-text-y 20) 672 100 color-background)
|
||||||
|
((overlay-tile 'draw-text!)
|
||||||
|
"GAME OVER" game-over-text-size
|
||||||
|
game-over-text-x game-over-text-y color-game-over))
|
||||||
|
(set! cached-game-over? #t)))
|
||||||
|
|
||||||
|
;; draw-pause! :: boolean -> /
|
||||||
|
(define (draw-pause! paused?)
|
||||||
|
(when (not (eq? paused? cached-paused?))
|
||||||
|
((overlay-layer 'empty!))
|
||||||
|
(when paused?
|
||||||
|
(let ((overlay-tile (make-tile width height)))
|
||||||
|
((overlay-layer 'add-drawable!) overlay-tile)
|
||||||
|
((overlay-tile 'draw-rectangle!)
|
||||||
|
0 maze-offset-y 672 (- height maze-offset-y) color-pause-bg)
|
||||||
|
((overlay-tile 'draw-text!)
|
||||||
|
"PAUSED" pause-text-size
|
||||||
|
pause-text-x pause-text-y color-pause-text)))
|
||||||
|
(set! cached-paused? paused?)))
|
||||||
|
|
||||||
|
;; mark-coins-dirty! :: -> /
|
||||||
|
(define (mark-coins-dirty!)
|
||||||
|
(set! coins-dirty? #t))
|
||||||
|
|
||||||
|
;; mark-maze-dirty! :: -> /
|
||||||
|
(define (mark-maze-dirty!)
|
||||||
|
(set! coins-dirty? #t))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Main draw function
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; draw-game! :: game -> /
|
||||||
|
(define (draw-game! game)
|
||||||
|
(let* ((level (game 'level))
|
||||||
|
(timer (level 'timer))
|
||||||
|
(pac-progress (/ (level 'pacman-movement-timer) pacman-speed-ms)))
|
||||||
|
;; Always update (lightweight sprite property sets)
|
||||||
|
(draw-pacman! (level 'pacman) pac-progress)
|
||||||
|
(draw-ghosts! (level 'ghosts))
|
||||||
|
;; Only redraw when dirty / changed
|
||||||
|
(draw-key! (level 'key))
|
||||||
|
(when coins-dirty?
|
||||||
|
(draw-coins! (level 'maze))
|
||||||
|
(draw-maze! (level 'maze))
|
||||||
|
(set! coins-dirty? #f))
|
||||||
|
(draw-ui! (level 'score) timer)
|
||||||
|
(draw-pause! (level 'paused?))
|
||||||
|
(draw-game-over! (or ((timer 'time-up?)) (level 'game-over?)))))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Callback registration
|
||||||
|
;;
|
||||||
|
|
||||||
|
(define (set-game-loop! fun)
|
||||||
|
((window 'set-update-callback!) fun))
|
||||||
|
|
||||||
|
(define (set-key-callback! fun)
|
||||||
|
((window 'set-key-callback!) fun))
|
||||||
|
|
||||||
|
;; start-drawing! :: game -> /
|
||||||
|
(define (start-drawing! game)
|
||||||
|
(let ((level (game 'level)))
|
||||||
|
;; Static elements (drawn once)
|
||||||
|
(draw-header!)
|
||||||
|
(draw-maze! (level 'maze))
|
||||||
|
(draw-coins! (level 'maze))
|
||||||
|
(init-key-position! (level 'key))
|
||||||
|
;; Initialize ghost positions
|
||||||
|
(draw-ghosts! (level 'ghosts))
|
||||||
|
(set! coins-dirty? #f)
|
||||||
|
;; Register draw callback
|
||||||
|
((window 'set-draw-callback!)
|
||||||
|
(lambda () (draw-game! game)))))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Dispatch
|
||||||
|
;;
|
||||||
|
|
||||||
|
(define (dispatch-draw msg)
|
||||||
|
(cond ((eq? msg 'set-game-loop!) set-game-loop!)
|
||||||
|
((eq? msg 'set-key-callback!) set-key-callback!)
|
||||||
|
((eq? msg 'start-drawing!) start-drawing!)
|
||||||
|
((eq? msg 'animate-pacman!) animate-pacman!)
|
||||||
|
((eq? msg 'mark-coins-dirty!) mark-coins-dirty!)
|
||||||
|
((eq? msg 'mark-maze-dirty!) mark-maze-dirty!)
|
||||||
|
(else (error "Draw ADT -- Unknown message:" msg))))
|
||||||
|
|
||||||
|
dispatch-draw))))
|
||||||
53
pacman-project/adt/game.rkt
Normal file
53
pacman-project/adt/game.rkt
Normal file
@@ -0,0 +1,53 @@
|
|||||||
|
#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 and animation.
|
||||||
|
(define (game-loop delta-time)
|
||||||
|
((level 'update!) delta-time)
|
||||||
|
((draw 'animate-pacman!) delta-time))
|
||||||
|
|
||||||
|
;; start! :: -> /
|
||||||
|
;; Starts the game by registering all callbacks and change listeners.
|
||||||
|
(define (start!)
|
||||||
|
;; Wire level change events to draw dirty flags.
|
||||||
|
((level 'set-on-coins-changed!) (draw 'mark-coins-dirty!))
|
||||||
|
((level 'set-on-maze-changed!) (draw 'mark-maze-dirty!))
|
||||||
|
;; Register graphics callbacks.
|
||||||
|
((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))))
|
||||||
114
pacman-project/adt/ghost.rkt
Normal file
114
pacman-project/adt/ghost.rkt
Normal file
@@ -0,0 +1,114 @@
|
|||||||
|
#lang r7rs
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Ghost ADT ;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
;; A ghost has a position, direction, movement mode, and type identity.
|
||||||
|
;; The targeting AI is handled by the level — this ADT only stores state.
|
||||||
|
;; Each ghost instance represents one of the four ghosts (Blinky, Inky,
|
||||||
|
;; Pinky, Clyde). Contains NO graphics code.
|
||||||
|
|
||||||
|
(define-library (pacman-project adt ghost)
|
||||||
|
(import (scheme base)
|
||||||
|
(pacman-project adt position))
|
||||||
|
(export make-ghost)
|
||||||
|
|
||||||
|
(begin
|
||||||
|
|
||||||
|
;; make-ghost :: symbol, number, number, number, number, number -> ghost
|
||||||
|
;; Creates a ghost of the given type at start-row/col with a scatter
|
||||||
|
;; corner target and a house exit delay (0 = starts outside).
|
||||||
|
(define (make-ghost ghost-type start-row start-col
|
||||||
|
scatter-row scatter-col exit-delay)
|
||||||
|
(let ((position (make-position start-row start-col))
|
||||||
|
(direction 'left)
|
||||||
|
(mode (if (= exit-delay 0) 'scatter 'in-house))
|
||||||
|
(scatter-target (make-position scatter-row scatter-col))
|
||||||
|
(house-timer exit-delay)
|
||||||
|
(movement-timer 0)
|
||||||
|
(reverse-queued? #f)
|
||||||
|
(prev-row start-row)
|
||||||
|
(prev-col start-col))
|
||||||
|
|
||||||
|
;; direction! :: symbol -> /
|
||||||
|
(define (direction! new-dir)
|
||||||
|
(set! direction new-dir))
|
||||||
|
|
||||||
|
;; mode! :: symbol -> /
|
||||||
|
;; Sets the ghost mode. When switching between chase/scatter,
|
||||||
|
;; the ghost must reverse direction (queued for next move).
|
||||||
|
(define (mode! new-mode)
|
||||||
|
(when (and (not (eq? mode new-mode))
|
||||||
|
(not (eq? mode 'in-house))
|
||||||
|
(not (eq? new-mode 'in-house)))
|
||||||
|
(set! reverse-queued? #t))
|
||||||
|
(set! mode new-mode))
|
||||||
|
|
||||||
|
;; move! :: number, number -> /
|
||||||
|
;; Saves previous position, then moves by delta.
|
||||||
|
(define (move! delta-row delta-col)
|
||||||
|
(set! prev-row (position 'row))
|
||||||
|
(set! prev-col (position 'col))
|
||||||
|
((position 'row!) (+ (position 'row) delta-row))
|
||||||
|
((position 'col!) (+ (position 'col) delta-col)))
|
||||||
|
|
||||||
|
;; sync-prev! :: -> /
|
||||||
|
;; Sets previous position to current. Call after teleportation
|
||||||
|
;; or ghost house exit to prevent long-range interpolation.
|
||||||
|
(define (sync-prev!)
|
||||||
|
(set! prev-row (position 'row))
|
||||||
|
(set! prev-col (position 'col)))
|
||||||
|
|
||||||
|
;; consume-reverse! :: -> boolean
|
||||||
|
;; Returns #t and clears the flag if a reverse was queued.
|
||||||
|
(define (consume-reverse!)
|
||||||
|
(if reverse-queued?
|
||||||
|
(begin (set! reverse-queued? #f) #t)
|
||||||
|
#f))
|
||||||
|
|
||||||
|
;; update-house-timer! :: number -> /
|
||||||
|
;; Decreases house timer. When it reaches 0, ghost exits.
|
||||||
|
(define (update-house-timer! delta-time)
|
||||||
|
(when (eq? mode 'in-house)
|
||||||
|
(set! house-timer (- house-timer delta-time))
|
||||||
|
(when (<= house-timer 0)
|
||||||
|
(set! mode 'scatter))))
|
||||||
|
|
||||||
|
;; reset-movement-timer! :: -> /
|
||||||
|
(define (reset-movement-timer!)
|
||||||
|
(set! movement-timer 0))
|
||||||
|
|
||||||
|
;; set-movement-timer! :: number -> /
|
||||||
|
(define (set-movement-timer! val)
|
||||||
|
(set! movement-timer val))
|
||||||
|
|
||||||
|
;; advance-movement-timer! :: number -> number
|
||||||
|
;; Returns updated movement timer value.
|
||||||
|
(define (advance-movement-timer! delta-time)
|
||||||
|
(set! movement-timer (+ movement-timer delta-time))
|
||||||
|
movement-timer)
|
||||||
|
|
||||||
|
;; dispatch-ghost :: symbol -> any
|
||||||
|
(define (dispatch-ghost msg)
|
||||||
|
(cond ((eq? msg 'position) position)
|
||||||
|
((eq? msg 'direction) direction)
|
||||||
|
((eq? msg 'direction!) direction!)
|
||||||
|
((eq? msg 'type) ghost-type)
|
||||||
|
((eq? msg 'mode) mode)
|
||||||
|
((eq? msg 'mode!) mode!)
|
||||||
|
((eq? msg 'move!) move!)
|
||||||
|
((eq? msg 'prev-row) prev-row)
|
||||||
|
((eq? msg 'prev-col) prev-col)
|
||||||
|
((eq? msg 'sync-prev!) sync-prev!)
|
||||||
|
((eq? msg 'scatter-target) scatter-target)
|
||||||
|
((eq? msg 'in-house?) (eq? mode 'in-house))
|
||||||
|
((eq? msg 'consume-reverse!) consume-reverse!)
|
||||||
|
((eq? msg 'update-house-timer!) update-house-timer!)
|
||||||
|
((eq? msg 'movement-timer) movement-timer)
|
||||||
|
((eq? msg 'advance-movement-timer!) advance-movement-timer!)
|
||||||
|
((eq? msg 'reset-movement-timer!) reset-movement-timer!)
|
||||||
|
((eq? msg 'set-movement-timer!) set-movement-timer!)
|
||||||
|
(else (error "Ghost ADT -- Unknown message:" msg))))
|
||||||
|
|
||||||
|
dispatch-ghost))))
|
||||||
55
pacman-project/adt/key.rkt
Normal file
55
pacman-project/adt/key.rkt
Normal 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))))
|
||||||
524
pacman-project/adt/level.rkt
Normal file
524
pacman-project/adt/level.rkt
Normal file
@@ -0,0 +1,524 @@
|
|||||||
|
#lang r7rs
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Level ADT ;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
;; Contains all game logic: automatic Pac-Man movement, ghost AI, collision
|
||||||
|
;; detection, coin/key pickup, door opening, teleportation, pause, and time
|
||||||
|
;; management. Pac-Man moves automatically in its current direction. Arrow
|
||||||
|
;; keys queue a desired turn direction, which is applied at the next movement
|
||||||
|
;; tick if the path is clear. Ghost targeting follows the original Pac-Man
|
||||||
|
;; AI: Blinky chases directly, Pinky targets ahead, Inky uses vector
|
||||||
|
;; doubling from Blinky, Clyde is shy within 8 tiles. Contains NO graphics.
|
||||||
|
|
||||||
|
(define-library (pacman-project adt level)
|
||||||
|
(import (scheme base)
|
||||||
|
(pacman-project constants)
|
||||||
|
(pacman-project adt position)
|
||||||
|
(pacman-project adt maze)
|
||||||
|
(pacman-project adt pacman)
|
||||||
|
(pacman-project adt ghost)
|
||||||
|
(pacman-project adt key)
|
||||||
|
(pacman-project adt score)
|
||||||
|
(pacman-project adt timer))
|
||||||
|
(export make-level)
|
||||||
|
|
||||||
|
(begin
|
||||||
|
|
||||||
|
;; make-level :: -> level
|
||||||
|
;; Creates a new level with all game objects including four ghosts.
|
||||||
|
(define (make-level)
|
||||||
|
(let ((maze (make-maze))
|
||||||
|
(pacman (make-pacman 5 2))
|
||||||
|
(key #f)
|
||||||
|
(score (make-score))
|
||||||
|
(timer (make-timer))
|
||||||
|
(paused? #f)
|
||||||
|
(game-over? #f)
|
||||||
|
(queued-direction #f)
|
||||||
|
(movement-timer 0)
|
||||||
|
(on-coins-changed! (lambda () #f))
|
||||||
|
(on-maze-changed! (lambda () #f))
|
||||||
|
(on-ghosts-changed! (lambda () #f)))
|
||||||
|
|
||||||
|
;; Initialize key after maze is created.
|
||||||
|
(set! key (make-key maze))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Create four ghosts
|
||||||
|
;;
|
||||||
|
|
||||||
|
(define blinky
|
||||||
|
(make-ghost 'blinky
|
||||||
|
blinky-start-row blinky-start-col
|
||||||
|
blinky-scatter-row blinky-scatter-col
|
||||||
|
0))
|
||||||
|
|
||||||
|
(define pinky
|
||||||
|
(make-ghost 'pinky
|
||||||
|
pinky-start-row pinky-start-col
|
||||||
|
pinky-scatter-row pinky-scatter-col
|
||||||
|
pinky-exit-delay))
|
||||||
|
|
||||||
|
(define inky
|
||||||
|
(make-ghost 'inky
|
||||||
|
inky-start-row inky-start-col
|
||||||
|
inky-scatter-row inky-scatter-col
|
||||||
|
inky-exit-delay))
|
||||||
|
|
||||||
|
(define clyde
|
||||||
|
(make-ghost 'clyde
|
||||||
|
clyde-start-row clyde-start-col
|
||||||
|
clyde-scatter-row clyde-scatter-col
|
||||||
|
clyde-exit-delay))
|
||||||
|
|
||||||
|
(define ghosts (list blinky pinky inky clyde))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Ghost mode cycling
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; Mode schedule: alternating scatter/chase durations.
|
||||||
|
;; After the last entry, ghosts stay in chase forever.
|
||||||
|
(define mode-schedule
|
||||||
|
(list (cons 'scatter scatter-duration-1)
|
||||||
|
(cons 'chase chase-duration-1)
|
||||||
|
(cons 'scatter scatter-duration-2)
|
||||||
|
(cons 'chase chase-duration-2)
|
||||||
|
(cons 'scatter scatter-duration-3)))
|
||||||
|
|
||||||
|
(define current-schedule mode-schedule)
|
||||||
|
(define mode-timer (if (null? mode-schedule) 0 (cdar mode-schedule)))
|
||||||
|
(define global-mode 'scatter)
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Direction helpers
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; direction->delta :: symbol -> (number . number)
|
||||||
|
(define (direction->delta direction)
|
||||||
|
(cond ((eq? direction 'right) (cons 0 1))
|
||||||
|
((eq? direction 'left) (cons 0 -1))
|
||||||
|
((eq? direction 'up) (cons -1 0))
|
||||||
|
((eq? direction 'down) (cons 1 0))
|
||||||
|
(else (cons 0 0))))
|
||||||
|
|
||||||
|
;; reverse-direction :: symbol -> symbol
|
||||||
|
(define (reverse-direction dir)
|
||||||
|
(cond ((eq? dir 'right) 'left)
|
||||||
|
((eq? dir 'left) 'right)
|
||||||
|
((eq? dir 'up) 'down)
|
||||||
|
((eq? dir 'down) 'up)
|
||||||
|
(else dir)))
|
||||||
|
|
||||||
|
;; can-move? :: symbol -> boolean
|
||||||
|
;; Checks if Pac-Man can move in the given direction.
|
||||||
|
(define (can-move? direction)
|
||||||
|
(let* ((delta (direction->delta direction))
|
||||||
|
(current-pos (pacman 'position))
|
||||||
|
(next-row (+ (current-pos 'row) (car delta)))
|
||||||
|
(next-col (+ (current-pos 'col) (cdr delta))))
|
||||||
|
(cond
|
||||||
|
((or (< next-col 0) (>= next-col (maze 'cols))) #t)
|
||||||
|
(((maze 'wall?) next-row next-col) #f)
|
||||||
|
(((maze 'door?) next-row next-col) (key 'taken?))
|
||||||
|
(else #t))))
|
||||||
|
|
||||||
|
;; ghost-can-move? :: ghost, symbol -> boolean
|
||||||
|
;; Checks if a ghost can move in the given direction.
|
||||||
|
;; Active ghosts cannot re-enter the ghost house.
|
||||||
|
(define (ghost-can-move? ghost direction)
|
||||||
|
(let* ((delta (direction->delta direction))
|
||||||
|
(pos (ghost 'position))
|
||||||
|
(next-row (+ (pos 'row) (car delta)))
|
||||||
|
(next-col (+ (pos 'col) (cdr delta))))
|
||||||
|
(cond
|
||||||
|
;; Off-grid horizontally: tunnel
|
||||||
|
((or (< next-col 0) (>= next-col (maze 'cols))) #t)
|
||||||
|
;; Walls block
|
||||||
|
(((maze 'wall?) next-row next-col) #f)
|
||||||
|
;; All doors block active ghosts (including ghost house door)
|
||||||
|
(((maze 'door?) next-row next-col) #f)
|
||||||
|
(else #t))))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Distance calculation
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; squared-distance :: number, number, number, number -> number
|
||||||
|
(define (squared-distance r1 c1 r2 c2)
|
||||||
|
(+ (* (- r1 r2) (- r1 r2))
|
||||||
|
(* (- c1 c2) (- c1 c2))))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Ghost targeting AI
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; ghost-target :: ghost -> (number . number)
|
||||||
|
;; Returns the target tile (row . col) for the ghost based on its
|
||||||
|
;; current mode and type-specific AI.
|
||||||
|
(define (ghost-target ghost)
|
||||||
|
(let ((mode (ghost 'mode)))
|
||||||
|
(cond
|
||||||
|
;; Scatter: head to assigned corner
|
||||||
|
((eq? mode 'scatter)
|
||||||
|
(let ((st (ghost 'scatter-target)))
|
||||||
|
(cons (st 'row) (st 'col))))
|
||||||
|
|
||||||
|
;; Chase: type-specific targeting
|
||||||
|
((eq? mode 'chase)
|
||||||
|
(let* ((pac-pos (pacman 'position))
|
||||||
|
(pac-row (pac-pos 'row))
|
||||||
|
(pac-col (pac-pos 'col))
|
||||||
|
(pac-dir (pacman 'direction))
|
||||||
|
(ghost-type (ghost 'type)))
|
||||||
|
(cond
|
||||||
|
;; Blinky: target Pac-Man directly
|
||||||
|
((eq? ghost-type 'blinky)
|
||||||
|
(cons pac-row pac-col))
|
||||||
|
|
||||||
|
;; Pinky: target 2 tiles ahead of Pac-Man
|
||||||
|
;; Original bug: when facing up, also offset 2 left
|
||||||
|
((eq? ghost-type 'pinky)
|
||||||
|
(let ((ahead (direction->delta pac-dir)))
|
||||||
|
(if (eq? pac-dir 'up)
|
||||||
|
(cons (+ pac-row (* (car ahead) pinky-look-ahead))
|
||||||
|
(+ pac-col (* (cdr ahead) pinky-look-ahead) (- pinky-look-ahead)))
|
||||||
|
(cons (+ pac-row (* (car ahead) pinky-look-ahead))
|
||||||
|
(+ pac-col (* (cdr ahead) pinky-look-ahead))))))
|
||||||
|
|
||||||
|
;; Inky: double the vector from Blinky to 2-ahead-of-Pac-Man
|
||||||
|
((eq? ghost-type 'inky)
|
||||||
|
(let* ((ahead (direction->delta pac-dir))
|
||||||
|
(pivot-row (+ pac-row (* (car ahead) pinky-look-ahead)))
|
||||||
|
(pivot-col (+ pac-col (* (cdr ahead) pinky-look-ahead)))
|
||||||
|
(blinky-pos (blinky 'position)))
|
||||||
|
(cons (+ pivot-row (- pivot-row (blinky-pos 'row)))
|
||||||
|
(+ pivot-col (- pivot-col (blinky-pos 'col))))))
|
||||||
|
|
||||||
|
;; Clyde: chase Pac-Man, but scatter when within 8 tiles
|
||||||
|
((eq? ghost-type 'clyde)
|
||||||
|
(let* ((ghost-pos (ghost 'position))
|
||||||
|
(dist-sq (squared-distance
|
||||||
|
(ghost-pos 'row) (ghost-pos 'col)
|
||||||
|
pac-row pac-col)))
|
||||||
|
(if (< dist-sq (* clyde-shy-distance clyde-shy-distance))
|
||||||
|
(let ((st (ghost 'scatter-target)))
|
||||||
|
(cons (st 'row) (st 'col)))
|
||||||
|
(cons pac-row pac-col))))
|
||||||
|
|
||||||
|
;; Fallback
|
||||||
|
(else (cons pac-row pac-col)))))
|
||||||
|
|
||||||
|
;; Default (in-house etc): stay put
|
||||||
|
(else
|
||||||
|
(let ((pos (ghost 'position)))
|
||||||
|
(cons (pos 'row) (pos 'col)))))))
|
||||||
|
|
||||||
|
;; choose-ghost-direction :: ghost -> symbol
|
||||||
|
;; Picks the best direction for the ghost at its current tile.
|
||||||
|
;; Cannot reverse; chooses direction minimizing distance to target.
|
||||||
|
;; Tie-break order: up, left, down, right.
|
||||||
|
(define (choose-ghost-direction ghost)
|
||||||
|
(let* ((target (ghost-target ghost))
|
||||||
|
(target-row (car target))
|
||||||
|
(target-col (cdr target))
|
||||||
|
(current-dir (ghost 'direction))
|
||||||
|
(reverse-dir (reverse-direction current-dir))
|
||||||
|
(pos (ghost 'position))
|
||||||
|
(row (pos 'row))
|
||||||
|
(col (pos 'col))
|
||||||
|
(candidates '(up left down right)))
|
||||||
|
(let loop ((dirs candidates)
|
||||||
|
(best-dir current-dir)
|
||||||
|
(best-dist 999999999))
|
||||||
|
(if (null? dirs)
|
||||||
|
;; If no valid direction found, reverse as last resort
|
||||||
|
(if (= best-dist 999999999) reverse-dir best-dir)
|
||||||
|
(let* ((dir (car dirs))
|
||||||
|
(delta (direction->delta dir))
|
||||||
|
(nr (+ row (car delta)))
|
||||||
|
(nc (+ col (cdr delta))))
|
||||||
|
(if (and (not (eq? dir reverse-dir))
|
||||||
|
(ghost-can-move? ghost dir))
|
||||||
|
(let ((dist (squared-distance nr nc target-row target-col)))
|
||||||
|
(if (< dist best-dist)
|
||||||
|
(loop (cdr dirs) dir dist)
|
||||||
|
(loop (cdr dirs) best-dir best-dist)))
|
||||||
|
(loop (cdr dirs) best-dir best-dist)))))))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Ghost movement
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; move-ghost! :: ghost -> /
|
||||||
|
;; Moves a ghost one tile in its chosen direction.
|
||||||
|
(define (move-ghost! ghost)
|
||||||
|
(let* ((dir (ghost 'direction))
|
||||||
|
(delta (direction->delta dir))
|
||||||
|
(pos (ghost 'position))
|
||||||
|
(next-row (+ (pos 'row) (car delta)))
|
||||||
|
(next-col (+ (pos 'col) (cdr delta))))
|
||||||
|
;; Handle tunnel teleportation
|
||||||
|
(cond
|
||||||
|
((< next-col 0)
|
||||||
|
((pos 'col!) (- (maze 'cols) 1))
|
||||||
|
((ghost 'sync-prev!)))
|
||||||
|
((>= next-col (maze 'cols))
|
||||||
|
((pos 'col!) 0)
|
||||||
|
((ghost 'sync-prev!)))
|
||||||
|
(else
|
||||||
|
((ghost 'move!) (car delta) (cdr delta))))))
|
||||||
|
|
||||||
|
;; advance-ghost! :: ghost -> /
|
||||||
|
;; Chooses direction and moves one ghost.
|
||||||
|
(define (advance-ghost! ghost)
|
||||||
|
(when (not (ghost 'in-house?))
|
||||||
|
;; Handle queued reverse from mode change
|
||||||
|
(when ((ghost 'consume-reverse!))
|
||||||
|
((ghost 'direction!) (reverse-direction (ghost 'direction))))
|
||||||
|
;; Choose best direction at current tile
|
||||||
|
(let ((new-dir (choose-ghost-direction ghost)))
|
||||||
|
((ghost 'direction!) new-dir)
|
||||||
|
(move-ghost! ghost))
|
||||||
|
(on-ghosts-changed!)))
|
||||||
|
|
||||||
|
;; exit-ghost-house! :: ghost -> /
|
||||||
|
;; Moves a ghost from inside the house to the exit position.
|
||||||
|
(define (exit-ghost-house! ghost)
|
||||||
|
(let ((pos (ghost 'position)))
|
||||||
|
((pos 'row!) ghost-house-exit-row)
|
||||||
|
((pos 'col!) ghost-house-exit-col)
|
||||||
|
((ghost 'direction!) 'left)
|
||||||
|
((ghost 'sync-prev!))
|
||||||
|
(on-ghosts-changed!)))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Ghost-Pacman collision
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; check-ghost-collision! :: -> /
|
||||||
|
;; Checks if any ghost occupies the same tile as Pac-Man.
|
||||||
|
(define (check-ghost-collision!)
|
||||||
|
(let ((pac-pos (pacman 'position)))
|
||||||
|
(for-each
|
||||||
|
(lambda (ghost)
|
||||||
|
(when (and (not (ghost 'in-house?))
|
||||||
|
(= ((ghost 'position) 'row) (pac-pos 'row))
|
||||||
|
(= ((ghost 'position) 'col) (pac-pos 'col)))
|
||||||
|
(set! game-over? #t)))
|
||||||
|
ghosts)))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Mode cycling
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; update-ghost-mode! :: number -> /
|
||||||
|
;; Advances the global mode timer and switches scatter/chase.
|
||||||
|
(define (update-ghost-mode! delta-time)
|
||||||
|
(when (not (null? current-schedule))
|
||||||
|
(set! mode-timer (- mode-timer delta-time))
|
||||||
|
(when (<= mode-timer 0)
|
||||||
|
(set! current-schedule (cdr current-schedule))
|
||||||
|
(if (null? current-schedule)
|
||||||
|
;; Permanent chase after schedule ends
|
||||||
|
(begin
|
||||||
|
(set! global-mode 'chase)
|
||||||
|
(for-each (lambda (g) ((g 'mode!) 'chase)) ghosts))
|
||||||
|
(let ((next-mode (caar current-schedule))
|
||||||
|
(next-duration (cdar current-schedule)))
|
||||||
|
(set! global-mode next-mode)
|
||||||
|
(set! mode-timer next-duration)
|
||||||
|
(for-each (lambda (g)
|
||||||
|
(when (not (g 'in-house?))
|
||||||
|
((g 'mode!) next-mode)))
|
||||||
|
ghosts))))))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Update ghosts
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; update-ghosts! :: number -> /
|
||||||
|
;; Updates all ghost timers, house exits, and movement.
|
||||||
|
(define (update-ghosts! delta-time)
|
||||||
|
(for-each
|
||||||
|
(lambda (ghost)
|
||||||
|
;; Update house timer for ghosts still inside
|
||||||
|
(let ((was-in-house? (ghost 'in-house?)))
|
||||||
|
((ghost 'update-house-timer!) delta-time)
|
||||||
|
;; Ghost just exited house
|
||||||
|
(when (and was-in-house? (not (ghost 'in-house?)))
|
||||||
|
(exit-ghost-house! ghost)
|
||||||
|
((ghost 'mode!) global-mode)))
|
||||||
|
;; Movement tick for active ghosts (carry residual time)
|
||||||
|
(when (not (ghost 'in-house?))
|
||||||
|
(let ((mt ((ghost 'advance-movement-timer!) delta-time)))
|
||||||
|
(when (>= mt ghost-speed-ms)
|
||||||
|
(advance-ghost! ghost)
|
||||||
|
((ghost 'set-movement-timer!) (- mt ghost-speed-ms))))))
|
||||||
|
ghosts))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Coin logic
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; eat-coin! :: number, number -> /
|
||||||
|
(define (eat-coin! row col)
|
||||||
|
((maze 'cell-set!) row col cell-type-empty)
|
||||||
|
((score 'increase!))
|
||||||
|
((timer 'increase!))
|
||||||
|
(on-coins-changed!))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Key logic
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; pick-up-key! :: number, number -> /
|
||||||
|
(define (pick-up-key! row col)
|
||||||
|
((maze 'cell-set!) row col cell-type-empty)
|
||||||
|
((key 'take!))
|
||||||
|
(on-coins-changed!))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Teleportation logic
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; teleport-horizontal! :: number, number -> /
|
||||||
|
(define (teleport-horizontal! row col)
|
||||||
|
(let ((pac-pos (pacman 'position)))
|
||||||
|
(cond ((< col 0)
|
||||||
|
((pac-pos 'col!) (- (maze 'cols) 1))
|
||||||
|
((pac-pos 'row!) row))
|
||||||
|
((>= col (maze 'cols))
|
||||||
|
((pac-pos 'col!) 0)
|
||||||
|
((pac-pos 'row!) row)))
|
||||||
|
;; Prevent interpolation across the entire map
|
||||||
|
((pacman 'sync-prev!))))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Movement logic
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; move-pacman! :: symbol -> /
|
||||||
|
(define (move-pacman! direction)
|
||||||
|
(let* ((delta (direction->delta direction))
|
||||||
|
(delta-row (car delta))
|
||||||
|
(delta-col (cdr delta))
|
||||||
|
(current-pos (pacman 'position))
|
||||||
|
(next-row (+ (current-pos 'row) delta-row))
|
||||||
|
(next-col (+ (current-pos 'col) delta-col)))
|
||||||
|
|
||||||
|
((pacman 'direction!) direction)
|
||||||
|
|
||||||
|
(cond
|
||||||
|
((or (< next-col 0) (>= next-col (maze 'cols)))
|
||||||
|
(teleport-horizontal! next-row next-col))
|
||||||
|
|
||||||
|
(((maze 'door?) next-row next-col)
|
||||||
|
(when (key 'taken?)
|
||||||
|
((maze 'remove-door!) next-row next-col)
|
||||||
|
(on-maze-changed!)))
|
||||||
|
|
||||||
|
(else
|
||||||
|
(when (not ((maze 'wall?) next-row next-col))
|
||||||
|
((pacman 'move!) delta-row delta-col)
|
||||||
|
(cond
|
||||||
|
(((maze 'key?) next-row next-col)
|
||||||
|
(pick-up-key! next-row next-col))
|
||||||
|
(((maze 'coin?) next-row next-col)
|
||||||
|
(eat-coin! next-row next-col))))))))
|
||||||
|
|
||||||
|
;; advance-pacman! :: -> /
|
||||||
|
(define (advance-pacman!)
|
||||||
|
(when (not (or ((timer 'time-up?)) game-over?))
|
||||||
|
(let* ((current-dir (pacman 'direction))
|
||||||
|
(pos-before-row ((pacman 'position) 'row))
|
||||||
|
(pos-before-col ((pacman 'position) 'col)))
|
||||||
|
(cond
|
||||||
|
((and queued-direction (can-move? queued-direction))
|
||||||
|
(move-pacman! queued-direction)
|
||||||
|
(set! queued-direction #f))
|
||||||
|
((can-move? current-dir)
|
||||||
|
(move-pacman! current-dir)))
|
||||||
|
;; If pacman didn't actually move, sync prev to avoid drift
|
||||||
|
(when (and (= ((pacman 'position) 'row) pos-before-row)
|
||||||
|
(= ((pacman 'position) 'col) pos-before-col))
|
||||||
|
((pacman 'sync-prev!))))))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Pause logic
|
||||||
|
;;
|
||||||
|
|
||||||
|
(define (toggle-pause!)
|
||||||
|
(set! paused? (not paused?)))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Key handling
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; key-press! :: symbol -> /
|
||||||
|
(define (key-press! pressed-key)
|
||||||
|
(cond
|
||||||
|
((eq? pressed-key 'escape) (toggle-pause!))
|
||||||
|
((not paused?)
|
||||||
|
(cond
|
||||||
|
((eq? pressed-key 'right) (set! queued-direction 'right))
|
||||||
|
((eq? pressed-key 'left) (set! queued-direction 'left))
|
||||||
|
((eq? pressed-key 'up) (set! queued-direction 'up))
|
||||||
|
((eq? pressed-key 'down) (set! queued-direction 'down))))))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Update (game loop)
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; update! :: number -> /
|
||||||
|
(define (update! delta-time)
|
||||||
|
(when (not (or paused? game-over?))
|
||||||
|
((timer 'decrease!) delta-time)
|
||||||
|
;; Pac-Man movement (carry residual for smoother interpolation)
|
||||||
|
(set! movement-timer (+ movement-timer delta-time))
|
||||||
|
(when (>= movement-timer pacman-speed-ms)
|
||||||
|
(advance-pacman!)
|
||||||
|
(set! movement-timer (- movement-timer pacman-speed-ms))
|
||||||
|
(check-ghost-collision!))
|
||||||
|
;; Ghost mode cycling and movement
|
||||||
|
(update-ghost-mode! delta-time)
|
||||||
|
(update-ghosts! delta-time)
|
||||||
|
(check-ghost-collision!)))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Callbacks
|
||||||
|
;;
|
||||||
|
|
||||||
|
(define (set-on-coins-changed! callback)
|
||||||
|
(set! on-coins-changed! callback))
|
||||||
|
|
||||||
|
(define (set-on-maze-changed! callback)
|
||||||
|
(set! on-maze-changed! callback))
|
||||||
|
|
||||||
|
(define (set-on-ghosts-changed! callback)
|
||||||
|
(set! on-ghosts-changed! callback))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Dispatch
|
||||||
|
;;
|
||||||
|
|
||||||
|
(define (dispatch-level msg)
|
||||||
|
(cond ((eq? msg 'maze) maze)
|
||||||
|
((eq? msg 'pacman) pacman)
|
||||||
|
((eq? msg 'ghosts) ghosts)
|
||||||
|
((eq? msg 'key) key)
|
||||||
|
((eq? msg 'score) score)
|
||||||
|
((eq? msg 'timer) timer)
|
||||||
|
((eq? msg 'paused?) paused?)
|
||||||
|
((eq? msg 'game-over?) game-over?)
|
||||||
|
((eq? msg 'pacman-movement-timer) movement-timer)
|
||||||
|
((eq? msg 'key-press!) key-press!)
|
||||||
|
((eq? msg 'update!) update!)
|
||||||
|
((eq? msg 'set-on-coins-changed!) set-on-coins-changed!)
|
||||||
|
((eq? msg 'set-on-maze-changed!) set-on-maze-changed!)
|
||||||
|
((eq? msg 'set-on-ghosts-changed!) set-on-ghosts-changed!)
|
||||||
|
(else (error "Level ADT -- Unknown message:" msg))))
|
||||||
|
|
||||||
|
dispatch-level))))
|
||||||
118
pacman-project/adt/maze.rkt
Normal file
118
pacman-project/adt/maze.rkt
Normal 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)))
|
||||||
61
pacman-project/adt/pacman.rkt
Normal file
61
pacman-project/adt/pacman.rkt
Normal file
@@ -0,0 +1,61 @@
|
|||||||
|
#lang r7rs
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Pac-Man ADT ;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
;; Manages the logical state of the player: grid position, direction, and
|
||||||
|
;; previous position for smooth rendering interpolation. Contains NO
|
||||||
|
;; graphics code.
|
||||||
|
|
||||||
|
(define-library (pacman-project adt pacman)
|
||||||
|
(import (scheme base)
|
||||||
|
(pacman-project adt position))
|
||||||
|
(export make-pacman)
|
||||||
|
|
||||||
|
(begin
|
||||||
|
|
||||||
|
;; make-pacman :: number, number -> pacman
|
||||||
|
;; Creates a Pac-Man object at the given start position (row, col).
|
||||||
|
(define (make-pacman start-row start-col)
|
||||||
|
(let ((position (make-position start-row start-col))
|
||||||
|
(direction 'right)
|
||||||
|
(prev-row start-row)
|
||||||
|
(prev-col start-col))
|
||||||
|
|
||||||
|
;; position! :: position -> /
|
||||||
|
(define (position! new-position)
|
||||||
|
(set! position new-position))
|
||||||
|
|
||||||
|
;; direction! :: symbol -> /
|
||||||
|
(define (direction! new-direction)
|
||||||
|
(set! direction new-direction))
|
||||||
|
|
||||||
|
;; move! :: number, number -> /
|
||||||
|
;; Saves previous position, then moves by delta on the grid.
|
||||||
|
(define (move! delta-row delta-col)
|
||||||
|
(set! prev-row (position 'row))
|
||||||
|
(set! prev-col (position 'col))
|
||||||
|
((position 'row!) (+ (position 'row) delta-row))
|
||||||
|
((position 'col!) (+ (position 'col) delta-col)))
|
||||||
|
|
||||||
|
;; sync-prev! :: -> /
|
||||||
|
;; Sets previous position to current. Call after teleportation
|
||||||
|
;; to prevent interpolation across the map.
|
||||||
|
(define (sync-prev!)
|
||||||
|
(set! prev-row (position 'row))
|
||||||
|
(set! prev-col (position 'col)))
|
||||||
|
|
||||||
|
;; dispatch-pacman :: symbol -> any
|
||||||
|
(define (dispatch-pacman msg)
|
||||||
|
(cond ((eq? msg 'position) position)
|
||||||
|
((eq? msg 'position!) position!)
|
||||||
|
((eq? msg 'direction) direction)
|
||||||
|
((eq? msg 'direction!) direction!)
|
||||||
|
((eq? msg 'move!) move!)
|
||||||
|
((eq? msg 'prev-row) prev-row)
|
||||||
|
((eq? msg 'prev-col) prev-col)
|
||||||
|
((eq? msg 'sync-prev!) sync-prev!)
|
||||||
|
(else (error "Pac-Man ADT -- Unknown message:" msg))))
|
||||||
|
|
||||||
|
dispatch-pacman))))
|
||||||
50
pacman-project/adt/position.rkt
Normal file
50
pacman-project/adt/position.rkt
Normal 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)))
|
||||||
32
pacman-project/adt/score.rkt
Normal file
32
pacman-project/adt/score.rkt
Normal file
@@ -0,0 +1,32 @@
|
|||||||
|
#lang r7rs
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Score ADT ;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
;; Tracks the player's score. Contains NO graphics code.
|
||||||
|
|
||||||
|
(define-library (pacman-project adt score)
|
||||||
|
(import (scheme base)
|
||||||
|
(pacman-project constants))
|
||||||
|
(export make-score)
|
||||||
|
|
||||||
|
(begin
|
||||||
|
|
||||||
|
;; make-score :: -> score
|
||||||
|
;; Creates a new score object, starting at 0.
|
||||||
|
(define (make-score)
|
||||||
|
(let ((points 0))
|
||||||
|
|
||||||
|
;; increase! :: -> /
|
||||||
|
;; Increases the score by points-per-coin.
|
||||||
|
(define (increase!)
|
||||||
|
(set! points (+ points points-per-coin)))
|
||||||
|
|
||||||
|
;; dispatch-score :: symbol -> any
|
||||||
|
(define (dispatch-score msg)
|
||||||
|
(cond ((eq? msg 'points) points)
|
||||||
|
((eq? msg 'increase!) increase!)
|
||||||
|
(else (error "Score ADT -- Unknown message:" msg))))
|
||||||
|
|
||||||
|
dispatch-score))))
|
||||||
62
pacman-project/adt/timer.rkt
Normal file
62
pacman-project/adt/timer.rkt
Normal 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))))
|
||||||
@@ -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)))
|
|
||||||
290
pacman-project/constants.rkt
Normal file
290
pacman-project/constants.rkt
Normal file
@@ -0,0 +1,290 @@
|
|||||||
|
#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
|
||||||
|
coin-size
|
||||||
|
|
||||||
|
;; Sprites
|
||||||
|
sprite-scale-pacman
|
||||||
|
sprite-scale-key
|
||||||
|
sprite-scale-key-ui
|
||||||
|
sprite-scale-ghost
|
||||||
|
|
||||||
|
;; Movement
|
||||||
|
pacman-speed-ms
|
||||||
|
ghost-speed-ms
|
||||||
|
|
||||||
|
;; Ghost house
|
||||||
|
ghost-house-door-row
|
||||||
|
ghost-house-door-col-left
|
||||||
|
ghost-house-door-col-right
|
||||||
|
ghost-house-exit-row
|
||||||
|
ghost-house-exit-col
|
||||||
|
|
||||||
|
;; Ghost start positions
|
||||||
|
blinky-start-row
|
||||||
|
blinky-start-col
|
||||||
|
pinky-start-row
|
||||||
|
pinky-start-col
|
||||||
|
inky-start-row
|
||||||
|
inky-start-col
|
||||||
|
clyde-start-row
|
||||||
|
clyde-start-col
|
||||||
|
|
||||||
|
;; Ghost scatter corners
|
||||||
|
blinky-scatter-row
|
||||||
|
blinky-scatter-col
|
||||||
|
pinky-scatter-row
|
||||||
|
pinky-scatter-col
|
||||||
|
inky-scatter-row
|
||||||
|
inky-scatter-col
|
||||||
|
clyde-scatter-row
|
||||||
|
clyde-scatter-col
|
||||||
|
|
||||||
|
;; Ghost house exit delays (ms)
|
||||||
|
pinky-exit-delay
|
||||||
|
inky-exit-delay
|
||||||
|
clyde-exit-delay
|
||||||
|
|
||||||
|
;; Ghost mode durations (ms)
|
||||||
|
scatter-duration-1
|
||||||
|
chase-duration-1
|
||||||
|
scatter-duration-2
|
||||||
|
chase-duration-2
|
||||||
|
scatter-duration-3
|
||||||
|
|
||||||
|
;; Ghost AI
|
||||||
|
clyde-shy-distance
|
||||||
|
pinky-look-ahead
|
||||||
|
|
||||||
|
;; 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
|
||||||
|
|
||||||
|
;; Colors
|
||||||
|
color-background
|
||||||
|
color-wall
|
||||||
|
color-door
|
||||||
|
color-coin
|
||||||
|
color-text
|
||||||
|
color-title
|
||||||
|
color-header-bg
|
||||||
|
color-game-over
|
||||||
|
color-pause-bg
|
||||||
|
color-pause-text
|
||||||
|
|
||||||
|
;; UI layout
|
||||||
|
header-height
|
||||||
|
header-title-size
|
||||||
|
header-title-x
|
||||||
|
header-title-y
|
||||||
|
score-label-size
|
||||||
|
score-label-x
|
||||||
|
score-label-y
|
||||||
|
score-value-size
|
||||||
|
score-value-x
|
||||||
|
score-value-y
|
||||||
|
key-ui-x
|
||||||
|
key-ui-y
|
||||||
|
sidebar-x
|
||||||
|
sidebar-width
|
||||||
|
time-label-size
|
||||||
|
time-label-x
|
||||||
|
time-label-y
|
||||||
|
time-value-size
|
||||||
|
time-value-x
|
||||||
|
time-value-y
|
||||||
|
game-over-text-size
|
||||||
|
game-over-text-x
|
||||||
|
game-over-text-y
|
||||||
|
pause-text-size
|
||||||
|
pause-text-x
|
||||||
|
pause-text-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
|
||||||
|
(define coin-inset 9)
|
||||||
|
(define coin-size 6)
|
||||||
|
|
||||||
|
;; Sprite scale factors
|
||||||
|
(define sprite-scale-pacman 1.5)
|
||||||
|
(define sprite-scale-key 1.5)
|
||||||
|
(define sprite-scale-key-ui 3)
|
||||||
|
(define sprite-scale-ghost 1.5)
|
||||||
|
|
||||||
|
;; Movement speed: time between automatic movement ticks
|
||||||
|
(define pacman-speed-ms 200)
|
||||||
|
(define ghost-speed-ms 220)
|
||||||
|
|
||||||
|
;; Ghost house position (door and exit point above door)
|
||||||
|
(define ghost-house-door-row 12)
|
||||||
|
(define ghost-house-door-col-left 13)
|
||||||
|
(define ghost-house-door-col-right 14)
|
||||||
|
(define ghost-house-exit-row 11)
|
||||||
|
(define ghost-house-exit-col 14)
|
||||||
|
|
||||||
|
;; Ghost start positions
|
||||||
|
(define blinky-start-row 11)
|
||||||
|
(define blinky-start-col 14)
|
||||||
|
(define pinky-start-row 14)
|
||||||
|
(define pinky-start-col 13)
|
||||||
|
(define inky-start-row 14)
|
||||||
|
(define inky-start-col 11)
|
||||||
|
(define clyde-start-row 14)
|
||||||
|
(define clyde-start-col 16)
|
||||||
|
|
||||||
|
;; Ghost scatter target corners
|
||||||
|
(define blinky-scatter-row 0)
|
||||||
|
(define blinky-scatter-col 27)
|
||||||
|
(define pinky-scatter-row 0)
|
||||||
|
(define pinky-scatter-col 0)
|
||||||
|
(define inky-scatter-row 30)
|
||||||
|
(define inky-scatter-col 27)
|
||||||
|
(define clyde-scatter-row 30)
|
||||||
|
(define clyde-scatter-col 0)
|
||||||
|
|
||||||
|
;; Ghost house exit delays (ms) — staggered release
|
||||||
|
(define pinky-exit-delay 2000)
|
||||||
|
(define inky-exit-delay 5000)
|
||||||
|
(define clyde-exit-delay 8000)
|
||||||
|
|
||||||
|
;; Ghost mode durations (ms) — scatter/chase alternation
|
||||||
|
(define scatter-duration-1 7000)
|
||||||
|
(define chase-duration-1 20000)
|
||||||
|
(define scatter-duration-2 7000)
|
||||||
|
(define chase-duration-2 20000)
|
||||||
|
(define scatter-duration-3 5000)
|
||||||
|
|
||||||
|
;; Ghost AI parameters
|
||||||
|
(define clyde-shy-distance 8)
|
||||||
|
(define pinky-look-ahead 2)
|
||||||
|
|
||||||
|
;; 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)
|
||||||
|
|
||||||
|
;; Colors — arcade-style palette (standard Racket color names only)
|
||||||
|
(define color-background "black")
|
||||||
|
(define color-wall "medium blue")
|
||||||
|
(define color-door "hot pink")
|
||||||
|
(define color-coin "gold")
|
||||||
|
(define color-text "white")
|
||||||
|
(define color-title "yellow")
|
||||||
|
(define color-header-bg "dark slate gray")
|
||||||
|
(define color-game-over "red")
|
||||||
|
(define color-pause-bg "black")
|
||||||
|
(define color-pause-text "red")
|
||||||
|
|
||||||
|
;; UI layout — header bar at the top
|
||||||
|
(define header-height 90)
|
||||||
|
(define header-title-size 36)
|
||||||
|
(define header-title-x 250)
|
||||||
|
(define header-title-y 25)
|
||||||
|
|
||||||
|
;; Score display (left side of header)
|
||||||
|
(define score-label-size 20)
|
||||||
|
(define score-label-x 20)
|
||||||
|
(define score-label-y 25)
|
||||||
|
(define score-value-size 32)
|
||||||
|
(define score-value-x 20)
|
||||||
|
(define score-value-y 50)
|
||||||
|
|
||||||
|
;; Key UI indicator position
|
||||||
|
(define key-ui-x 600)
|
||||||
|
(define key-ui-y 30)
|
||||||
|
|
||||||
|
;; Sidebar (right of maze)
|
||||||
|
(define sidebar-x 672)
|
||||||
|
(define sidebar-width 4)
|
||||||
|
|
||||||
|
;; Time display (right sidebar area)
|
||||||
|
(define time-label-size 20)
|
||||||
|
(define time-label-x 700)
|
||||||
|
(define time-label-y 200)
|
||||||
|
(define time-value-size 40)
|
||||||
|
(define time-value-x 710)
|
||||||
|
(define time-value-y 240)
|
||||||
|
|
||||||
|
;; Game over overlay
|
||||||
|
(define game-over-text-size 48)
|
||||||
|
(define game-over-text-x 180)
|
||||||
|
(define game-over-text-y 380)
|
||||||
|
|
||||||
|
;; Pause overlay
|
||||||
|
(define pause-text-size 48)
|
||||||
|
(define pause-text-x 200)
|
||||||
|
(define pause-text-y 400)))
|
||||||
@@ -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!))
|
||||||
26
pacman-project/tests/all-tests.rkt
Normal file
26
pacman-project/tests/all-tests.rkt
Normal file
@@ -0,0 +1,26 @@
|
|||||||
|
#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-ghost) ghost:)
|
||||||
|
(prefix (pacman-project tests test-score) score:)
|
||||||
|
(prefix (pacman-project tests test-timer) timer:))
|
||||||
|
|
||||||
|
(define (test-all)
|
||||||
|
(position:test)
|
||||||
|
(maze:test)
|
||||||
|
(pacman:test)
|
||||||
|
(ghost:test)
|
||||||
|
(score:test)
|
||||||
|
(timer:test))
|
||||||
|
|
||||||
|
(test-all)
|
||||||
@@ -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)
|
|
||||||
@@ -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"))))
|
|
||||||
97
pacman-project/tests/test-ghost.rkt
Normal file
97
pacman-project/tests/test-ghost.rkt
Normal file
@@ -0,0 +1,97 @@
|
|||||||
|
#lang r7rs
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Tests: Ghost ADT ;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(define-library (pacman-project tests test-ghost)
|
||||||
|
(import (scheme base)
|
||||||
|
(pp1 tests)
|
||||||
|
(pacman-project adt ghost))
|
||||||
|
(export test)
|
||||||
|
|
||||||
|
(begin
|
||||||
|
|
||||||
|
;; Test creation and initial state
|
||||||
|
(define (test-creation)
|
||||||
|
(define g (make-ghost 'blinky 11 14 0 27 0))
|
||||||
|
(define pos (g 'position))
|
||||||
|
(check-eq? (pos 'row) 11 "Start row should be 11")
|
||||||
|
(check-eq? (pos 'col) 14 "Start col should be 14")
|
||||||
|
(check-eq? (g 'type) 'blinky "Type should be blinky")
|
||||||
|
(check-eq? (g 'direction) 'left "Default direction should be left"))
|
||||||
|
|
||||||
|
;; Test that exit-delay 0 means ghost starts outside (scatter mode)
|
||||||
|
(define (test-blinky-starts-active)
|
||||||
|
(define g (make-ghost 'blinky 11 14 0 27 0))
|
||||||
|
(check-eq? (g 'in-house?) #f "Blinky should start outside")
|
||||||
|
(check-eq? (g 'mode) 'scatter "Blinky should start in scatter"))
|
||||||
|
|
||||||
|
;; Test that non-zero exit-delay means ghost starts in house
|
||||||
|
(define (test-pinky-starts-in-house)
|
||||||
|
(define g (make-ghost 'pinky 14 13 0 0 2000))
|
||||||
|
(check-eq? (g 'in-house?) #t "Pinky should start in house")
|
||||||
|
(check-eq? (g 'mode) 'in-house "Pinky mode should be in-house"))
|
||||||
|
|
||||||
|
;; Test direction change
|
||||||
|
(define (test-direction)
|
||||||
|
(define g (make-ghost 'blinky 11 14 0 27 0))
|
||||||
|
((g 'direction!) 'right)
|
||||||
|
(check-eq? (g 'direction) 'right "Direction should be right"))
|
||||||
|
|
||||||
|
;; Test mode change and reverse queuing
|
||||||
|
(define (test-mode-change-queues-reverse)
|
||||||
|
(define g (make-ghost 'blinky 11 14 0 27 0))
|
||||||
|
((g 'mode!) 'chase)
|
||||||
|
(check-eq? (g 'mode) 'chase "Mode should be chase")
|
||||||
|
(check-eq? ((g 'consume-reverse!)) #t "Reverse should be queued after mode change"))
|
||||||
|
|
||||||
|
;; Test reverse consumed only once
|
||||||
|
(define (test-consume-reverse-once)
|
||||||
|
(define g (make-ghost 'blinky 11 14 0 27 0))
|
||||||
|
((g 'mode!) 'chase)
|
||||||
|
((g 'consume-reverse!))
|
||||||
|
(check-eq? ((g 'consume-reverse!)) #f "Reverse should be consumed after first call"))
|
||||||
|
|
||||||
|
;; Test move
|
||||||
|
(define (test-move)
|
||||||
|
(define g (make-ghost 'blinky 11 14 0 27 0))
|
||||||
|
((g 'move!) 0 -1)
|
||||||
|
(define pos (g 'position))
|
||||||
|
(check-eq? (pos 'col) 13 "Col should be 13 after move left"))
|
||||||
|
|
||||||
|
;; Test scatter target
|
||||||
|
(define (test-scatter-target)
|
||||||
|
(define g (make-ghost 'blinky 11 14 0 27 0))
|
||||||
|
(define st (g 'scatter-target))
|
||||||
|
(check-eq? (st 'row) 0 "Scatter target row should be 0")
|
||||||
|
(check-eq? (st 'col) 27 "Scatter target col should be 27"))
|
||||||
|
|
||||||
|
;; Test house timer expiry
|
||||||
|
(define (test-house-exit)
|
||||||
|
(define g (make-ghost 'pinky 14 13 0 0 2000))
|
||||||
|
((g 'update-house-timer!) 1000)
|
||||||
|
(check-eq? (g 'in-house?) #t "Still in house after 1000ms")
|
||||||
|
((g 'update-house-timer!) 1000)
|
||||||
|
(check-eq? (g 'in-house?) #f "Should exit house after 2000ms")
|
||||||
|
(check-eq? (g 'mode) 'scatter "Should be in scatter after exiting"))
|
||||||
|
|
||||||
|
;; Test movement timer
|
||||||
|
(define (test-movement-timer)
|
||||||
|
(define g (make-ghost 'blinky 11 14 0 27 0))
|
||||||
|
(check-eq? ((g 'advance-movement-timer!) 100) 100 "Timer should be 100")
|
||||||
|
(check-eq? ((g 'advance-movement-timer!) 120) 220 "Timer should be 220")
|
||||||
|
((g 'reset-movement-timer!))
|
||||||
|
(check-eq? (g 'movement-timer) 0 "Timer should reset to 0"))
|
||||||
|
|
||||||
|
(define (test)
|
||||||
|
(run-test test-creation "Ghost: creation and initial state")
|
||||||
|
(run-test test-blinky-starts-active "Ghost: Blinky starts active")
|
||||||
|
(run-test test-pinky-starts-in-house "Ghost: Pinky starts in house")
|
||||||
|
(run-test test-direction "Ghost: direction change")
|
||||||
|
(run-test test-mode-change-queues-reverse "Ghost: mode change queues reverse")
|
||||||
|
(run-test test-consume-reverse-once "Ghost: consume reverse only once")
|
||||||
|
(run-test test-move "Ghost: move")
|
||||||
|
(run-test test-scatter-target "Ghost: scatter target")
|
||||||
|
(run-test test-house-exit "Ghost: house timer exit")
|
||||||
|
(run-test test-movement-timer "Ghost: movement timer"))))
|
||||||
58
pacman-project/tests/test-maze.rkt
Normal file
58
pacman-project/tests/test-maze.rkt
Normal 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"))))
|
||||||
@@ -7,45 +7,45 @@
|
|||||||
(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"))))
|
||||||
|
|||||||
@@ -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
57
pacman-project/tests/test-position.rkt
Normal 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"))))
|
||||||
@@ -7,24 +7,24 @@
|
|||||||
(define-library (pacman-project tests test-score)
|
(define-library (pacman-project tests test-score)
|
||||||
(import (scheme base)
|
(import (scheme base)
|
||||||
(pp1 tests)
|
(pp1 tests)
|
||||||
(pacman-project adt-score))
|
(pacman-project adt score))
|
||||||
(export test)
|
(export test)
|
||||||
|
|
||||||
(begin
|
(begin
|
||||||
|
|
||||||
;; Test startscore
|
;; Test initial score
|
||||||
(define (test-startscore)
|
(define (test-initial)
|
||||||
(define s (maak-score))
|
(define s (make-score))
|
||||||
(check-eq? (s 'punten) 0 "Startscore moet 0 zijn"))
|
(check-eq? (s 'points) 0 "Initial score should be 0"))
|
||||||
|
|
||||||
;; Test score verhoging
|
;; Test score increase
|
||||||
(define (test-verhoog)
|
(define (test-increase)
|
||||||
(define s (maak-score))
|
(define s (make-score))
|
||||||
((s 'verhoog!))
|
((s 'increase!))
|
||||||
(check-eq? (s 'punten) 10 "Score moet 10 zijn na 1 muntje")
|
(check-eq? (s 'points) 10 "Score should be 10 after 1 coin")
|
||||||
((s 'verhoog!))
|
((s 'increase!))
|
||||||
(check-eq? (s 'punten) 20 "Score moet 20 zijn na 2 muntjes"))
|
(check-eq? (s 'points) 20 "Score should be 20 after 2 coins"))
|
||||||
|
|
||||||
(define (test)
|
(define (test)
|
||||||
(run-test test-startscore "Score: startscore")
|
(run-test test-initial "Score: initial score")
|
||||||
(run-test test-verhoog "Score: verhoging"))))
|
(run-test test-increase "Score: increase"))))
|
||||||
|
|||||||
@@ -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
55
pacman-project/tests/test-timer.rkt
Normal 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
40
snake-wpo/adt-appel.rkt
Normal 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
182
snake-wpo/adt-level.rkt
Normal 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
91
snake-wpo/adt-positie.rkt
Normal 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
33
snake-wpo/adt-slang-stuk.rkt
Normal 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
77
snake-wpo/adt-slang.rkt
Normal 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
52
snake-wpo/adt-spel.rkt
Normal 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
188
snake-wpo/adt-teken.rkt
Normal 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
53
snake-wpo/constanten.rkt
Normal 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
39
snake-wpo/hulp-procedures.rkt
Normal 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
BIN
snake-wpo/images/apple-mask.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 649 B |
BIN
snake-wpo/images/apple.png
Normal file
BIN
snake-wpo/images/apple.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 673 B |
BIN
snake-wpo/images/snake-mask.png
Normal file
BIN
snake-wpo/images/snake-mask.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 5.1 KiB |
BIN
snake-wpo/images/snake.png
Normal file
BIN
snake-wpo/images/snake.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 4.5 KiB |
16
snake-wpo/spel.rkt
Normal file
16
snake-wpo/spel.rkt
Normal 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
19
snake-wpo/tests/alle-testen.rkt
Normal 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
27
snake-wpo/tests/test-appel.rkt
Normal 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
28
snake-wpo/tests/test-positie.rkt
Normal 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)
|
||||||
Reference in New Issue
Block a user