Pacman-Project/pacman-project/adt-level.rkt

#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))))