~nprescott/ray-tracer

9ada50d1b4840f417b351a432df01cab95b53b9b — Nolan Prescott 1 year, 5 days ago 6ff9a90
add REAL RAY CASTING

I mean, it is only an ugly red circle, but IT ACTUALLY WORKS
3 files changed, 229 insertions(+), 7 deletions(-)

M sample.lisp
M tests.lisp
M tracer.lisp
M sample.lisp => sample.lisp +26 -1
@@ 1,7 1,7 @@
(defpackage :com.nprescott.raytracer-sample-code
  (:use :common-lisp :com.nprescott.raytracer))

;;; sample
;;; projectile test
(defstruct projectile position velocity)
(defstruct environment gravity wind)



@@ 51,3 51,28 @@
      (mapcar #'(lambda (p) (paint-with-offset canvas p))
              (loop for hour below 12 collect (face-point hour)))
      (ppm->file (canvas->ppm canvas) "/home/nolan/test-output.ppm"))))

;;; silhouette test
(defun cast-silhouette ()
  (let* ((ray-starting-place (point 0 0 -5))
         (wall-z 10)
         (wall-size 7.0)
         (canvas-pixels 100)
         (pixel-size (/ wall-size canvas-pixels))
         (half (/ wall-size 2))
         (c (make-canvas :width canvas-pixels :height canvas-pixels))
         (color (vec3 255 0 0))
         (shape (make-sphere)))
    ;; (set-transform shape (matrix*matrix (shearing 1 0 0 0 0 0)
    ;;                                     (scaling 0.5 1 1)))
    (loop for y below canvas-pixels
       for world-y = (- half (* pixel-size y))
       do (loop for x below canvas-pixels
             for world-x = (+ (- half) (* pixel-size x))
             for the-position = (point world-x world-y wall-z)
             for r = (make-ray :origin ray-starting-place
                               :direction (normalize (VECTOR- the-position
                                                              ray-starting-place)))
             for xs = (intersect shape r)
             when (hit xs) do (write-pixel c x y color)))
    (ppm->file (canvas->ppm c) "/home/nolan/test-output.ppm")))

M tests.lisp => tests.lisp +160 -1
@@ 526,8 526,167 @@
  (shearing-transforms-z-proportionally-to-y)
  (chaining-transformations))

(deftest creating-and-querying-ray
  (let* ((origin (point 1 2 3))
         (direction (vec3 4 5 6))
         (r (make-ray :origin origin :direction direction)))
    (check (equalp (ray-origin r) origin)
           (equalp (ray-direction r) direction))))

(deftest point-from-distance
  (let ((r (make-ray :origin (point 2 3 4) :direction (vec3 1 0 0))))
    (check (equalp (ray-position r 0) (point 2 3 4))
           (equalp (ray-position r 1) (point 3 3 4))
           (equalp (ray-position r -1) (point 1 3 4))
           (equalp (ray-position r 2.5) (point 4.5 3 4)))))

(deftest ray-intersects-sphere-twice
  (let* ((r (make-ray :origin (point 0 0 -5) :direction (vec3 0 0 1)))
         (s (make-sphere))
         (xs (intersect s r)))
    (check (equalp (length xs) 2)
           (equalp (crosspoint-time (first xs)) 4.0)
           (equalp (crosspoint-time (second xs)) 6.0))))

(deftest ray-intersects-at-a-tangent
  (let* ((r (make-ray :origin (point 0 1 -5) :direction (vec3 0 0 1)))
         (s (make-sphere))
         (xs (intersect s r)))
    (check (equalp (length xs) 2)
           (equalp (crosspoint-time (first xs)) 5.0)
           (equalp (crosspoint-time (second xs)) 5.0))))

(deftest ray-misses-sphere
  (let* ((r (make-ray :origin (point 0 2 -5) :direction (vec3 0 0 1)))
         (s (make-sphere))
         (xs (intersect s r)))
    (check (equalp (length xs) 0))))

(deftest ray-originates-inside-sphere
  (let* ((r (make-ray :origin (point 0 0 0) :direction (vec3 0 0 1)))
         (s (make-sphere))
         (xs (intersect s r)))
    (check (equalp (length xs) 2)
           (equalp (crosspoint-time (first xs)) -1.0)
           (equalp (crosspoint-time (second xs)) 1.0))))

