Playing with raycasting

I wanted to learn about raycasting. Raycasting is like a simplified version of ray tracing. As in ray tracing, you examine the environment by projecting a ray from your current location out in some direction to determine what is visible in that direction. But we simplify the problem by only considering two dimensions.

I was also interested in making the graphics more functional and less dependent upon side effects. Now obviously rendering an image to the screen is going to involve side effects, but we can refactor the rendering problem into two subproblems, a pure function that maps the world to an image and the procedure that displays the image.

I'll put the code below. The run procedure implements the event loop state machine. It keeps track of the world and calls next-world on the current world to update the world as time passes. next-world just maps next-state over the objects in the world. next-state does not mutate an object, rather it returns a new object in the new state. Every 13 milliseconds, run calls render-world!, which calls render! on each object in the world.

We're going to use raycasting to fake up a first-person view of a two-dimensional maze. From a position within the maze, we'll cast a ray in a direction and see how far away the wall is. If we peer at the wall through a narrow slit in just that direction, it will appear as a vertical line with height inversely proportional to its distance. If we sweep the ray direction and stack the vertical lines next to each other, it will create three dimensional effect.

The render! method for a fp-view will side effect the screen, but we'll compute the contents functionally. We'll go through each column on the screen and call (vraster fp-view column) to compute a color and a height and we'll draw a vertical line of that height in that color in that column.

