@@ 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")))
@@ 526,8 526,167 @@ 0 0 0 0 0 0 0 0 0 0
(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))
@@ 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))