(deftest sphere-entirely-behind-ray
  (let* ((r (make-ray :origin (point 0 0 5) :direction (vec3 0 0 1)))
         (s (make-sphere))
         (xs (intersect s r)))
    (check (equalp (length xs) 2)
           (equalp (crosspoint-time (first xs)) -6.0)
           (equalp (crosspoint-time (second xs)) -4.0))))

(deftest crosspoint-contains-time-and-object
  (let* ((s (make-sphere))
         (c (make-crosspoint :time 3.5 :object s)))
    (check (equalp (crosspoint-time c) 3.5)
           (equalp (crosspoint-object c) s))))

(deftest intersect-sets-the-object-on-the-crosspoint
  (let* ((r (make-ray :origin (point 0 0 -5) :direction (vec3 0 0 1)))
         (s (make-sphere))
         (xs (intersect s r)))
    (check (equalp (length xs) 2)
           (equalp (crosspoint-object (first xs)) s)
           (equalp (crosspoint-object (second xs)) s))))

(deftest hit-when-all-crosspoints-have-positive-time
  (let* ((s (make-sphere))
         (c1 (make-crosspoint :time 1 :object s))
         (c2 (make-crosspoint :time 2 :object s))
         (intersections (list c1 c2)))
    (check (equalp (hit intersections) c1))))

(deftest hit-with-some-negative-time-value
  (let* ((s (make-sphere))
         (c1 (make-crosspoint :time -1 :object s))
         (c2 (make-crosspoint :time 1 :object s))
         (intersections (list c1 c2)))
    (check (equalp (hit intersections) c2))))

(deftest hit-with-only-negative-time-values
  (let* ((s (make-sphere))
         (c1 (make-crosspoint :time -2 :object s))
         (c2 (make-crosspoint :time -1 :object s))
         (intersections (list c1 c2)))
    (check (equalp (hit intersections) nil))))

(deftest hit-is-always-nearest-in-time
  (let* ((s (make-sphere))
         (c1 (make-crosspoint :time 5 :object s))
         (c2 (make-crosspoint :time 7 :object s))
         (c3 (make-crosspoint :time -3 :object s))
         (c4 (make-crosspoint :time 2 :object s))
         (intersections (list c3 c1 c4 c2))) ; order shouldn't matter
    (check (equalp (hit intersections) c4))))

(deftest translating-a-ray
  (let* ((r (make-ray :origin (point 1 2 3) :direction (vec3 0 1 0)))
         (m (translation 3 4 5))
         (r2 (transform r m)))
    (check (equalp (ray-origin r2) (point 4 6 8))
           (equalp (ray-direction r2) (vec3 0 1 0)))))

(deftest scaling-a-ray
  (let* ((r (make-ray :origin (point 1 2 3) :direction (vec3 0 1 0)))
         (m (scaling 2 3 4))
         (r2 (transform r m)))
    (check (equalp (ray-origin r2) (point 2 6 12))
           (equalp (ray-direction r2) (vec3 0 3 0)))))

(deftest sphere-has-default-transformation
  (let ((s (make-sphere)))
    (check (equalp (sphere-transformation s)
                   identity-matrix))))

(deftest changing-a-sphere-transformation
  (let ((s (make-sphere))
        (transform (translation 2 3 4)))
    (set-transform s transform)
    (check (equalp (sphere-transformation s)
                   transform))))

(deftest intersecting-scaled-sphere-with-ray
  (let* ((r (make-ray :origin (point 0 0 -5) :direction (vec3 0 0 1)))
         (s (make-sphere)))
    (set-transform s (scaling 2 2 2))
    (let ((xs (intersect s r)))
      (check (equalp (length xs) 2)
             (equalp (crosspoint-time (first xs)) 3)
             (equalp (crosspoint-time (second xs)) 7)))))

(deftest intersecting-translated-sphere-with-ray
  (let* ((r (make-ray :origin (point 0 0 -5) :direction (vec3 0 0 1)))
         (s (make-sphere)))
    (set-transform s (translation 5 0 0))
    (let ((xs (intersect s r)))
      (check (equalp (length xs) 0)))))