(defmethod render! (renderer (fp-view fp-view))
  (dotimes (column +window-width+)
    (multiple-value-bind (r g b height)
        (vraster fp-view column)
      (sdl2:set-render-draw-color renderer r g b #xFF)
      (sdl2:render-draw-line renderer
                             column (round (+ (/ +window-height+ 2) (/ height 2)))
                             column (round (- (/ +window-height+ 2) (/ height 2)))))))

vraster is a function that returns the color and height of the wall on a particular column on the screen. It figures out the angle at which to cast to a ray and calls range to find the distance to the nearest wall at that angle. This is sufficient to determine the wall height for that column, but the first person effect is enhanced significantly if you tint the color according to the distance and the direction of the wall. Knowing the distance, we compute the exact point px, py that the ray hit. It's a wall in the x direction if the y coordinate is an integer and vice versa.

(defparameter +field-of-view+ (/ pi 4))

(defun column->theta (column)
  (- (* (/ column +window-width+) +field-of-view+) (/ +field-of-view+ 2)))

(defun vraster (fp-view column)
  (let* ((location (get-location fp-view))
         (theta (column->theta column))
         (distance (range location theta))
         (px (+ (get-x location) (* (sin (+ (get-theta location) theta)) distance)))
         (py (+ (get-y location) (* (cos (+ (get-theta location) theta)) distance)))
         (wx (< (abs (- py (round py))) 0.05))
         (wy (< (abs (- px (round px))) 0.05)))
    (values
     (min #xFF (floor (/ (if wx #xff #x00) distance)))
     (min #xFF (floor (/ #xFF distance)))
     (min #xFF (floor (/ (if wy #xff #x00) distance)))
     (min +window-height+ (/ (* +window-height+ 2) distance)))))

So we've factored the rendering of a frame into a procedure that draws on the screen and a function that returns what to draw. The direct advantage of this is that we can determine what we should draw without actually drawing it. As an example, suppose we wanted to generate a stereo pair of images. The only thing we need to change is the render! method. It will now compute the view from two slightly different locations and put one set of columns on the left and the other on the right.

(defmethod render! (renderer (fp-view fp-view))
  (dotimes (column (/ +window-width+ 2))
    (multiple-value-bind (r g b height)
        (vraster (left-eye (get-location fp-view)) (* column 2))
      (sdl2:set-render-draw-color renderer r g b #xFF)
      (sdl2:render-draw-line renderer
                             column (round (+ (/ +window-height+ 2) (/ height 2)))
                             column (round (- (/ +window-height+ 2) (/ height 2)))))
    (multiple-value-bind (r g b height)
        (vraster (right-eye (get-location fp-view)) (* column 2))
      (sdl2:set-render-draw-color renderer r g b #xFF)
      (sdl2:render-draw-line renderer
                             (+ column (/ +window-width+ 2)) (round (+ (/ +window-height+ 2) (/ height 2)))
                             (+ column (/ +window-width+ 2)) (round (- (/ +window-height+ 2) (/ height 2)))))))

In this and in a previous post I've gone through the effort of writing some graphics code while avoiding unnecessary side effects. Typical graphics examples and tutorials are stuffed to the brim with global variables, state, and side effects. I wanted to see which side effects were intrinsic to graphics and which are simply incidental to how the examples are coded. It appears that large amounts of the global state and side effects are unnecessary and a more functional approach is reasonable.

As promised, here is the code.

;;; -*- Lisp -*-

(defpackage "RAYCAST"
  (:shadowing-import-from "NAMED-LET" "LET")
  (:use "COMMON-LISP" "NAMED-LET""))

(in-package "RAYCAST")

(defparameter +window-height+ 480)
(defparameter +window-width+ 640)

(defgeneric next-state (object dt)
  (:method ((object t) dt) object))
(defgeneric render! (renderer thing))

(defun next-world (previous-world dt)
  (map 'list (lambda (object) (next-state object dt)) previous-world))

(defun render-world! (renderer world)
  (sdl2:set-render-draw-color renderer #x00 #x00 #x00 #xFF)
  (sdl2:render-clear renderer)
  (mapc (lambda (object) (render! renderer object)) world)
  (sdl2:render-present renderer))

(defun run (initial-world)
  (sdl2:with-init (:video)
    (sdl2:with-window (window
                       :h +window-height+
                       :w +window-width+
                       :flags '(:shown))
      (sdl2:with-renderer (renderer window :index -1 :flags '(:accelerated :presentvsync))

        (let ((last-ticks 0)
              (render-ticker 0)
              (title-ticker 0)
              (sim-count 0)
              (frame-count 0)
              (world initial-world))

          (flet ((title-tick! (dticks)
                   (incf title-ticker dticks)
                   (when (>= title-ticker 1000)
                     (decf title-ticker 1000)
                     (sdl2:set-window-title window
                                            (format nil "Sim rate: ~d, Frame rate: ~d"
                                                    sim-count frame-count))
                     (setq sim-count 0)
                     (setq frame-count 0)))

                 (world-tick! (dticks)
                   (incf sim-count)
                   (setq world (next-world world (/ dticks 1000))))

                 (render-tick! (dticks)
                   (incf render-ticker dticks)
                   (when (>= render-ticker 13)
                     (incf frame-count)
                     (decf render-ticker 13)
                     (render-world! renderer world))))

            (sdl2:with-event-loop (:method :poll)

              (:idle ()
                     (let ((this-ticks (sdl2:get-ticks)))
                       (if (= this-ticks last-ticks)
                           (sdl2:delay 1)
                           (let ((dticks (- this-ticks last-ticks)))
                             (setq last-ticks this-ticks)
                             (title-tick! dticks)
                             (world-tick! dticks)
                             (render-tick! dticks)))))

              (:keydown (:keysym keysym)
                        (case (sdl2:scancode keysym)
                          ((:scancode-x :scancode-escape) (sdl2:push-quit-event))
                          ((:scancode-left :scancode-right
                            :scancode-up :scancode-down
                            :scancode-pageup :scancode-pagedown)
                           nil)
                          (t (format *trace-output* "~&Keydown: ~s" (sdl2:scancode keysym))
                           (force-output *trace-output*))))

              (:quit () t)
              )))))))

(defparameter +maze+
  #2a((1 1 1 1 1 1 1 1 1 1 1 1)
      (1 0 0 1 0 0 0 0 0 0 0 1)
      (1 0 0 1 0 0 0 0 0 0 0 1)
      (1 0 1 1 0 0 0 1 0 1 0 1)
      (1 0 0 0 0 0 0 0 0 0 0 1)
      (1 0 0 0 0 0 0 1 0 1 0 1)
      (1 0 0 0 0 0 0 0 0 0 0 1)
      (1 0 0 0 0 0 0 0 0 0 0 1)
      (1 0 0 0 0 1 0 0 0 1 0 1)
      (1 0 0 0 0 0 0 0 0 0 0 1)
      (1 1 1 1 1 1 1 1 1 1 1 1)))

(defclass location ()
  ((maze :initarg :maze
         :initform +maze+
         :reader get-maze)
   (x :initarg :x
      :initform 2.5
      :reader get-x)
   (y :initarg :y
      :initform 2.5
      :reader get-y)
   (theta :initarg :theta
          :initform 0
          :reader get-theta)))

(defun ud-input ()
  (- (if (sdl2:keyboard-state-p :scancode-up) 1 0)
     (if (sdl2:keyboard-state-p :scancode-down) 1 0)))

(defun lr-input ()
  (- (if (sdl2:keyboard-state-p :scancode-right) 1 0)
     (if (sdl2:keyboard-state-p :scancode-left) 1 0)))

(defun pg-input ()
  (- (if (sdl2:keyboard-state-p :scancode-pageup) 1 0)
     (if (sdl2:keyboard-state-p :scancode-pagedown) 1 0)))

(defun canonicalize-angle (angle)
  (cond ((>= angle pi) (canonicalize-angle (- angle (* pi 2))))
        ((>= angle (- pi)) angle)
        (t (canonicalize-angle (+ angle (* pi 2))))))

(defparameter +translation-rate+ 3.0) ;; tiles per second
(defparameter +rotation-rate+ pi) ;; radians per second

(defmethod next-state ((location location) dt)
  (let ((fbstep (* (ud-input) +translation-rate+ dt))
        (lrstep (* (pg-input) +translation-rate+ dt))
        (thstep (* (lr-input) +rotation-rate+ dt))

        (old-x (get-x location))
        (old-y (get-y location))
        (cos-theta (cos (get-theta location)))
        (sin-theta (sin (get-theta location))))

    (let ((new-x (+ old-x (* sin-theta fbstep) (- (* cos-theta lrstep))))
          (new-y (+ old-y (* cos-theta fbstep) (+ (* sin-theta lrstep))))
          (new-theta (canonicalize-angle (+ (get-theta location) thstep))))
      (cond ((zerop (aref (get-maze location) (floor new-x) (floor new-y)))
             (make-instance 'location :x new-x :y new-y :theta new-theta))
            ((zerop (aref (get-maze location) (floor old-x) (floor new-y)))
             (make-instance 'location :x old-x :y new-y :theta new-theta))
            ((zerop (aref (get-maze location) (floor new-x) (floor old-y)))
             (make-instance 'location :x new-x :y old-y :theta new-theta))
            (t
             (make-instance 'location :x old-x :y old-y :theta new-theta))))))

(defclass fp-view ()
  ((location :initarg :location
             :reader get-location)))

(defmethod next-state ((fp-view fp-view) dt)
  (make-instance 'fp-view :location (next-state (get-location fp-view) dt)))

(defun range (location relative-theta)
  (let* ((angle (+ (get-theta location) relative-theta))

         (dx/dS (sin angle))
         (dy/dS (cos angle))

         (x-step (if (< dx/dS 0) -1 1))
         (y-step (if (< dy/dS 0) -1 1))

         (dS/dx (abs (/ 1 (if (zerop dx/dS) 1e-30 dx/dS))))
         (dS/dy (abs (/ 1 (if (zerop dy/dS) 1e-30 dy/dS)))))

    (let dda ((next-x (* dS/dx
                         (if (< dx/dS 0)
                             (- (get-x location) (floor (get-x location)))
                             (- (+ 1.0 (floor (get-x location))) (get-x location)))))
              (mapx (floor (get-x location)))
              (next-y (* dS/dy
                         (if (< dy/dS 0)
                             (- (get-y location) (floor (get-y location)))
                             (- (+ 1.0 (floor (get-y location))) (get-y location)))))
              (mapy (floor (get-y location)))
              (distance 0))
      (cond ((not (zerop (aref (get-maze location) mapx mapy))) distance)
            ((< next-x next-y)
             (dda (+ next-x dS/dx) (+ mapx x-step)
                  next-y mapy
                  next-x))
            (t
             (dda next-x mapx
                  (+ next-y dS/dy) (+ mapy y-step)
                  next-y))))))

(defparameter +field-of-view+ (/ pi 4))

(defun column->theta (column)
  (- (* (/ column +window-width+) +field-of-view+) (/ +field-of-view+ 2)))

(defun vraster (location column)
  (let* ((theta (column->theta column))
         (distance (range location theta))
         (px (+ (get-x location) (* (sin (+ (get-theta location) theta)) distance)))
         (py (+ (get-y location) (* (cos (+ (get-theta location) theta)) distance)))
         (wx (< (abs (- py (round py))) 0.05))
         (wy (< (abs (- px (round px))) 0.05)))
    (values
     (min #xFF (floor (/ (if wx #xff #x00) distance)))
     (min #xFF (floor (/ #xfF distance)))
     (min #xFF (floor (/ (if wy #xff #x00) distance)))
     (min +window-height+ (/ (* +window-height+ 2) distance)))))

(defmethod render! (renderer (fp-view fp-view))
  (dotimes (column +window-width+)
    (multiple-value-bind (r g b height)
        (vraster (get-location fp-view) column)
      (sdl2:set-render-draw-color renderer r g b #xFF)
      (sdl2:render-draw-line renderer
                             column (round (+ (/ +window-height+ 2) (/ height 2)))
                             column (round (- (/ +window-height+ 2) (/ height 2)))))))

;; (run (list (make-instance 'fp-view :location (make-instance 'location))))