asteroids-1.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)


;;...................................................... 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 delta-time)
  (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)

;; 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 800] [height 450]))

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

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

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

;; 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)
  (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))


;;............................................................... 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 laser shots
;; -- when hit by laser shot, 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
       ))

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

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

(add-actor (new asteroid%
                [initial-position (v2 150 200)]
                [initial-direction (random-direction)]
                [initial-speed 0.04]))
(add-actor (new asteroid%
                [initial-position (v2 350 200)]
                [initial-direction (random-direction)]
                [initial-speed 0.04]))
(add-actor (new asteroid%
                [initial-position (v2 550 200)]
                [initial-direction (random-direction)]
                [initial-speed 0.04]))
(run-game-loop)