(deftest casting-rays
  (creating-and-querying-ray)
  (point-from-distance)
  (ray-intersects-sphere-twice)
  (ray-intersects-at-a-tangent)
  (ray-misses-sphere)
  (ray-originates-inside-sphere)
  (sphere-entirely-behind-ray)
  (crosspoint-contains-time-and-object)
  (intersect-sets-the-object-on-the-crosspoint)
  (hit-when-all-crosspoints-have-positive-time)
  (hit-with-some-negative-time-value)
  (hit-with-only-negative-time-values)
  (hit-is-always-nearest-in-time)
  (translating-a-ray)
  (scaling-a-ray)
  (sphere-has-default-transformation)
  (intersecting-scaled-sphere-with-ray)
  (intersecting-translated-sphere-with-ray))

(deftest suite
  (vector-basics)
  (canvas-and-visuals)
  (matrix-basics)
  (matrix-transformations))
  (matrix-transformations)
  (casting-rays))

M tracer.lisp => tracer.lisp +43 -5
@@ 144,9 144,6 @@
                        (aref m i j))))
       finally (return result))))

(defun minor (m row column)
  (determinant (submatrix m row column)))

(defun cofactor (m row column)
  (if (oddp (+ row column))
      (- (minor m row column))


@@ 160,6 157,9 @@
        (dotimes (i (array-dimension m 0) result)
          (incf result (* (cofactor m 0 i) (aref m 0 i)))))))

(defun minor (m row column)
  (determinant (submatrix m row column)))

(defun invertible? (m)
  (not (eq (determinant m) 0)))



@@ 179,6 179,7 @@
                            (0 0 0 1)))

(defun transpose (m)
  ;; isn't this wrong for non-square matrices?
  (let ((result (make-array (array-dimensions m))))
    (dotimes (i (array-dimension m 0) result)
      (dotimes (j (array-dimension m 1))


@@ 189,13 190,13 @@
  (make-array '(4 4) :initial-contents `((1 0 0 ,x)
                                         (0 1 0 ,y)
                                         (0 0 1 ,z)
                                         (0 0 0 1))))
                                         (0 0 0  1))))

(defun scaling (x y z)
  (make-array '(4 4) :initial-contents `((,x  0  0 0)
                                         ( 0 ,y  0 0)
                                         ( 0  0 ,z 0)
                                         ( 0  0  0  1))))
                                         ( 0  0  0 1))))

(defun rotation-x (r)
  (make-array '(4 4) :initial-contents `((1     0         0      0)


@@ 220,3 221,40 @@
                                         (,yx   1 ,yz 0)
                                         (,zx ,zy   1 0)
                                         (  0   0   0 1))))

(defstruct ray origin direction)
(defstruct sphere (transformation identity-matrix))
(defstruct crosspoint time object)

(defun ray-position (r time)
  (VECTOR+ (ray-origin r) (scale-vector (ray-direction r) time)))

(defun intersect (s r)
  (let* ((inv-ray (transform r (inverse (sphere-transformation s))))
         (sphere-to-ray (VECTOR- (ray-origin inv-ray) (point 0 0 0)))
         (a (dot-product (ray-direction inv-ray) (ray-direction inv-ray)))
         (b (* 2 (dot-product (ray-direction inv-ray) sphere-to-ray)))
         (c (- (dot-product sphere-to-ray sphere-to-ray) 1))
         (discriminant (- (expt b 2) (* 4 a c))))
    (if (< discriminant 0)
        (list)
        (list (make-crosspoint :time (/ (- (- b) (sqrt discriminant)) (* 2 a))
                               :object s)
              (make-crosspoint :time (/ (+ (- b) (sqrt discriminant)) (* 2 a))
                               :object s)))))

(defun hit (intersections)
  (flet ((positivep (x) (> (crosspoint-time x) 0)))
    (if (some #'positivep intersections)
        (first (sort (remove-if-not #'positivep (copy-seq intersections))
                     #'< :key #'crosspoint-time))
        nil)))

(defun transform (ray matrix)
  (let ((o (matrix*vector matrix (ray-origin ray)))
        (d (matrix*vector matrix (ray-direction ray))))
    (make-ray :origin o :direction d)))

;;; should probably just drop this entirely...
(defun set-transform (s transform)
  (setf (sphere-transformation s) transform))