Pacman-Project/snake-wpo/adt-teken.rkt

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