M sample.lisp +18 -8
@@ 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")))
M tests.lisp +159 -46
@@ 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 @@ 0 0 0 0 0 0 0 0 0 0
(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 @@ 0 0 0 0 0 0 0 0 0 0
(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))
M tracer.lisp +46 -2
@@ 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))))