# HG changeset patch # User Nolan Prescott # Date 1586070482 14400 # Sun Apr 05 03:08:02 2020 -0400 # Node ID fff35fa24340924b816b7ab1dc45da6a4bc2c25c # Parent eab2502021c0b1feadb1465785bb42e550a07967 add REAL RAY CASTING I mean, it is only an ugly red circle, but IT ACTUALLY WORKS diff --git a/sample.lisp b/sample.lisp --- a/sample.lisp +++ b/sample.lisp @@ -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"))) diff --git a/tests.lisp b/tests.lisp --- a/tests.lisp +++ b/tests.lisp @@ -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)) diff --git a/tracer.lisp b/tracer.lisp --- a/tracer.lisp +++ b/tracer.lisp @@ -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))