# HG changeset patch # User Nolan Prescott # Date 1586297963 14400 # Tue Apr 07 18:19:23 2020 -0400 # Node ID b51fcbe732614f99645259210f284b8499103fda # Parent fff35fa24340924b816b7ab1dc45da6a4bc2c25c add lighting, draws a real sphere! diff --git a/sample.lisp b/sample.lisp --- a/sample.lisp +++ b/sample.lisp @@ -52,19 +52,18 @@ (loop for hour below 12 collect (face-point hour))) (ppm->file (canvas->ppm canvas) "/home/nolan/test-output.ppm")))) -;;; silhouette test -(defun cast-silhouette () +;;; cast some rays! +(defun draw-sphere () (let* ((ray-starting-place (point 0 0 -5)) (wall-z 10) (wall-size 7.0) - (canvas-pixels 100) + (canvas-pixels 400) (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))) + (shape (make-sphere :material (make-material :color (vec3 0.8 0.6 0)))) + (light (make-light :intensity (vec3 1 1 1) + :position (point 5 12 -8)))) (loop for y below canvas-pixels for world-y = (- half (* pixel-size y)) do (loop for x below canvas-pixels @@ -74,5 +73,16 @@ :direction (normalize (VECTOR- the-position ray-starting-place))) for xs = (intersect shape r) - when (hit xs) do (write-pixel c x y color))) + for contact = (hit xs) + when contact do + (let* ((pos (ray-position r (crosspoint-time contact))) + (normal (normal-at (crosspoint-object contact) pos)) + (eye (negate-vector (ray-direction r))) + (color-at-point + (lighting (sphere-material (crosspoint-object contact)) + light + pos + eye + normal))) + (write-pixel c x y color-at-point)))) (ppm->file (canvas->ppm c) "/home/nolan/test-output.ppm"))) diff --git a/tests.lisp b/tests.lisp --- a/tests.lisp +++ b/tests.lisp @@ -16,6 +16,12 @@ (defun float= (f1 f2) (< (abs (- f1 f2)) single-float-epsilon)) +(defun float-vectors-equal (v1 v2) + ;; is there a better way to do float= over two arrays? + (let ((a (loop for i across v1 collect i)) + (b (loop for i across v2 collect i))) + (not (member nil (mapcar #'float= a b))))) + ;;; tests (deftest adding-vectors (let ((a (vec3 3 -2 5)) @@ -403,63 +409,36 @@ (deftest rotation-around-x-axis (let* ((p (point 0 1 0)) (half-quarter (rotation-x (/ pi 4))) - (full-quarter (rotation-x (/ pi 2))) - (hq-values (loop for i across (matrix*vector half-quarter p) - collect i)) - (hq-actuals (loop for i across (point 0 (/ (sqrt 2) 2) (/ (sqrt 2) 2)) - collect i)) - (fq-values (loop for i across (matrix*vector full-quarter p) - collect i)) - (fq-actuals (loop for i across (point 0 0 1) - collect i))) - (check (not (member nil (mapcar #'float= hq-values hq-actuals))) - (not (member nil (mapcar #'float= fq-values fq-actuals)))))) + (full-quarter (rotation-x (/ pi 2)))) + (check (float-vectors-equal (matrix*vector half-quarter p) + (point 0 (/ (sqrt 2) 2) (/ (sqrt 2) 2))) + (float-vectors-equal (matrix*vector full-quarter p) + (point 0 0 1))))) (deftest inverse-x-rotation-rotates-oppositely (let* ((p (point 0 1 0)) (half-quarter (rotation-x (/ pi 4))) - (inv (inverse half-quarter)) - (inverse-values (loop for i across (matrix*vector inv p) - collect i)) - (inverse-actuals (loop for i across (point 0 (/ (sqrt 2) 2) (-(/ (sqrt 2) 2))) - collect i))) - (check - ;; is there a better way to do float= over two arrays? - (not (member nil (mapcar #'float= inverse-values inverse-actuals)))))) + (inv (inverse half-quarter))) + (check (float-vectors-equal (matrix*vector inv p) + (point 0 (/ (sqrt 2) 2) (-(/ (sqrt 2) 2))))))) (deftest rotation-around-y-axis (let* ((p (point 0 0 1)) (half-quarter (rotation-y (/ pi 4))) - (full-quarter (rotation-y (/ pi 2))) - (hq-values (loop for i across (matrix*vector half-quarter p) - collect i)) - (hq-actuals (loop for i across (point (/ (sqrt 2) 2) - 0 - (/ (sqrt 2) 2)) - collect i)) - (fq-values (loop for i across (matrix*vector full-quarter p) - collect i)) - (fq-actuals (loop for i across (point 1 0 0) - collect i))) - (check (not (member nil (mapcar #'float= hq-values hq-actuals))) - (not (member nil (mapcar #'float= fq-values fq-actuals)))))) + (full-quarter (rotation-y (/ pi 2)))) + (check (float-vectors-equal (matrix*vector half-quarter p) + (point (/ (sqrt 2) 2) 0 (/ (sqrt 2) 2))) + (float-vectors-equal (matrix*vector full-quarter p) + (point 1 0 0))))) (deftest rotation-around-z-axis (let* ((p (point 0 1 0)) (half-quarter (rotation-z (/ pi 4))) - (full-quarter (rotation-z (/ pi 2))) - (hq-values (loop for i across - (matrix*vector half-quarter p) - collect i)) - (hq-actuals (loop for i across - (point (- (/ (sqrt 2) 2)) (/ (sqrt 2) 2) 0) - collect i)) - (fq-values (loop for i across (matrix*vector full-quarter p) - collect i)) - (fq-actuals (loop for i across (point -1 0 0) - collect i))) - (check (not (member nil (mapcar #'float= hq-values hq-actuals))) - (not (member nil (mapcar #'float= fq-values fq-actuals)))))) + (full-quarter (rotation-z (/ pi 2)))) + (check (float-vectors-equal (matrix*vector half-quarter p) + (point (- (/ (sqrt 2) 2)) (/ (sqrt 2) 2) 0)) + (float-vectors-equal (matrix*vector full-quarter p) + (point -1 0 0))))) (deftest shearing-transforms-x-proportionally-to-y (let ((transform (shearing 1 0 0 0 0 0)) @@ -684,9 +663,143 @@ (intersecting-scaled-sphere-with-ray) (intersecting-translated-sphere-with-ray)) +(deftest normal-of-sphere-on-x-axis + (let* ((s (make-sphere)) + (n (normal-at s (point 1 0 0)))) + (check (equalp n (vec3 1 0 0))))) + +(deftest normal-of-sphere-on-y-axis + (let* ((s (make-sphere)) + (n (normal-at s (point 0 1 0)))) + (check (equalp n (vec3 0 1 0))))) + +(deftest normal-of-sphere-on-z-axis + (let* ((s (make-sphere)) + (n (normal-at s (point 0 0 1)))) + (check (equalp n (vec3 0 0 1))))) + +(deftest normal-of-sphere-on-nonaxial-point + (let* ((s (make-sphere)) + (p (/ (sqrt 3d0) 3d0)) + (n (normal-at s (point p p p)))) + (check (float-vectors-equal n (vec3 p p p))))) + +(deftest normals-are-normalized + (let* ((s (make-sphere)) + (p (/ (sqrt 3) 3)) + (n (normal-at s (point p p p)))) + (check (float-vectors-equal n (normalize n))))) + +(deftest normal-of-translated-sphere + (let* ((s (make-sphere :transformation (translation 0 1 0))) + (n (normal-at s (point 0 1.707 -0.707)))) + (check (float-vectors-equal n (vec3 0 0.7071068 -0.7071068))))) + +(deftest normal-of-transformed-sphere + (let* ((s (make-sphere :transformation (matrix*matrix (scaling 1 0.5 1) + (rotation-z (/ pi 5))))) + (n (normal-at s (point 0 (/ (sqrt 2) 2) (- (/ (sqrt 2) 2)))))) + (check (float-vectors-equal n (vec3 0 0.9701425 -0.242535625))))) + +(deftest reflecting-a-vector-at-45-degrees + (let* ((v (vec3 1 -1 0)) + (n (vec3 0 1 0))) + (check (float-vectors-equal (reflect v n) (vec3 1 1 0))))) + +(deftest reflecting-a-vector-off-a-slanted-surface + (let* ((v (vec3 0 -1 0)) + (s (/ (sqrt 2) 2)) + (n (vec3 s s 0))) + (check (float-vectors-equal (reflect v n) (vec3 1 0 0))))) + +(deftest point-light-has-position-and-intensity + (let ((l (make-light :position (point 0 0 0) + :intensity (vec3 1 1 1)))) + (check (equalp (light-position l) (point 0 0 0)) + (equalp (light-intensity l) (vec3 1 1 1))))) + +(deftest default-material-properties + (let ((m (make-material))) + (check (equalp (material-color m)(vec3 1 1 1)) + (equalp (material-ambient m) 0.1) + (equalp (material-diffuse m) 0.9) + (equalp (material-specular m) 0.9) + (equalp (material-shininess m) 200.0)))) + +(deftest sphere-may-be-assigned-material + (let* ((m (make-material :ambient 1)) + (s (make-sphere :material m))) + (check (equalp (sphere-material s) m)))) + +(deftest lighting-with-eye-between-light-and-surface + (let* ((m (make-material)) + (pos (point 0 0 0)) + (eye (vec3 0 0 -1)) + (normal (vec3 0 0 -1)) + (light (make-light :intensity (vec3 1 1 1) + :position (point 0 0 -10)))) + (check (equalp (lighting m light pos eye normal) + (vec3 1.9 1.9 1.9))))) + +(deftest lighting-with-eye-between-light-and-surface-offset-45-degrees + (let* ((m (make-material)) + (pos (point 0 0 0)) + (eye (vec3 0 (/ (sqrt 2) 2) (/ (sqrt 2) 2))) + (normal (vec3 0 0 -1)) + (light (make-light :intensity (vec3 1 1 1) :position (point 0 0 -10)))) + (check (equalp (lighting m light pos eye normal) + (vec3 1.0 1.0 1.0))))) + +(deftest lighting-with-eye-opposite-light-offset-45-degrees + (let* ((m (make-material)) + (pos (point 0 0 0)) + (eye (vec3 0 0 -1)) + (normal (vec3 0 0 -1)) + (light (make-light :intensity (vec3 1 1 1) :position (point 0 10 -10)))) + (check (equalp (lighting m light pos eye normal) + (vec3 0.73639613 0.73639613 0.73639613))))) + +(deftest lighting-with-eye-in-path-of-reflection-vector + (let* ((m (make-material)) + (pos (point 0 0 0)) + (eye (vec3 0 (- (/ (sqrt 2) 2)) (- (/ (sqrt 2) 2)))) + (normal (vec3 0 0 -1)) + (light (make-light :intensity (vec3 1 1 1) :position (point 0 10 -10)))) + (check (equalp (lighting m light pos eye normal) + (vec3 1.6363962 1.6363962 1.6363962))))) + +(deftest lighting-with-eye-behind-surface + (let* ((m (make-material)) + (pos (point 0 0 0)) + (eye (vec3 0 0 -1)) + (normal (vec3 0 0 -1)) + (light (make-light :intensity (vec3 1 1 1) :position (point 0 0 10)))) + (check (equalp (lighting m light pos eye normal) + (vec3 0.1 0.1 0.1))))) + +(deftest properties-of-lighting + (normal-of-sphere-on-x-axis) + (normal-of-sphere-on-y-axis) + (normal-of-sphere-on-z-axis) + (normal-of-sphere-on-nonaxial-point) + (normals-are-normalized) + (normal-of-translated-sphere) + (normal-of-transformed-sphere) + (reflecting-a-vector-at-45-degrees) + (reflecting-a-vector-off-a-slanted-surface) + (point-light-has-position-and-intensity) + (default-material-properties) + (sphere-may-be-assigned-material) + (lighting-with-eye-between-light-and-surface) + (lighting-with-eye-between-light-and-surface-offset-45-degrees) + (lighting-with-eye-opposite-light-offset-45-degrees) + (lighting-with-eye-in-path-of-reflection-vector) + (lighting-with-eye-behind-surface)) + (deftest suite (vector-basics) (canvas-and-visuals) (matrix-basics) (matrix-transformations) - (casting-rays)) + (casting-rays) + (properties-of-lighting)) diff --git a/tracer.lisp b/tracer.lisp --- a/tracer.lisp +++ b/tracer.lisp @@ -89,7 +89,10 @@ (mapcan #'(lambda (x) (if (atom x) (mklist x) (flatten x))) ls))) (defun canvas-pixel-strings (c) - (labels ((pixel->string (v) (format nil "~s ~s ~s" (Red v) (Green v) (Blue v)))) + (labels ((pixel->string (v) (format nil "~d ~d ~d" + (floor (* 255 (Red v))) + (floor (* 255 (Green v))) + (floor (* 255 (Blue v)))))) (flatten (loop for i below (canvas-height c) collect (loop for j below (canvas-width c) collect (pixel->string (aref (canvas-body c) j i))))))) @@ -222,8 +225,17 @@ (,zx ,zy 1 0) ( 0 0 0 1)))) +(defstruct material + (color (vec3 1 1 1)) + (ambient 0.1) + (diffuse 0.9) + (specular 0.9) + (shininess 200)) +(defstruct light intensity position) (defstruct ray origin direction) -(defstruct sphere (transformation identity-matrix)) +(defstruct sphere + (transformation identity-matrix) + (material (make-material))) (defstruct crosspoint time object) (defun ray-position (r time) @@ -258,3 +270,35 @@ ;;; should probably just drop this entirely... (defun set-transform (s transform) (setf (sphere-transformation s) transform)) + +(defun normal-at (sphere world-point) + (let* ((object-point (matrix*vector (inverse (sphere-transformation sphere)) world-point)) + (object-normal (VECTOR- object-point (point 0 0 0))) + (world-normal (matrix*vector (transpose (inverse (sphere-transformation sphere))) + object-normal))) + (setf (aref world-normal 3) 0) ; FIXME submatrix 3,3 instead + (normalize world-normal))) + +(defun reflect (in normal) + (VECTOR- in (scale-vector normal (* 2 (dot-product in normal))))) + +(defun lighting (material light position eye-vector normal-vector) + (let* ((effective-color (VECTOR* (material-color material) (light-intensity light))) + (lightv (normalize (VECTOR- (light-position light) position))) + (ambient (scale-vector effective-color (material-ambient material))) + (light-dot-normal (dot-product lightv normal-vector)) + (black (vec3 0 0 0)) + (diffuse black) + (specular black) + (reflect-dot-eye (dot-product (reflect (negate-vector lightv) normal-vector) + eye-vector))) + (if (> light-dot-normal 0) + (setf diffuse (scale-vector + (scale-vector effective-color (material-diffuse material)) + light-dot-normal))) + (if (> reflect-dot-eye 0) + (setf specular (scale-vector (light-intensity light) + (* (material-specular material) + (expt reflect-dot-eye + (material-shininess material)))))) + (reduce #'VECTOR+ (list ambient diffuse specular))))