Asteroids game implementation in Racket

asteroids.rkt

#lang racket
;; An Asteroids game in Racket

;; Copyright (c) 2021 Alex Harsányi (AlexHarsanyi@gmail.com)

;; Permission is hereby granted, free of charge, to any person obtaining a
;; copy of this software and associated documentation files (the "Software"),
;; to deal in the Software without restriction, including without limitation
;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
;; and/or sell copies of the Software, and to permit persons to whom the
;; Software is furnished to do so, subject to the following conditions:

;; The above copyright notice and this permission notice shall be included in
;; all copies or substantial portions of the Software.

;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;; DEALINGS IN THE SOFTWARE.

(require racket/gui racket/random pict)


;;...................................................... the game engine ....

;; A game engine will manage a "scene" of objects.  Here is out scene,
;; initially empty.  We represent the scene as a list of actors.
(define the-scene '())

;; Here are some functions to add and remove actors from the scene.  Since the
;; scene is a list, these functions just use `cons` and `remove` to operate on
;; lists.
(define (add-actor actor)
  (set! the-scene (cons actor the-scene)))

(define (remove-actor actor)
  (set! the-scene (remove actor the-scene)))

;; Here are some basic operations on the scene itself: paining it onto the
;; canvas, updating the scene as time passes and handling keyboard events.
;; This is a simple "game engine", so all we do here is simply pass on the
;; information to every actor in the scene.

(define (paint-scene scene canvas dc)
  (for ([actor (in-list scene)])
    (send actor paint canvas dc)))

(define (update-scene scene collision-handlers delta-time)
  (handle-collisions scene collision-handlers)
  (for ([actor (in-list scene)])
    (send actor update/delta-time delta-time)))

(define (handle-keyboard-event scene event)
  (for ([actor (in-list scene)])
    (send actor keyboard-event event)))

;; Actors are objects and, while we don't yet know what each actor will do,
;; they need to provide some common methods so the game engine can operate on
;; them, so we define an `actor<%>` interface.  Our actors must provide:
;;
;; * a way to draw themselves onto the canvas -- a `paint` method
;;
;; * a way to update their state (e.g. move) -- an `update/delta-time` method
;;
;; * a way to respond to user input (e.g to move the ship) -- an
;; `keyboard-event` method
;;
;; * a way to check for collisions with other objects -- an
;; `maybe-collide-with` method.
;;
(define actor<%>
  (interface ()
    [paint (->m (is-a?/c canvas%) (is-a?/c dc<%>) any/c)]
    [update/delta-time (->m positive? any/c)]
    [keyboard-event (->m (is-a?/c key-event%) any/c)]))

;; Since not all the actors need to supply all methods, we provide a
;; convenient parent class providing empty implementations for all methods, so
;; each actor can override what it needs.
;;
;; For example, only the ship will need to handle keyboard events, but
;; keyboard events are sent to all actors (see `handle-keyboard-event`), so
;; most actors will not need to worry about providing a `keyboard-event`
;; method.
(define actor%
  (class* object% (actor<%>)
    (init)
    (super-new)
    (define/public (paint _canvas _dc) (void))
    (define/public (update/delta-time _dt) (void))
    (define/public (keyboard-event _e) (void))))

;; This is the state of the game and it is used to know when to display the
;; game over overlay, and to exit the game loop.
(define game-outcome 'not-started)

;; The current game score.
(define game-score 0)

;; We define our own game window, deriving from `frame%` -- this allows us to
;; override the on-close method to set the game outcome to 'abandoned -- this
;; will cause the game loop to exit.  We also intercept keyboard events and
;; send them to the objects in the scene.
(define game-window%
  (class frame%
    (init)
    (super-new)
    (define/augride (on-close)
      (set! game-outcome 'abandoned))
    (define/override (on-subwindow-char receiver event)
      (handle-keyboard-event the-scene event)
      (super on-subwindow-char receiver event))))

;; The GUI frame showing our game
(define the-frame (new game-window% [label "Asteroids"] [width 1600] [height 900]))

(define transparent-brush (send the-brush-list find-or-create-brush "black" 'transparent))

;; This is the game over overlay
(define game-over-pict
  (let* ([label (text "Game Over" (cons 'bold 'default) 48)]
         [background (filled-rounded-rectangle
                      (+ 25 (pict-width label))
                      (+ 25 (pict-height label)))])
    (cc-superimpose
     (cellophane (colorize background '(221 221 221)) 0.9)
     (colorize label '(165 0 38)))))

;; Handle painting the scene.  We do some setup and delegate painting to all
;; the actors in the scene.  As a special case, if the game state is
;; 'game-over, we display the game over overlay (that could have also been
;; done as an actor)
(define (on-canvas-paint canvas dc)
  (send dc set-smoothing 'smoothed)
  (send dc set-brush transparent-brush)
  (paint-scene the-scene canvas dc)
  (when (equal? game-outcome 'game-over)
    (let-values ([(width height) (send dc get-size)])
      (let ([x (/ (- width (pict-width game-over-pict)) 2)]
            [y (/ (- height (pict-height game-over-pict)) 2)])
        (draw-pict game-over-pict dc x y)))))

;; This is the canvas used to draw the actual game scene.
(define the-canvas
  (new canvas%
       [parent the-frame]
       [paint-callback on-canvas-paint]))

;; To place actors correctly in the scene we need to know the scene size - the
;; size specified to the frame% object are the outside dimensions, so we need
;; to ask the canvas for its size.  However, GUI widget sizes are only
;; computed when the frame is shown to the user, so we have to call
;; reflow-container before we have valid values for the canvas size.
;;
;; The game uses a fixed canvas size -- we could also have accommodated
;; dynamic sizes by intercepting the on-size method in the canvas and
;; informing all actors of size changes -- this is done in the space invaders
;; implementation, see
;;
;; https://gist.github.com/alex-hhh/da11a5e937960e69dc473be131be732d
;; https://alex-hhh.github.io/2020/11/space-invaders.html
;;
(send the-frame reflow-container)
(define-values (canvas-width canvas-height) (send the-canvas get-size))

;; This is the main game loop, keeping track of time and sending the actors
;; the `update/delta-time` message and refreshing the canvas.  The game loop
;; runs until the game-outcome is set to abandoned -- which is when the user
;; closes the window.
(define (run-game-loop #:frame-rate [frame-rate 60])
  (collect-garbage 'incremental)
  (set! game-outcome 'in-progress)
  (set! game-score 0)
  (send the-frame show #t)
  (send the-frame focus)

  (define frame-time (* (/ 1.0 frame-rate) 1000.0))

  (let loop ([last-game-time (current-inexact-milliseconds)]
             [current-game-time (current-inexact-milliseconds)])
    (define dt (- current-game-time last-game-time))
    (update-scene the-scene the-collision-handlers dt)
    (send the-canvas refresh-now)
    (define update-duration (- (current-inexact-milliseconds) current-game-time))
    (define remaining-time (- frame-time update-duration))
    (sleep/yield (/ (max 0 remaining-time) 1000.0))
    (unless (equal? game-outcome 'abandoned)
      ;; NOTE: current-game-time becomes last-game-time next iteration
      (loop current-game-time (current-inexact-milliseconds)))))


;;.............................................. two dimensional vectors ....

;; This is a 2D game and we use vectors to represent positions, velocities and
;; acceleration.  For example, when expressed as a vector, the velocity does
;; not only define how fast an object moves, but also in what direction.  This
;; representation makes it convenient to express basic operations in 2D space.

;; https://en.wikipedia.org/wiki/Euclidean_vector

(struct v2 (x y) #:transparent)         ; a vector is a 2D item having an x and y component

(define vzero (v2 0 0))                 ; a convenient "zero vector"
(define vright (v2 1 0)) ; the right unit vector -- a vector pointing to the right
(define vleft (v2 -1 0)) ; the left unit vector
(define vup (v2 0 -1))   ; the up unit vector
(define vdown (v2 0 1))  ; the down unit vector

(define (vplus a b)                     ; vector addition
  (v2 (+ (v2-x a) (v2-x b)) (+ (v2-y a) (v2-y b))))

(define (vminus a b)                    ; vector subtraction
  (v2 (- (v2-x a) (v2-x b)) (- (v2-y a) (v2-y b))))

(define (vnegate a)                     ; vector negation, i.e. (- v)
  (v2 (- (v2-x a)) (- (v2-y a))))

(define (vscale v s)                    ; scaling a vector by a number (Scalar)
  (v2 (* (v2-x v) s) (* (v2-y v) s)))

(define (vdot a b)                      ; dot product (the magic operation)
  ;; https://en.wikipedia.org/wiki/Dot_product
  (+ (* (v2-x a) (v2-x b)) (* (v2-y a) (v2-y b))))

(define (vlength v)                     ; the length of a vector
  (match-define (v2 x y) v)
  (sqrt (+ (* x x) (* y y))))

(define (vnorm v)                       ; normalize: make a unit vector with the same direction as v
  (define l (vlength v))
  (v2 (/ (v2-x v) l) (/ (v2-y v) l)))

(define (vreflect v n)                  ; reflect a vector around a normal 'n'
  (vminus (vscale n (* 2 (vdot v n))) v))

(define (vrotate v theta)               ; rotate counter clockwise theta radians
  (define cos-theta (cos theta))
  (define sin-theta (sin theta))
  (match-define (v2 x y) v)
  (v2 (- (* cos-theta x) (* (- sin-theta) y))
      (+ (* sin-theta x) (* cos-theta y))))

(define (random-direction) ; construct a vector pointing into a random direction
  (define max 10000)
  (define (rnd) (/ (- (random 1 (add1 max)) (/ max 2)) (/ max 2)))
  (vnorm (v2 (rnd) (rnd))))

;; Create a new random number which is around VALUE.  For example, this is
;; used to create velocities which are not the same, but all vary around a
;; value.
(define (random-around value #:precision (precision 1e4) #:nudge (nudge 1e-1))
  (define n (* value nudge))
  (define half-precision (exact-truncate (/ precision 2)))
  (+ value (* n  (/ (random (- half-precision) half-precision) precision))))


;;............................................................... bodies ....

;; a "body" represents an object in a physics engine -- the body has a
;; position, velocity and acceleration (all vectors), a radius (all our
;; physics bodies are circles.  The body also has an orientation and an
;; angular velocity, allowing the body to spin around itself.
;;
;; Finally, the body has a velocity-damping which is used to simulate friction
;; -- a body that has a velocity but no acceleration will slow down according
;; to this parameter
(struct body
  (position
   velocity
   acceleration
   radius
   orientation                          ; orientation for spinning bodies
   angular-velocity
   velocity-damping)
  #:transparent)

;; Create a new body representing the evolution of the body B after a period
;; of time DT.  If the body has acceleration, its velocity will be slightly
;; higher, if the body has velocity, its position will be updated.  Also, the
;; body's orientation will be updated according to its angular velocity.
;;
;; This body simulates the bodys movement in time.
(define (update-body b dt)
  (match-define (body position velocity acceleration radius orientation angular-velocity velocity-damping) b)
  (define new-velocity (vscale (vplus velocity (vscale acceleration dt)) velocity-damping))
  (define new-position (vplus position (vscale new-velocity dt)))
  (define new-orientation (+ orientation (* angular-velocity dt)))
  (body
   new-position
   new-velocity
   acceleration
   radius
   new-orientation
   angular-velocity
   velocity-damping))

;; Bounce the body around a surface with the normal N.  The body's velocity
;; will be reflected around the normal and perturbed slightly.  This is used
;; to implement bouncing of bodies on other objects.
(define (bounce-body b n)
  (define scale
    (if (< (vdot (vnorm (body-velocity b)) n) 0) -1 1))
  (define new-velocity
    (vrotate
     (vreflect (vscale (body-velocity b) scale) n)
     (* (body-angular-velocity b) 16)))
  (update-body (struct-copy body b [velocity new-velocity]) 16))

;; A function to draw the physics body -- shows its size, velocity and
;; orientation.  The physics body is not visible (the models are what are
;; visible), but this can be useful to debug the application -- add a call to
;; draw-debug-body in the paint method of the actors.
(define (draw-debug-body dc b)
  (define old-pen (send dc get-pen))

  (define r (body-radius b))
  (define p (body-position b))

  (define body-pen
    (send the-pen-list find-or-create-pen "darkslategray" 3 'short-dash))
  (send dc set-pen body-pen)
  (send dc draw-ellipse (- (v2-x p) r) (- (v2-y p) r) (* 2 r) (* 2 r))

  (define v (vplus p (vscale (body-velocity b) r)))

  (send dc set-pen (send the-pen-list find-or-create-pen "red" 5 'solid))
  (send dc draw-line (v2-x p) (v2-y p) (v2-x v) (v2-y v))

  (define a (vplus p (vscale (body-acceleration b) r)))
  (send dc set-pen (send the-pen-list find-or-create-pen "blue" 3 'solid))
  (send dc draw-line (v2-x p) (v2-y p) (v2-x a) (v2-y a))

  (define o (vplus p (vscale (vrotate vright (body-orientation b)) r)))
  (send dc set-pen (send the-pen-list find-or-create-pen "green" 1 'solid))
  (send dc draw-line (v2-x p) (v2-y p) (v2-x o) (v2-y o))

  (send dc set-pen old-pen))


;;........................................................... collisions ....

;; This section defines the basic collision handling mechanism -- actual
;; handlers are defined elsewhere.


;; A list of collision handlers, see `add-collision-handler`
(define the-collision-handlers '())

;; Add a new collision HANDLER between objects of type OBJECT-A and OBJECT-B.
;; OBJECT-A and OBJECT-B are classes (e.g. asteroid%) and the HADNLER function
;; receives two object and it is supposed to detect and handle collisions
;; between the two objects.
(define (add-collision-handler object-a object-b handler)
  (set! the-collision-handlers (cons (list object-a object-b handler) the-collision-handlers)))

;; Handle collisions between two actors using the COLLISION-HANDLERS list of
;; handlers (this is normally THE-COLLISION-HANDLERS), We iterate on the
;; collision handlers and check for a valid one depending on the types of the
;; objects.
(define (handle-collisions-between first-actor second-actor collision-handlers)
  (for/or ([handler (in-list collision-handlers)])
    (match-define (list first-object second-object handler-function) handler)
    
    ;; NOTE: a handler always wants an object of type OBJECT-A first, but we
    ;; also handle the case when the second actor is of type OBJECT-A by
    ;; swapping the arguments to the handler.
    (cond ((and (is-a? first-actor first-object)
                (is-a? second-actor second-object))
           (handler-function first-actor second-actor)
           #t)
          ((and (is-a? first-actor second-object)
                (is-a? second-actor first-object))
           (handler-function second-actor first-actor)
           #t)
          (else
           #f))))

;; Handle collisions in the SCENE (normally THE-SCENE) using
;; COLLISION-HANDLERS (normally THE-COLLISION-HANDLERS).  We simply call
;; `handle-collisions-between` for every pair of actors in the scene, taking
;; special care to not call the handlers twice for the same pair of objects.
(define (handle-collisions scene collision-handlers)
  (let outer-loop ([scene scene])
    (unless (null? scene)
      (define first-actor (first scene))
      ;; Only check for collisions between FIRST-ACTOR and the remaining
      ;; actors -- this ensures that we only call collision handling once for
      ;; each pair.
      (let inner-loop ([remaining-actors (rest scene)])
        (unless (null? remaining-actors)
          (define second-actor (first remaining-actors))
          (handle-collisions-between first-actor second-actor collision-handlers)
          (inner-loop (rest remaining-actors))))
      (outer-loop (rest scene)))))


;;............................................................... models ....

;; Create a pen for drawing a model.  Drawing models is done by scaling up the
;; DC coordinates, and this will scale up pen widths.  This creates a pen that
;; takes scaling into account.
(define (make-scaled-pen color width scale)
  (send the-pen-list find-or-create-pen color (/ width scale) 'solid))

;; Create a dc-path% object from a list of POINTS -- dc-path% objects are
;; easier to draw, but lists of points are easier to define, so this function
;; glues the two.
(define (points->dc-path points)
  (define path (new dc-path%))
  (unless (null? points)
    (match-define (list x y) (first points))
    (send path move-to x y)
    (for ([point (in-list (rest points))])
      (match-define (list x y) point)
      (send path line-to x y)))
  path)

;; Draw a model (a dc-path%) onto the device context DC using a PEN -- the
;; BODY is the physics body and defines the position and size of the model.
;; Since dc-path% objects are fixed, we control the position and orientation
;; by rotating, scaling and offseting the device context itself.
(define (draw-model dc model pen body)
  ;; Save parameters we are about to change
  (define old-transformation (send dc get-transformation))
  (define old-pen (send dc get-pen))

  (define position (body-position body))
  (define scale (body-radius body))
  (define orientation (body-orientation body))

  (send dc set-origin (v2-x position) (v2-y position))
  (send dc set-scale scale scale)
  (send dc set-rotation (- orientation))
  (send dc set-pen pen)
  (send dc draw-path model)

  ;; restore old parameters
  (send dc set-pen old-pen)
  (send dc set-transformation old-transformation))


;;............................................................ asteroid% ....

;; Asteroid `dc-path%` objects, defined around a circle of radius 1. Several
;; paths are defined, to make asteroids look different. When instantiated, an
;; `asteroid%` object will pick a random path to be its model.

(define asteroid-path-1
  (points->dc-path
   '((0/5 5/5) (3/5 4/5) (4/5 3/5) (3/5 1/5) (5/5 0/5) (4/5 -4/5) (1/5 -5/5)
               (-2/5 -4/5) (-4/5 -4/5) (-5/5 -1/5) (-3/5 -1/5) (-5/5 2/5) (-3/5 3/5)
               (-2/5 5/5) (0/5 5/5))))

(define asteroid-path-2
  (points->dc-path
   '((0 -6/5) (-2/5 -4/5) (-4/5 -4/5) (-5/5 -1/5) (-4/5 2/5) (-4/5 3/5)
              (-3/5 3/5) (-1/5 5/5) (4/5 3/5) (4/5 1/5) (5/5 0) (4/5 -3/5)
              (2/5 -4/5) (0 -6/5))))

(define asteroid-path-3
  (points->dc-path
   '((1/5 -4/5) (-2/5 -5/5) (-2/5 -3/5) (-4/5 -4/5) (-4/5 -2/5) (-5/5 0/5)
                (-5/5 3/5) (-3/5 4/5) (-2/5 3/5) (0/5 5/5) (4/5 3/5)
                (3/5 2/5) (3/5 1/5) (5/5 1/5) (4/5 -3/5) (3/5 -5/5)
                (1/5 -4/5))))

(define asteroid-path-4
  (points->dc-path
   '((0/5 -5/5) (-2/5 -4/5) (-4/5 -4/5) (-4/5 -1/5) (-5/5 1/5) (-3/5 4/5)
                (-1/5 5/5) (2/5 5/5) (1/5 3/5) (3/5 4/5) (5/5 1/5)
                (3/5 -2/5) (3/5 -4/5) (0/5 -5/5))))

(define asteroid-paths
  (list asteroid-path-1 asteroid-path-2 asteroid-path-3 asteroid-path-4))

;; The "asteroid%" actor represents asteroids on the screen.  They move
;; around, bounce around other asteroids and walls and are hit by missiles --
;; when hit by a missile, new smaller asteroids are created in their place.
(define asteroid%
  (class actor%
    (init-field [initial-position #f]
                [initial-direction (random-direction)]
                [initial-speed (random-around 0.05)]
                [initial-angular-velocity (random-around 0.0005)]
                [model (random-ref asteroid-paths)]
                [size (random 60 90)])
    (super-new)

    (unless initial-position
      (error "asteroid%: initial position must be specified"))

    (define the-body
      (body
       initial-position
       (vscale initial-direction initial-speed)
       vzero                ; no acceleration
       size                 ; radius
       0                    ; orientation
       initial-angular-velocity
       1.0                  ; no velocity damping
       ))

    (define/public (get-body) the-body)

    ;; Handle hitting a wall -- bounce the body around the normal of the wall
    (define/public (reflect-by-normal normal)
      (set! the-body (bounce-body the-body normal)))

    ;; Updating an asteroid means simply updating its physics body
    (define/override (update/delta-time dt)
      (set! the-body (update-body the-body dt)))

    (define pen (make-scaled-pen "firebrick" 3 size))

    ;; Painting an asteroid means simply paining the model.
    (define/override (paint _canvas dc)
      (draw-model dc model pen the-body))))


;;................................................................ wall% ....

;; A "wall%" is a simple actor which serves to as a collision body to keep
;; objects in the scene.  It does not draw itself anything (i.e. the wall is
;; invisible) and does not update itself, i.e. it is not moving anywhere.
;;
;; A wall is a line, which is defined as a normal and a distance from origin.
;; This form is useful in quickly determining how far away a point is from a
;; line.
(define wall%
  (class actor%
    (init-field normal distance)
    (super-new)

    (define/public (get-normal) normal)
    (define/public (get-distance) distance)

    ))


;;.................................................... asteroid-spawner% ....

;; Find the sum of the asteroid areas present in the scene -- this is an
;; estimate of how many asteroids are in the scene
(define (total-asteroid-area)
  (for/sum ([actor (in-list the-scene)] #:when (is-a? actor asteroid%))
    (define radius (body-radius (send actor get-body)))
    (* pi radius radius)))


;; Spawn a new asteroid -- we select a random position on the screen and a
;; random direction, than start the asteroid outside the playing field and
;; have it move towards the selected position -- this makes it appear that
;; asteroids come from "outside"
(define (spawn-asteroid)
  (define target (v2 (random canvas-width) (random canvas-height)))
  (define direction (random-direction))
  (define position
    (vplus target (vscale (vnegate direction) (max canvas-width canvas-height))))
  (add-actor (new asteroid%
                  [initial-position position]
                  [initial-direction direction])))
  
;; An "asteroid-spawner%" actor is responsible for monitoring the scene and if
;; the number of asteroids falls below a certain number, creates new
;; asteroids.
(define asteroid-spawner%
  (class actor%
    (init-field
     ;; interval at which we check if we need to spawn new asteroids
     [spawn-rate 1000]
     ;; minimum total area of the asteroids in the scene -- if the total size
     ;; falls below this number, a new asteroid will be created.  Default
     ;; value corresponds to about 3 big asteroids...
     [min-total-area 50000])
    (super-new)

    ;; Remaining time until we check if we need to spawn new asteroids
    (define remaining-time 0)

    (define/override (update/delta-time dt)
      (set! remaining-time (- remaining-time dt))
      (when (< remaining-time 0)
        ;; Count the total size of the asteroids in the scene -- this is a
        ;; good proxy for the "amount of asteroids" currently in the scene.
        (define total-area (total-asteroid-area))
        (when (< total-area min-total-area)
          (spawn-asteroid))
        (set! remaining-time spawn-rate)))

    ))


;;................................................................ ship% ....

;; The points making the outline of the space ship.  These are all on a circle
;; of radius 1.
(define space-ship-points
  '((5/5 0/5) (-4/5 -3/5) (-3/5 -1/5) (-3/5 1/5) (-4/5 3/5) (5/5 0/5)))

;; A `dc-path%` made of the space ship points
(define space-ship-path (points->dc-path space-ship-points))

;; The points making the outline of the space ship thrust
(define space-ship-thrust-path
  (points->dc-path '((-3/5 -1/5) (-4/5 0/5) (-3/5 1/5) (-3/5 -1/5))))

;; A `dc-path%` made of the thrust points
(define space-ship-scale 30)

;; Amount of time the space ship is invincible (i.e. cannot be destroyed by
;; collisions) when the space ship is created -- this allows spawning the ship
;; in the middle of the game screen and allowing the user to move to a safe
;; position themselves, instead of trying to find a safe spot to spawn a new
;; ship...
(define space-ship-cooldown 5000)

;; Amount of time between missile launches when the user keeps the space bar
;; down -- this defines the shooting rate of the ship.
(define space-ship-shoot-interval 250)

;; The "space-ship%" actor represents the space ship in the game -- the user
;; can control its thrust and angular velocity as well as fire missiles (which
;; are represented by a separate "missile%" actor) -- the ship participates in
;; collisions with the walls at the edge of the screen, making it bounce back,
;; as well as the asteroids, which destroy the ship.
(define space-ship%
  (class actor%
    (init-field [position (v2 (/ canvas-width 2) (/ canvas-height 2))])
    (super-new)

    ;; The physics body representing the ship, initially with no velocity or
    ;; acceleration.  Note that the ship has a velocity damping -- making it
    ;; appear to have friction, slowing it down, so the ship will not stop
    ;; when the acceleration is removed, but will also not continue to travel
    ;; indefinitely.
    (define the-body
      (body
       position
       vzero                ; no initial velocity
       vzero                ; no initial acceleration
       space-ship-scale
       0                    ; orientation
       0                    ; no angular-velocity
       0.98))               ; velocity damping

    ;; The amount of time remaining when the ship is invincible, when 0, the
    ;; ship can collide with asteroids
    (define cooldown space-ship-cooldown)

    ;; When #t, the ship is shooting missiles
    (define shooting? #f)
    
    ;; Amount of time remaining until the ship can fire the next shot.  If 0
    ;; or less, the ship can fire now.
    (define repeat-shoot-time 0)

    ;; Return the physics body of the ship -- this is used in collision
    ;; detection
    (define/public (get-body) the-body)

    ;; Handle bumping into a wall defined by NORMAL.  We bounce the ships body
    ;; around the normal.
    (define/public (bumped-into-wall normal)
      (set! the-body (bounce-body the-body normal)))

    ;; Return #t if the ship is in the cooldown period, when it cannot be
    ;; destroyed.
    (define/public (cooldown?) (> cooldown 0))

    (define/override (update/delta-time dt)
      ;; First, update the body, according to its velocity, acceleration and
      ;; angular velocity, given the amount of time passed (dt)
      (set! the-body (update-body the-body dt))

      ;; Decrease the cooldown time
      (when (> cooldown 0)
        (set! cooldown (- cooldown dt)))

      ;; When the ship is shooting, check the repeat-shoot-time and create
      ;; missile% objects
      (when shooting?
        (set! repeat-shoot-time (- repeat-shoot-time dt))
        (when (<= repeat-shoot-time 0)
          (set! repeat-shoot-time (+ repeat-shoot-time space-ship-shoot-interval))
          (define position (body-position the-body))
          (define direction (vrotate vright (body-orientation the-body)))
          (define scale (body-radius the-body))
          (add-actor (new missile%
                          [position (vplus position (vscale direction scale))]
                          [direction direction])))))

    (define pen (make-scaled-pen "forestgreen" 5 space-ship-scale))
    (define thrust-pen (make-scaled-pen "dark orange" 3 space-ship-scale))
    (define cooldown-pen (send the-pen-list find-or-create-pen "red" 2 'solid))

    (define/override (paint _canvas dc)
      ;; Draw the ship model
      (draw-model dc space-ship-path pen the-body)

      ;; If the ship is accelerating or has an angular velocity, also draw the
      ;; thrust outline.
      (when (or (not (zero? (body-angular-velocity the-body)))
                (> (vlength (body-acceleration the-body)) 0))
        (draw-model dc space-ship-thrust-path thrust-pen the-body))
      
      ;; When the cooldown is active, draw an arc of a circle around the ship
      ;; -- the arc shortens as the cooldown timer goes down.
      (when (> cooldown 0)
        (define remaining-cooldown (/ cooldown space-ship-cooldown))
        (define r (body-radius the-body))
        (define p (body-position the-body))
        (define o (body-orientation the-body))
        (define a (* pi remaining-cooldown))
        (define old-pen (send dc get-pen))
        (send dc set-pen cooldown-pen)
        (send dc draw-arc
              (- (v2-x p) r) (- (v2-y p) r)
              (* 2 r) (* 2 r)
              (- (- o) a)
              (+ (- o) a))
        (send dc set-pen old-pen)))

    ;; Handle a keyboard event to move the ship and shoot missiles.  Note that
    ;; we track both key-press and key-release events, rather than relying on
    ;; the keyboards repeat rate.
    (define/override (keyboard-event event)
      (case (send event get-key-code)
        ;; If the user presses the left or right keys, update the bodys
        ;; angular velocity to make the ship rotate.
        ((left)
         (set! the-body (struct-copy body the-body [angular-velocity -0.005])))
        ((right)
         (set! the-body (struct-copy body the-body [angular-velocity 0.005])))
        ;; If the user presses the up key, update the ships acceleration, so
        ;; the ship starts moving.
        ((up)
         (define a (vscale (vrotate vright (body-orientation the-body)) 0.001))
         (set! the-body (struct-copy body the-body [acceleration a])))

        ;; If the user presses the space key, set shooting? to #t --
        ;; update/delta-time will create missile% objects.
        ((#\space)
         (set! shooting? #t))

        ((release)
         (define code (send event get-key-release-code))
         ;; If the user released the left or right key, set the
         ;; angular-velocity to 0 to stop the ship from rotating
         (when (member code '(left right))
           (set! the-body (struct-copy body the-body [angular-velocity 0])))

         ;; If the user released the up key, set the acceleration to zero, to
         ;; make the ship eventually slow down (note that it still keeps its
         ;; velocity)
         (when (member code '(up))
           (set! the-body (struct-copy body the-body [acceleration vzero])))

         ;; If the user released the space key, set shooting? to false, so we
         ;; stop shooting.
         (when (member code '(#\space))
           (set! shooting? #f)
           (set! repeat-shoot-time 0)))))

    ))


;;.......................................................... missile% ....

;; A missile actor represents one shot from the ship.  A shot will start at
;; the ship's position and travel in the direction of the ship.  The shot
;; either hits a target (handled by the handle-collisions-between function),
;; or expires after a certain amount of time
(define missile%
  (class actor%
    (init-field position                ; position where the missile starts
                direction               ; direction in which it is moving
                ;; amount of time this actor will be active -- if it does not
                ;; hit a target in this time, it will expire and will remove
                ;; itself from the scene.
                [life-time 5000])
    (super-new)

    (define length 30)                  ; the length of the missile

    ;; The physics body for the missile.  The tip of the shot is at the
    ;; position of the body and the tail is at the radius position in the
    ;; opposite of the travel direction.
    (define the-body
      (body
       (vplus position (vscale direction length))
       (vscale direction 0.3)           ; direction and speed
       vzero                            ; no acceleration
       length                           ; radius
       0                                ; no orientation
       0                                ; no angular velocity
       1))                              ; no velocity damping


    ;; Return the position of the tip of the shot -- used in collision
    ;; detection
    (define/public (get-tip-position) (body-position the-body))

    ;; Update the missile -- it travels using `update-body`, but if its
    ;; lifetime expired, it is removed form the scene.
    (define/override (update/delta-time dt)
      (set! life-time (- life-time dt))
      (when (< life-time 0)
        (remove-actor this))
      (set! the-body (update-body the-body dt)))

    ;; Pen used to draw the missile
    (define pen (send the-pen-list find-or-create-pen "corflowerblue" 2 'solid))

    (define/override (paint _canvas dc)
      (define old-pen (send dc get-pen))
      (send dc set-pen pen)
      (define tip (get-tip-position))
      (define tail (vplus (get-tip-position)
                          (vscale (vnorm (body-velocity the-body))
                                  (* -1 (body-radius the-body)))))
      (send dc draw-line (v2-x tip) (v2-y tip) (v2-x tail) (v2-y tail))
      (send dc set-pen old-pen))

    ))


;;........................................................... explosion% ....

;; A "bubble" is used in the explosion% object to track the bubbles that form
;; the explosion.
(struct bubble (position direction size speed) #:transparent)

;; The "explosion%" is an actor which simulates an "explosion" by drawing a
;; set of bubbles that move away from an initial position.  It is used when an
;; asteroid or the space ship are destroyed.
(define explosion%
  (class actor%
    (init-field position               ; position where the explosion happened
                [bubble-count 50]      ; number of bubbles to draw
                ;; life time of the explosion, the object is removed after
                ;; this amount of time
                [life-time 2000])
    (super-new)

    (define bubbles
      (for/list ([n (in-range bubble-count)])
        (bubble position
                (random-direction)
                (random 5 30)
                (random-around 0.3 #:nudge 0.5))))

    (define/override (update/delta-time dt)
      (set! life-time (- life-time dt))
      (if (< life-time 0)
          (remove-actor this)           ; we're done, remove ourselves from the scene
          (set! bubbles
                (for/list ([b (in-list bubbles)])
                  (match-define (bubble position direction size speed) b)
                  (bubble
                   (vplus position (vscale direction (* speed dt)))
                   direction            ; does not change
                   (* size 1.02)        ; bubble size grows with time
                   speed)))))           ; speed does not change

    ;; Pen used to draw the circles
    (define pen (send the-pen-list find-or-create-pen "darkslategray" 2 'solid))

    (define/override (paint _canvas dc)
      (define old-pen (send dc get-pen))
      (send dc set-pen pen)
      (for ([b (in-list bubbles)])
        (match-define (bubble p _d s _e) b)
        (send dc draw-ellipse (- (v2-x p) (/ s 2)) (- (v2-y p) (/ s 2)) s s))
      (send dc set-pen old-pen))))


;;.......................................................... game-score% ....

;; The "game-score%" is an actor which displays the score in the top - left
;; corner of the screen.  The game score is kept in the global 'game-score'
;; variable and updated when asteroids are hit.  This actor will display an
;; incrementing counter which targets the 'game-score', but lags behind it --
;; this produces the familiar incrementing counter effect in games.
(define game-score%
  (class actor%
    (init)
    (super-new)

    (define displayed 0)                ; the game score we actually display.

    ;; Update the displayed score -- if it is less than the game score, we add
    ;; a fraction of the difference to `displayed`
    (define/override (update/delta-time _dt)
      (when (< displayed game-score)
        (define difference (- game-score displayed))
        (set! displayed (exact-truncate (+ displayed (* 0.10 difference))))))

    ;; Text font used to display the score
    (define text-font (send the-font-list find-or-create-font 24 'default 'normal))

    ;; Show the displayed value in the top - left corner of the screen
    (define/override (paint canvas dc)
      (define label (~a displayed #:width 7 #:left-pad-string "0" #:align 'right))
      (define old-font (send dc get-font))
      (send dc set-font text-font)
      (send dc draw-text label 5 5)
      (send dc set-font old-font))

    ))


;;............................................................... spares% ....

;; The "spares%" is an actor that keeps spare space ships to be used if the
;; main ship is destroyed.  It is used to implement the concept of "Remaining
;; Lives" in a game.  It is responsible for spawning a ship when the main one
;; is destroyed or signal that it is game over when all the spares have been
;; used up.  It also paints the list of spare ships in the top - right corner
;; of the game screen so the user knows how many ships they have left.
(define spares%
  (class actor%
    (init-field [initial 5])
    (super-new)

    ;; Number of spare space ships still remaining, when this is 0 and a new
    ;; space ship needs to be spawned, its game over.
    (define remaining initial)

    ;; Interval at which we check if the current space ship was destroyed --
    ;; we could check every time `update/delta-time` is called, but this is a
    ;; bit excessive.
    (define check-interval 3000)

    ;; Remaining time until the next check, when less than zero, it is time to
    ;; check if a new ship needs to be spawned.
    (define cooldown 0)

    (define/override (update/delta-time dt)
      (set! cooldown (- cooldown dt))
      (when (< cooldown 0)
        (set! cooldown (+ cooldown check-interval))
        ;; Try to find the ship in the scene
        (define ship
          (for/first ([actor (in-list the-scene)]
                      #:when (is-a? actor space-ship%))
            actor))
        (unless ship                    ; there is no ship!
          ;; If we still have spares, add another ship to the scene, otherwise
          ;; signal that it is game over.
          (if (> remaining 0)
              (add-actor (new space-ship%))
              (set! game-outcome 'game-over))
          (set! remaining (sub1 remaining)))))

    ;; The scale of the spare space ships is smaller than the main one -- to
    ;; avoid confusing between the spares and the main ship.
    (define scale (* space-ship-scale 0.75))

    ;; Bodies to represent the spare space ships.  These bodies are only used
    ;; to position the spare ships when they are painted in the top - left of
    ;; the game window and will not otherwise move or participate in
    ;; collisions.
    (define bodies
      (for/list ([index (in-range initial 0 -1)])
        (define x (- canvas-width (* 2 index scale)))
        (define y scale)
        (body (v2 x y) vzero vzero scale 0 0 0)))

    ;; Pens used to draw the remaining and used up space ship spares.  They
    ;; should be distinct from the main space ship.
    (define remaining-pen (make-scaled-pen "teal" 5 scale))
    (define used-pen (make-scaled-pen "dark gray" 5 scale))

    ;; Paint the spare space ships (both used up and remaining).
    (define/override (paint canvas dc)
      (for ([body (in-list bodies)]
            [index (in-naturals)])
        (define pen (if (>= index remaining) used-pen remaining-pen))
        (draw-model dc space-ship-path pen body)))

    ))


;;................................................... collision-handling ....

;; Determine if two bodies collide -- i.e. the distance between their centers
;; is smaller than the sum of their radii.
(define (bodies-collide? b1 b2)
  (define center-direction (vminus (body-position b1) (body-position b2)))
  (define distance-between-centres (vlength center-direction))
  (< distance-between-centres (+ (body-radius b1) (body-radius b2))))

;; Determine if a body and a wall collide, i.e the distance from the center of
;; the body to the wall is less than the body radius.
(define (body-wall-collision? b wall-normal wall-distance)
  (define centre-to-wall-distance
    (+ (vdot wall-normal (body-position b)) wall-distance))
  (< centre-to-wall-distance (body-radius b)))

;; Determine is a body and a point collide, i.e the distance from the point to
;; the center of the body is less than the body radius.
(define (body-point-collision? b p)
  (define centre-to-point-distance (vlength (vminus p (body-position b))))
  (< centre-to-point-distance (body-radius b)))

;; Handle an asteroid - wall collision -- if they collide, reflect the
;; asteroid.
(define (handle-asteroid-wall-collision a w)
  (when (body-wall-collision? (send a get-body) (send w get-normal) (send w get-distance))
    (send a reflect-by-normal (send w get-normal))))

;; Add the handler for the asteroid - wall collision
(add-collision-handler asteroid% wall% handle-asteroid-wall-collision)

;; Handle the space-ship - wall collision -- if they collide, reflect the
;; space ship
(define (handle-space-ship-wall-collision s w)
  (when (body-wall-collision? (send s get-body) (send w get-normal) (send w get-distance))
    (send s bumped-into-wall (send w get-normal))))

(add-collision-handler space-ship% wall% handle-space-ship-wall-collision)

;; Handle an asteroid - asteroid collision -- if they collide, reflect both of
;; them on the collision normal
(define (handle-asteroid-asteroid-collision a b)
  (define a-body (send a get-body))
  (define b-body (send b get-body))
  (when (bodies-collide? a-body b-body)
    (define collision-direction
      (vnorm (vminus (body-position a-body) (body-position b-body))))
    (send a reflect-by-normal collision-direction)
    (send b reflect-by-normal (vscale collision-direction -1))))

(add-collision-handler asteroid% asteroid% handle-asteroid-asteroid-collision)

;; Handle an asteroid - missile collision -- if they collide, remove the
;; asteroid and the missile, add an explosion and some smaller asteroids
(define (handle-asteroid-missile-collision a l)
  (define a-body (send a get-body))
  
  (when (body-point-collision? a-body (send l get-tip-position))
    (remove-actor a)                   ; This asteroid is no more
    (remove-actor l)                   ; ... and neither is the missile
    (add-actor (new explosion% [position (body-position a-body)])) ; add an explosion
      
    ;; Add some smaller asteroids to the scene
    (define size (body-radius a-body))
    (when (> size 25)
      (define new-size (* size 0.60))
      (define position (body-position a-body))
      (define direction (vnorm (body-velocity a-body)))
      (define offset (vscale direction size))
      (for ([rotation (list 0 (/ (* 2 pi) 3) (- (/ (* 2 pi) 3)))])
        (define new-position (vplus position (vrotate offset rotation)))
        (add-actor (new asteroid%
                        [size new-size]
                        [initial-position new-position]))))

    ;; Update the game score -- user gets more points for hitting a smaller
    ;; asteroid.
    (set! game-score (+ game-score (+ 100 (* 1000 (max 0 (- 1 (/ size 100)))))))))

(add-collision-handler asteroid% missile% handle-asteroid-missile-collision)

;; Handle a space-ship - asteroid collision -- if they collide, destroy the
;; space ship and add an explosion to the scene
(define (handle-space-ship-asteroid-collision s a)
  (unless (send s cooldown?)            ; ship is invincible during cooldown
    (define collision?
      (and (bodies-collide? (send s get-body) (send a get-body))
           ;; bodies-collide? will indicate that the two circles representing
           ;; the bodies actually collide, but we want more precision for the
           ;; ship, so we now check if any point of the ship is inside the
           ;; asteroid -- this does not work correctly, as we would have to
           ;; check for line segment intersections between two polygons, but
           ;; this error it is in the favor of the user and keeps the code
           ;; simple, so we'll let it pass.
         (let* ([a-body (send a get-body)]
                [s-body (send s get-body)]
                [s-center (body-position s-body)])
           (for/or ([point (in-list space-ship-points)])
             (match-define (list x y) point)
             (body-point-collision? a-body (vplus (v2 x y) s-center))))))
    (when collision?
      (remove-actor s)
      (add-actor (new explosion% [position (body-position (send s get-body))])))))

(add-collision-handler space-ship% asteroid% handle-space-ship-asteroid-collision)


;;...................................................... setup the scene ....

(add-actor (new space-ship%))           ; our space ship
(add-actor (new spares% [initial 3]))   ; add some spare ships
(add-actor (new game-score%))           ; show the game score
(add-actor (new asteroid-spawner% [min-total-area 120000])) ; someone has to produce the asteroids

;; These are the walls making up the scene, everything bounces inside these
;; walls.
(add-actor (new wall% [normal vright] [distance 0]))
(add-actor (new wall% [normal vleft] [distance canvas-width]))
(add-actor (new wall% [normal vdown] [distance 0]))
(add-actor (new wall% [normal vup] [distance canvas-height]))

(run-game-loop)