Space Invaders

SpaceInvaders.rkt

(let ()
              (current-namespace (make-base-namespace))
              (define (hello) (displayln "Space Invaders!"))
              (namespace-set-variable-value! 'hello hello)
              ;;;
              ;;; Browser API
              ;;;
              ;;; Time
              (define now                (js-import-from (js-date)     "now"              0))
              ;;; Window
              (define the-window         (js-window))
              (define set-timeout        (js-import-from the-window    "setTimeout"       2))
              ;;; Document
              (define the-document       (js-document))
              (define get-element-by-id  (js-import-from the-document  "getElementById"   1))
              ;;; Canvas
              (define the-canvas         (get-element-by-id "the-canvas"))
              (define get-context        (js-import-from the-canvas    "getContext"       1))
              (define add-event-listener (js-import-from the-canvas    "addEventListener" 3))
              ;;; Drawing Context
              (define dc                 (get-context "2d"))
              ; Rectangles
              (define fill-rect          (js-import-from dc            "fillRect"    4))
              (define stroke-rect        (js-import-from dc            "strokeRect"  4))
              (define clear-rect         (js-import-from dc            "clearRect"   4))
              ; Text
              (define fill-text          (js-import-from dc            "fillText"    4))
              (define stroke-text        (js-import-from dc            "strokeText"  4))
              (define measure-text       (js-import-from dc            "measureText" 1))              
              ;;;
              ;;; Helpers
              ;;;              
              (define (filter-map proc xs)
                (filter (λ (x) x) (map proc xs)))
              ;;;
              ;;; SPACE INVADERS
              ;;;

              ; Jens Axel Søgaard, 2017
              ;     https://github.com/soegaard/space-invaders

              ; A Racket remake of Mary Rose Cook's JavaScript version of Space Invaders.
              ;     https://github.com/maryrosecook/annotated-code

              ;;; Data Representation
              (struct world        (player invaders bullets) #:transparent)
              (struct body         (x y size)                #:transparent)
              (struct invader body (patrol-x speed-x)        #:transparent)
              (struct bullet  body (velocity-x velocity-y)   #:transparent)
              (struct player  body (dead?)                   #:transparent)

              ; A world represents the state of the game.
              ; A world consists of a player, a list of invaders and a list of bullets.
              ; The invaders, the bullets and the player are all bodies.
              ; All bodies are drawn as little squares.
              ; A body contains the x and y coordinate og its upper left corner as well as its size.
              ; Invaders move back and forth horisontally - this is called patrolling.
              ; The field patrol-x determines how far the invader has moved from its original position.
              ; A positive speed-x means rightward movement, and a negative sign leftward movement.

              ;;; Configuration
              (define width       400)
              (define height      400)
              (define player-size  15)
              (define bullet-size   3)
              (define invader-size 15)

              ;;; Smart Constructors
              
              (define (new-bullet x y vx vy)
                (bullet x y bullet-size vx vy))

              (define (new-invader x y)
                (define patrol-x  0)
                (define speed-x   0.3)
                (invader x y invader-size patrol-x speed-x))

              (define (new-player x y)
                (define size 15)
                (define dead? #f)
                (player x y size dead?))

              ;;;
              ;;; MODEL
              ;;;

              ;;; Creation

              ; create-world : -> world
              ;  the initial world contains the player and a bunch of invaders
              (define (create-world)
                (world (create-player) (create-invaders) '()))

              ; create-invaders : -> (list body)
              ;   create list of twenty-four invaders
              (define (create-invaders)
                (for/list ([i (in-range (* 4 12))])
                  (define x (+ 20 (* 30 (remainder i 12)))) ; 12 columns
                  (define y (+ 20 (* 30 (quotient  i 12)))) 
                  (new-invader x y)))

              ; create-player : -> player
              (define (create-player)
                (define x (/ width 2.))
                (define y (- height (* 2. player-size)))
                (new-player x y))

              ;;; Updaters

              ; update-invader : invader -> invader
              (define (update-invader i)
                (match-define (invader x y size patrol-x speed-x) i)
                ; If the invader is outside the patrol bound we flip the speed
                (define speed-x-factor (if (and (<= 0 patrol-x) (<= patrol-x 29)) 1 -1))
                (define new-speed-x    (* speed-x-factor speed-x))
                (define new-x          (+        x new-speed-x))
                (define new-patrol-x   (+ patrol-x new-speed-x))
                (invader new-x y size new-patrol-x new-speed-x))

              ; update-bullet : bullet -> bullet
              (define (update-bullet b)
                (match-define (bullet x y size vx vy) b)
                (bullet (+ x vx) (+ y vy) size vx vy))

              ; update-player : world -> world
              (define (update-player w)
                (match-define (world p is bs) w)
                (match-define (player x y size d) p)
                (define dead? (or d (collisions? p bs)))
                (define moved-player
                  (cond [d                   p]
                        [(key-down? "left")  (player (- x 2.) y size dead?)]
                        [(key-down? "right") (player (+ x 2.) y size dead?)]
                        [else                (player x y size dead?)]))
                (world moved-player is bs))

              ; spawn-invader-bullets : world -> world
              ;   maybe create new bullets below an invader
              (define (spawn-invader-bullets w)
                (match-define (world p is bs) w)
                (define (maybe-spawn-bullet i)
                  (match-define (invader x y size _ _) i)
                  ; once in a while, if no friends below, create a bullet
                  (if (and (> (random) 0.992)
                           (not (invader-below? i is)))
                      (bullet x (+ y size 1) 3 (- (random) 0.5) 2.)
                      #f))
                (define new-bullets (filter-map maybe-spawn-bullet is))
                (world p is (append new-bullets bs)))

              (define (invader-below? i is)
                (match-define (body x y size) i)
                (for/or ([b (in-list is)])
                  (and (<= x (body-x b) (+ x size))
                       (> (body-y b) (+ y size)))))

              ; spawn-player-bullet : world -> world
              ;   a non-dead player shoots when space is pressed
              (define (spawn-player-bullet w)
                (match-define (world p is bs) w)
                (cond
                  [(player-dead? p) w] ; no shooting, when dead
                  [(key-just-down? #\space) ; space => new bullet
                   (match-define (player x y size d) p)
                   (define b (new-bullet (+ x (/ size 2.)) y 0 -7))
                   (world p is (cons b bs))]
                  [else w]))
              
              ;;; UPDATES

              (define (update w)
                (restart-on-r
                 (remove-colliding-bodies
                  (spawn-player-bullet
                   (spawn-invader-bullets
                    (update-player
                     (update-invaders
                      (update-bullets w))))))))

              (define (update-invaders w)
                (define is (world-invaders w))
                (struct-copy world w [invaders (map update-invader is)]))

              (define (update-bullets w)
                (struct-copy world w [bullets (map update-bullet (world-bullets w))]))

              (define (restart-on-r w)
                (if (key-down? #\r)
                    (create-world)
                    w))

              ;;; Collision

              (define (colliding? b1 b2)
                (match-define (body x1 y1 s1) b1)
                (match-define (body x2 y2 s2) b2)
                (not (or (eq? b1 b2)
                         (< (+ x1 s1) x2) (> x1 (+ x2 s2))
                         (< (+ y1 s1) y2) (> y1 (+ y2 s2)))))

              (define (collisions? x bs)
                (for/or ([b (in-list bs)]) (colliding? x b)))

              (define (inside-screen? b)
                (match-define (body x y size) b)
                (and (< -40 x) (< x (+ width  40))
                     (< -40 y) (< y (+ height 40))))

              (define (remove-colliding-bodies w)
                (match-define (world p is bs) w)
                (define (no-bullet-collisons? x)   (not (collisions? x bs)))
                (define (no-invaders-collisons? x) (not (collisions? x is)))
                (world p 
                       (filter no-bullet-collisons? is)
                       (filter inside-screen? ; remove non-visible bullets
                               (filter no-invaders-collisons? bs))))

              ;;; DRAWING

              ; draw-bodies : (list body) -> void
              ;   draw the bodies in the world w
              (define (draw-bodies bs)
                (for ([b (in-list bs)])
                  (match-define (body x y s) b)
                  (define c (if (player? b) (if (player-dead? b) "red" "green") "black"))
                  (js-set! dc "fillStyle" c)
                  (fill-rect x y s s)))

              (define (draw-world w)
                (match-define (world p is bs) w)
                (draw-bodies (append (list p) is bs)))

              ;;; GUI STATE

              (define the-world (create-world))

              ;;; Keyboard
              ; The keyboard state is kept in a hash table. 
              ; Use key-down? to find out, whether a key is pressed or not.
              (define the-keyboard (make-hasheq))
              (define (key-up! k)   (hash-set! the-keyboard k #f))
              (define (key-down? k) (not (key-up? k)))
              (define (key-up? k)   (not (hash-ref the-keyboard k #f)))

              (define (key-down! k)
                (when (key-up? k) ; prevent two keydowns without a keyup inbetween
                  (hash-set! the-keyboard k (now))))
              
              (define (key-just-down? k)
                (define old-ts (hash-ref the-keyboard k))
                (define new-ts (now))
                (and (key-down? k)
                     (< (- new-ts old-ts) 25)))

              (define (on-keydown event)
                (key-down! (keycode->key (js-ref event "keyCode"))))

              (define (on-keyup event)
                (key-up!   (keycode->key (js-ref event "keyCode"))))
              
              (define (keycode->key k)
                (cond
                  [(= k 38) "up"]
                  [(= k 40) "down"]
                  [(= k 37) "left"]
                  [(= k 39) "right"]
                  [(= k 32) #\space]
                  [(= k 65) "left"]  ; a
                  [(= k 83) "down"]  ; s
                  [(= k 87) "up"]    ; w
                  [(= k 68) "right"] ; d
                  [(= k 82) #\r]     ; r
                  [else     #f]))

              ;;; Event Handlers

              (define (on-paint)   ; repaint (exposed or resized)
                (clear-rect 0 0 width height)
                (draw-world the-world))

              (define (on-timer)
                (set! the-world (update the-world))
                (on-paint)
                (set-timeout (js-export on-timer) 20))

              ; Install event handlers
              (add-event-listener "keydown" (js-export on-keydown) #f)
              (add-event-listener "keyup"   (js-export on-keyup)   #f)
              (on-timer))