@@ 0,0 1,53 @@
+(defpackage :com.nprescott.raytracer-sample-code
+ (:use :common-lisp :com.nprescott.raytracer))
+
+;;; sample
+(defstruct projectile position velocity)
+(defstruct environment gravity wind)
+
+(defun tick (env proj)
+ (let ((p (VECTOR+ (projectile-position proj) (projectile-velocity proj)))
+ (v (VECTOR+ (projectile-velocity proj) (VECTOR+ (environment-gravity env)
+ (environment-wind env)))))
+ (make-projectile :position p :velocity v)))
+
+(defun projectile-tracking ()
+ (do* ((env (make-environment :gravity (vec3 0 -0.1 0)
+ :wind (vec3 -0.01 0 0)))
+ (p (make-projectile :position (point 0 1 0)
+ :velocity (normalize (vec3 1 1 0)))
+ (tick env p)))
+ ((if (<= (Y (projectile-position p)) 0) (return p)))
+ (format t "~a~%" (projectile-position p))))
+
+(defun projectile-visualization ()
+ (do* ((env (make-environment :gravity (vec3 0 -0.093 0)
+ :wind (vec3 -0.01 0 0)))
+ (p (make-projectile :position (point 0 1 0)
+ :velocity (scale-vector (normalize (vec3 1 1.5 0)) 10))
+ (tick env p))
+ (c (make-canvas :width 900 :height 550)))
+ ((<= (Y (projectile-position p)) 0)
+ (ppm->file (canvas->ppm c) "/home/nolan/test-output.ppm"))
+ (format t "~s ~s~%"
+ (max 0 (floor (X (projectile-position p))))
+ (max 0 (floor (- (canvas-height c) 100))))
+ (write-pixel c
+ (max 0 (floor (X (projectile-position p))))
+ (max 0 (floor (- (canvas-height c) (Y (projectile-position p)))))
+ (vector 255 255 255))))
+
+;; sample "clock face"
+(defun clockface ()
+ (flet ((face-point (hour)
+ (matrix*vector (matrix*matrix (translation 0 0 0) (rotation-z (* hour (/ pi 6))))
+ (point 0 1 0)))
+ (paint-with-offset (canvas p)
+ (write-pixel canvas
+ (+ 50 (* 30 (X p)))
+ (+ 50 (* 30 (Y p)))
+ (vector 255 255 255))))
+ (let ((canvas (make-canvas :width 100 :height 100)))
+ (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"))))
@@ 0,0 1,533 @@
+(defpackage :com.nprescott.raytracer-tests
+ (:use :common-lisp :com.nprescott.raytracer))
+
+;;; "test harness"
+(defmacro check (&body forms)
+ `(progn
+ ,@(loop for f in forms collect
+ `(progn (assert ,f)
+ (write-char #\.)
+ (values)))))
+
+(defmacro deftest (name &body body)
+ `(defun ,name ()
+ ,@body))
+
+(defun float= (f1 f2)
+ (< (abs (- f1 f2)) single-float-epsilon))
+
+;;; tests
+(deftest adding-vectors
+ (let ((a (vec3 3 -2 5))
+ (b (vec3 -2 3 1)))
+ (check (equalp (VECTOR+ a b)
+ (vec3 1 1 6)))))
+
+(deftest subtracting-vectors
+ (let ((a (vec3 3 2 1))
+ (b (vec3 5 6 7)))
+ (check (equalp (VECTOR- a b)
+ (vec3 -2 -4 -6)))))
+
+(deftest point-minus-a-vector
+ (let ((p (point 3 2 1))
+ (v (vec3 5 6 7)))
+ (check (equalp (VECTOR- p v)
+ (point -2 -4 -6)))))
+
+(deftest subtracting-zero-vector
+ (let ((zero (vec3 0 0 0))
+ (v (vec3 1 -2 3)))
+ (check (equalp (VECTOR- zero v)
+ (vec3 -1 2 -3)))))
+
+(deftest negating-a-vector
+ (let ((v (vec3 1 -2 3)))
+ (check (equalp (negate-vector v)
+ (vec3 -1 2 -3)))))
+
+(deftest multiply-by-scalar
+ (let ((t1 (vector 1 -2 3 -4))
+ (scalar 3.5))
+ (check (equalp (scale-vector t1 scalar)
+ (vec3 3.5 -7 10.5)))))
+
+(deftest multiply-by-scalar-fraction
+ (let ((v (vec3 1 -2 3))
+ (scalar (/ 1 2)))
+ (check (equalp (scale-vector v scalar)
+ (vec3 0.5 -1 1.5)))))
+
+(deftest dividing-scalar
+ (let ((v (vec3 1 -2 3))
+ (scalar 2))
+ (check (equalp (scale-vector v (/ 1 scalar))
+ (vec3 0.5 -1 1.5)))))
+
+(deftest magnitude-of-vector
+ (let ((v1 (vec3 0 1 0))
+ (v2 (vec3 0 0 1))
+ (v3 (vec3 1 2 3))
+ (v4 (vec3 -1 -2 -3)))
+ (check (equalp (magnitude v1) 1)
+ (equalp (magnitude v2) 1)
+ (equalp (magnitude v3) (sqrt 14))
+ (equalp (magnitude v4) (sqrt 14)))))
+
+(deftest normalize-vector
+ (let ((v1 (vec3 4 0 0))
+ (v2 (vec3 1 2 3)))
+ (check (equalp (normalize v1) (vec3 1 0 0))
+ (equalp (normalize v2) (vec3 (/ 1 (sqrt 14))
+ (/ 2 (sqrt 14))
+ (/ 3 (sqrt 14)))))))
+
+(deftest normalize-magnitude-of-vector
+ (let ((v1 (vec3 1 2 3)))
+ (check (float= (magnitude (normalize v1)) 1))))
+
+(deftest test-dot-product
+ (let ((v1 (vec3 1 2 3))
+ (v2 (vec3 2 3 4)))
+ (check (equalp (dot-product v1 v2) 20))))
+
+(deftest cross-product-results
+ (let ((v1 (vec3 1 2 3))
+ (v2 (vec3 2 3 4)))
+ (check (equalp (cross-product v1 v2) (vec3 -1 2 -1))
+ (equalp (cross-product v2 v1) (vec3 1 -2 1)))))
+
+(deftest vector-basics
+ (adding-vectors)
+ (subtracting-vectors)
+ (point-minus-a-vector)
+ (subtracting-zero-vector)
+ (negating-a-vector)
+ (multiply-by-scalar)
+ (multiply-by-scalar-fraction)
+ (dividing-scalar)
+ (magnitude-of-vector)
+ (normalize-vector)
+ (normalize-magnitude-of-vector)
+ (test-dot-product)
+ (cross-product-results))
+
+(deftest color-vector-getters
+ (let ((c (vector -0.5 0.4 1.7)))
+ (check (equalp (RED c) -0.5)
+ (equalp (GREEN c) 0.4)
+ (equalp (BLUE c) 1.7))))
+
+(deftest blending-colors
+ (let* ((c1 (vec3 1 0.2 0.4))
+ (c2 (vec3 0.9 1 0.1))
+ (blended-color (blend c1 c2)))
+ (check (float= (RED blended-color) 0.9)
+ (float= (GREEN blended-color) 0.2)
+ (float= (BLUE blended-color) 0.04))))
+
+(deftest canvas-properties
+ (let* ((c (make-canvas :width 10 :height 20))
+ (w (canvas-width c))
+ (h (canvas-height c)))
+ (check (equalp w 10)
+ (equalp h 20)
+ (loop for i across (make-array (array-total-size (canvas-body c))
+ :displaced-to (canvas-body c))
+ always (equalp i (vector 0 0 0))))))
+
+(deftest canvas-write-pixel
+ (let ((canvas (make-canvas :width 10 :height 20))
+ (color (vector 1 0 0)))
+ (write-pixel canvas 2 3 color)
+ (check (equalp (aref (canvas-body canvas) 2 3) (vector 1 0 0)))))
+
+(deftest check-canvas-pixel-string
+ (let ((c (make-canvas :width 1 :height 2)))
+ (check (equalp (canvas-pixel-strings c) (list "0 0 0" "0 0 0")))))
+
+(deftest check-canvas-to-string
+ (let ((c (make-canvas :width 1 :height 2)))
+ (check (equalp (canvas->string c) "0 0 0 0 0 0"))))
+
+(deftest output-canvas-to-ppm
+ (check (equalp (canvas->ppm (make-canvas :width 3 :height 5))
+ "P3
+3 5
+255
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0
+")))
+
+(deftest ppm-includes-trailing-newline
+ (let ((c (canvas->ppm (make-canvas :width 3 :height 5))))
+ (check (equalp 0 (position #\Newline (reverse c) :test #'char=)))))
+
+(deftest canvas-and-visuals
+ (color-vector-getters)
+ (blending-colors)
+ (canvas-properties)
+ (canvas-write-pixel)
+ (check-canvas-pixel-string)
+ (check-canvas-to-string)
+ (output-canvas-to-ppm)
+ (ppm-includes-trailing-newline))
+
+(deftest multiply-4x4-matrices
+ (let ((a #2A((1 2 3 4)
+ (5 6 7 8)
+ (9 8 7 6)
+ (5 4 3 2)))
+ (b #2A((-2 1 2 3)
+ ( 3 2 1 -1)
+ ( 4 3 6 5)
+ ( 1 2 7 8))))
+ (check (equalp (matrix*matrix a b)
+ #2A((20 22 50 48)
+ (44 54 114 108)
+ (40 58 110 102)
+ (16 26 46 42))))))
+
+(deftest multiply-matrix-with-vector
+ (let ((a #2A((1 2 3 4)
+ (2 4 4 2)
+ (8 6 4 1)
+ (0 0 0 1)))
+ (b (vector 1 2 3 1)))
+ (check (equalp (matrix*vector a b) (vector 18 24 33 1)))))
+
+(deftest identity-matrix-returns-original-matrix
+ (check (equalp
+ (matrix*matrix identity-matrix #2A((1 2 3 4)
+ (2 4 4 2)
+ (8 6 4 1)
+ (0 0 0 1)))
+ #2A((1 2 3 4)
+ (2 4 4 2)
+ (8 6 4 1)
+ (0 0 0 1)))))
+
+(deftest identity-matrix-times-tuple
+ (check (equalp
+ (matrix*vector identity-matrix (vector 1 2 3 4))
+ (vector 1 2 3 4))))
+
+(deftest transpose-a-matrix
+ (let ((a #2A((0 9 3 0)
+ (9 8 0 8)
+ (1 8 5 3)
+ (0 0 5 6))))
+ (check (equalp (transpose a) #2A((0 9 1 0)
+ (9 8 8 0)
+ (3 0 5 5)
+ (0 8 3 6))))))
+
+(deftest transpose-identity-matrix
+ (check (equalp (transpose identity-matrix)
+ identity-matrix)))
+
+(deftest verify-2x2-determinant
+ (let ((a #2A(( 1 5)
+ (-3 2))))
+ (check (equalp (determinant a) 17))))
+
+(deftest submatrix-of-3x3-is-2x2
+ (let ((m #2A(( 1 5 0)
+ (-3 2 7)
+ ( 0 6 -3))))
+ (check (equalp (submatrix m 0 2) #2A((-3 2)
+ ( 0 6))))))
+
+(deftest submatrix-of-4x4-is-3x3
+ (let ((m #2A((-6 1 1 6)
+ (-8 5 8 6)
+ (-1 0 8 2)
+ (-7 1 -1 1))))
+ (check (equalp (submatrix m 2 1) #2A((-6 1 6)
+ (-8 8 6)
+ (-7 -1 1))))))
+
+(deftest 3x3-matrix-minor
+ (let* ((a #2A((3 5 0)
+ (2 -1 7)
+ (6 -1 5)))
+ (b (submatrix a 1 0)))
+ (check (equalp (determinant b) 25)
+ (equalp (minor a 1 0) 25))))
+
+(deftest 3x3-matrix-cofactor
+ (let ((a #2A((3 5 0)
+ (2 -1 -7)
+ (6 -1 5))))
+ (check (equalp (minor a 0 0) -12)
+ (equalp (cofactor a 0 0) -12)
+ (equalp (minor a 1 0) 25)
+ (equalp (cofactor a 1 0) -25))))
+
+(deftest 3x3-matrix-determinant
+ (let ((a #2A(( 1 2 6)
+ (-5 8 -4)
+ ( 2 6 4))))
+ (check (equalp (cofactor a 0 0) 56)
+ (equalp (cofactor a 0 1) 12)
+ (equalp (cofactor a 0 2) -46)
+ (equalp (determinant a) -196))))
+
+(deftest 4x4-matrix-determinant
+ (let ((a #2A((-2 -8 3 5)
+ (-3 1 7 3)
+ ( 1 2 -9 6)
+ (-6 7 7 -9))))
+ (check (equalp (cofactor a 0 0) 690)
+ (equalp (cofactor a 0 1) 447)
+ (equalp (cofactor a 0 2) 210)
+ (equalp (cofactor a 0 3) 51)
+ (equalp (determinant a) -4071))))
+
+(deftest invertibility-predicate
+ (let ((a #2A((6 4 4 4)
+ (5 5 7 6)
+ (4 -9 3 -7)
+ (9 1 7 -6))))
+ (check (equalp (determinant a) -2120)
+ (equalp (invertible? a) t))))
+
+(deftest invertibility-negative-case
+ (let ((a #2A((-4 2 -2 -3)
+ ( 9 6 2 6)
+ ( 0 -5 1 -5)
+ ( 0 0 0 0))))
+ (check (equalp (determinant a) 0)
+ (equalp (invertible? a) nil))))
+
+(deftest calculate-matrix-inverse
+ (let* ((a #2A((-5 2 6 -8)
+ ( 1 -5 1 8)
+ ( 7 7 -6 -7)
+ ( 1 -3 7 4)))
+ (b (inverse a)))
+ (check (equalp (determinant a) 532)
+ (equalp (cofactor a 2 3) -160)
+ (equalp (aref b 3 2) -160/532)
+ (equalp (cofactor a 3 2) 105)
+ (equalp (aref b 2 3) 105/532)
+
+ (equalp b #2A(( 29/133 60/133 32/133 -6/133)
+ (-215/266 -775/532 -59/133 277/532)
+ ( -3/38 -17/76 -1/19 15/76)
+ (-139/266 -433/532 -40/133 163/532))))))
+
+(deftest inverse-is-reversible
+ (let* ((a #2A((-5 2 6 -8)
+ ( 1 -5 1 8)
+ ( 7 7 -6 -7)
+ ( 1 -3 7 4)))
+ (b (inverse a)))
+ (check (equalp (inverse b) a))))
+
+(deftest inverse-undoes-multiplication
+ (let* ((a #2A(( 3 -9 7 3)
+ ( 3 -8 2 -9)
+ (-4 4 4 1)
+ (-6 5 -1 1)))
+ (b #2A((8 2 2 2)
+ (3 -1 7 0)
+ (7 0 5 4)
+ (6 -2 0 5)))
+ (c (matrix*matrix a b)))
+ (check (equalp (matrix*matrix c (inverse b)) a))))
+
+(deftest matrix-basics
+ (multiply-4x4-matrices)
+ (multiply-matrix-with-vector)
+ (identity-matrix-returns-original-matrix)
+ (identity-matrix-times-tuple)
+ (transpose-a-matrix)
+ (transpose-identity-matrix)
+ (verify-2x2-determinant)
+ (submatrix-of-3x3-is-2x2)
+ (submatrix-of-4x4-is-3x3)
+ (3x3-matrix-minor)
+ (3x3-matrix-cofactor)
+ (3x3-matrix-determinant)
+ (4x4-matrix-determinant)
+ (invertibility-predicate)
+ (invertibility-negative-case)
+ (calculate-matrix-inverse)
+ (inverse-is-reversible)
+ (inverse-undoes-multiplication))
+
+(deftest multiplying-translation-matrix
+ (let ((transform (translation 5 -3 2))
+ (p (point -3 4 5)))
+ (check (equalp (matrix*vector transform p)
+ (point 2 1 7)))))
+
+(deftest multiply-inverse-of-translation
+ (let* ((transform (translation 5 -3 2))
+ (inv (inverse transform))
+ (p (point -3 4 5)))
+ (check (equalp (matrix*vector inv p)
+ (point -8 7 3)))))
+
+(deftest translation-of-a-vector
+ (let ((transform (translation 5 -3 2))
+ (v (vec3 -3 4 5)))
+ (check (equalp (matrix*vector transform v) v))))
+
+(deftest scaling-matrix-to-point
+ (let ((transform (scaling 2 3 4))
+ (p (point -4 6 8)))
+ (check (equalp (matrix*vector transform p)
+ (point -8 18 32)))))
+
+(deftest scaling-matrix-to-vector
+ (let ((transform (scaling 2 3 4))
+ (v (vec3 -4 6 8)))
+ (check (equalp (matrix*vector transform v)
+ (vec3 -8 18 32)))))
+
+(deftest multiplying-inverse-of-scaling-matrix
+ (let* ((transform (scaling 2 3 4))
+ (inv (inverse transform))
+ (v (vec3 -4 6 8)))
+ (check (equalp (matrix*vector inv v)
+ (vec3 -2 2 2)))))
+
+(deftest scaling-negatively-is-reflection
+ (let ((transform (scaling -1 1 1))
+ (p (point 2 3 4)))
+ (check (equalp (matrix*vector transform p)
+ (point -2 3 4)))))
+
+(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))))))
+
+(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))))))
+
+(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))))))
+
+(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))))))
+
+(deftest shearing-transforms-x-proportionally-to-y
+ (let ((transform (shearing 1 0 0 0 0 0))
+ (p (point 2 3 4)))
+ (check (equalp (matrix*vector transform p)
+ (point 5 3 4)))))
+
+(deftest shearing-transforms-x-proportionally-to-z
+ (let ((transform (shearing 0 1 0 0 0 0))
+ (p (point 2 3 4)))
+ (check (equalp (matrix*vector transform p)
+ (point 6 3 4)))))
+
+(deftest shearing-transforms-y-proportionally-to-x
+ (let ((transform (shearing 0 0 1 0 0 0))
+ (p (point 2 3 4)))
+ (check (equalp (matrix*vector transform p)
+ (point 2 5 4)))))
+
+(deftest shearing-transforms-y-proportionally-to-z
+ (let ((transform (shearing 0 0 0 1 0 0))
+ (p (point 2 3 4)))
+ (check (equalp (matrix*vector transform p)
+ (point 2 7 4)))))
+
+(deftest shearing-transforms-z-proportionally-to-x
+ (let ((transform (shearing 0 0 0 0 1 0))
+ (p (point 2 3 4)))
+ (check (equalp (matrix*vector transform p)
+ (point 2 3 6)))))
+
+(deftest shearing-transforms-z-proportionally-to-y
+ (let ((transform (shearing 0 0 0 0 0 1))
+ (p (point 2 3 4)))
+ (check (equalp (matrix*vector transform p)
+ (point 2 3 7)))))
+
+(deftest chaining-transformations
+ (let ((a (rotation-x (/ pi 2)))
+ (b (scaling 5 5 5))
+ (c (translation 10 5 7))
+ (p (point 1 0 1)))
+ (check (equalp (matrix*vector (matrix*matrix c (matrix*matrix b a))
+ p)
+ (point 15 0 7)))))
+
+(deftest matrix-transformations
+ (multiplying-translation-matrix)
+ (multiply-inverse-of-translation)
+ (translation-of-a-vector)
+ (scaling-matrix-to-point)
+ (scaling-matrix-to-vector)
+ (multiplying-inverse-of-scaling-matrix)
+ (scaling-negatively-is-reflection)
+ (rotation-around-x-axis)
+ (inverse-x-rotation-rotates-oppositely)
+ (rotation-around-y-axis)
+ (rotation-around-z-axis)
+ (shearing-transforms-x-proportionally-to-y)
+ (shearing-transforms-x-proportionally-to-z)
+ (shearing-transforms-y-proportionally-to-x)
+ (shearing-transforms-y-proportionally-to-z)
+ (shearing-transforms-z-proportionally-to-x)
+ (shearing-transforms-z-proportionally-to-y)
+ (chaining-transformations))
+
+(deftest suite
+ (vector-basics)
+ (canvas-and-visuals)
+ (matrix-basics)
+ (matrix-transformations))
@@ 1,19 1,6 @@
-;;; test code:
-(defmacro check (&body forms)
- `(progn
- ,@(loop for f in forms collect
- `(progn (assert ,f)
- (write-char #\.)
- (values)))))
+(defpackage :com.nprescott.raytracer
+ (:use :common-lisp))
-(defmacro deftest (name &body body)
- `(defun ,name ()
- ,@body))
-
-(defun float= (f1 f2)
- (< (abs (- f1 f2)) single-float-epsilon))
-
-;;; code:
(defmacro defun-vector-binop (binop)
`(defun ,(intern (concatenate 'string "VECTOR" (string binop))) (v1 v2)
(vector (,binop (aref v1 0) (aref v2 0))
@@ 143,14 130,6 @@
(* (aref a i k)
(aref b k j))))))))
-(defun determinant (m)
- (if (equalp (array-dimensions m) '(2 2))
- (- (* (aref m 0 0) (aref m 1 1))
- (* (aref m 0 1) (aref m 1 0)))
- (let ((result 0))
- (dotimes (i (array-dimension m 0) result)
- (incf result (* (cofactor m 0 i) (aref m 0 i)))))))
-
(defun submatrix (m row column)
(let ((result (make-array (mapcar #'1- (array-dimensions m)))))
(loop for i below (array-dimension m 0)
@@ 173,6 152,14 @@
(- (minor m row column))
(minor m row column)))
+(defun determinant (m)
+ (if (equalp (array-dimensions m) '(2 2))
+ (- (* (aref m 0 0) (aref m 1 1))
+ (* (aref m 0 1) (aref m 1 0)))
+ (let ((result 0))
+ (dotimes (i (array-dimension m 0) result)
+ (incf result (* (cofactor m 0 i) (aref m 0 i)))))))
+
(defun invertible? (m)
(not (eq (determinant m) 0)))
@@ 233,570 220,3 @@
(,yx 1 ,yz 0)
(,zx ,zy 1 0)
( 0 0 0 1))))
-
-;;; tests:
-(deftest adding-vectors
- (let ((a (vec3 3 -2 5))
- (b (vec3 -2 3 1)))
- (check (equalp (VECTOR+ a b)
- (vec3 1 1 6)))))
-
-(deftest subtracting-vectors
- (let ((a (vec3 3 2 1))
- (b (vec3 5 6 7)))
- (check (equalp (VECTOR- a b)
- (vec3 -2 -4 -6)))))
-
-(deftest point-minus-a-vector
- (let ((p (point 3 2 1))
- (v (vec3 5 6 7)))
- (check (equalp (VECTOR- p v)
- (point -2 -4 -6)))))
-
-(deftest subtracting-zero-vector
- (let ((zero (vec3 0 0 0))
- (v (vec3 1 -2 3)))
- (check (equalp (VECTOR- zero v)
- (vec3 -1 2 -3)))))
-
-(deftest negating-a-vector
- (let ((v (vec3 1 -2 3)))
- (check (equalp (negate-vector v)
- (vec3 -1 2 -3)))))
-
-(deftest multiply-by-scalar
- (let ((t1 (vector 1 -2 3 -4))
- (scalar 3.5))
- (check (equalp (scale-vector t1 scalar)
- (vec3 3.5 -7 10.5)))))
-
-(deftest multiply-by-scalar-fraction
- (let ((v (vec3 1 -2 3))
- (scalar (/ 1 2)))
- (check (equalp (scale-vector v scalar)
- (vec3 0.5 -1 1.5)))))
-
-(deftest dividing-scalar
- (let ((v (vec3 1 -2 3))
- (scalar 2))
- (check (equalp (scale-vector v (/ 1 scalar))
- (vec3 0.5 -1 1.5)))))
-
-(deftest magnitude-of-vector
- (let ((v1 (vec3 0 1 0))
- (v2 (vec3 0 0 1))
- (v3 (vec3 1 2 3))
- (v4 (vec3 -1 -2 -3)))
- (check (equalp (magnitude v1) 1)
- (equalp (magnitude v2) 1)
- (equalp (magnitude v3) (sqrt 14))
- (equalp (magnitude v4) (sqrt 14)))))
-
-(deftest normalize-vector
- (let ((v1 (vec3 4 0 0))
- (v2 (vec3 1 2 3)))
- (check (equalp (normalize v1) (vec3 1 0 0))
- (equalp (normalize v2) (vec3 (/ 1 (sqrt 14))
- (/ 2 (sqrt 14))
- (/ 3 (sqrt 14)))))))
-
-(deftest normalize-magnitude-of-vector
- (let ((v1 (vec3 1 2 3)))
- (check (float= (magnitude (normalize v1)) 1))))
-
-(deftest test-dot-product
- (let ((v1 (vec3 1 2 3))
- (v2 (vec3 2 3 4)))
- (check (equalp (dot-product v1 v2) 20))))
-
-(deftest cross-product-results
- (let ((v1 (vec3 1 2 3))
- (v2 (vec3 2 3 4)))
- (check (equalp (cross-product v1 v2) (vec3 -1 2 -1))
- (equalp (cross-product v2 v1) (vec3 1 -2 1)))))
-
-(deftest vector-basics
- (adding-vectors)
- (subtracting-vectors)
- (point-minus-a-vector)
- (subtracting-zero-vector)
- (negating-a-vector)
- (multiply-by-scalar)
- (multiply-by-scalar-fraction)
- (dividing-scalar)
- (magnitude-of-vector)
- (normalize-vector)
- (normalize-magnitude-of-vector)
- (test-dot-product)
- (cross-product-results))
-
-(deftest color-vector-getters
- (let ((c (vector -0.5 0.4 1.7)))
- (check (equalp (RED c) -0.5)
- (equalp (GREEN c) 0.4)
- (equalp (BLUE c) 1.7))))
-
-(deftest blending-colors
- (let* ((c1 (vec3 1 0.2 0.4))
- (c2 (vec3 0.9 1 0.1))
- (blended-color (blend c1 c2)))
- (check (float= (RED blended-color) 0.9)
- (float= (GREEN blended-color) 0.2)
- (float= (BLUE blended-color) 0.04))))
-
-(deftest canvas-properties
- (let* ((c (make-canvas :width 10 :height 20))
- (w (canvas-width c))
- (h (canvas-height c)))
- (check (equalp w 10)
- (equalp h 20)
- (loop for i across (make-array (array-total-size (canvas-body c))
- :displaced-to (canvas-body c))
- always (equalp i (vector 0 0 0))))))
-
-(deftest canvas-write-pixel
- (let ((canvas (make-canvas :width 10 :height 20))
- (color (vector 1 0 0)))
- (write-pixel canvas 2 3 color)
- (check (equalp (aref (canvas-body canvas) 2 3) (vector 1 0 0)))))
-
-(deftest check-canvas-pixel-string
- (let ((c (make-canvas :width 1 :height 2)))
- (check (equalp (canvas-pixel-strings c) (list "0 0 0" "0 0 0")))))
-
-(deftest check-canvas-to-string
- (let ((c (make-canvas :width 1 :height 2)))
- (check (equalp (canvas->string c) "0 0 0 0 0 0"))))
-
-(deftest output-canvas-to-ppm
- (check (equalp (canvas->ppm (make-canvas :width 3 :height 5))
- "P3
-3 5
-255
-0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
-0 0 0 0 0 0 0 0 0 0
-")))
-
-(deftest ppm-includes-trailing-newline
- (let ((c (canvas->ppm (make-canvas :width 3 :height 5))))
- (check (equalp 0 (position #\Newline (reverse c) :test #'char=)))))
-
-(deftest canvas-and-visuals
- (color-vector-getters)
- (blending-colors)
- (canvas-properties)
- (canvas-write-pixel)
- (check-canvas-pixel-string)
- (check-canvas-to-string)
- (output-canvas-to-ppm)
- (ppm-includes-trailing-newline))
-
-(deftest multiply-4x4-matrices
- (let ((a #2A((1 2 3 4)
- (5 6 7 8)
- (9 8 7 6)
- (5 4 3 2)))
- (b #2A((-2 1 2 3)
- ( 3 2 1 -1)
- ( 4 3 6 5)
- ( 1 2 7 8))))
- (check (equalp (matrix*matrix a b)
- #2A((20 22 50 48)
- (44 54 114 108)
- (40 58 110 102)
- (16 26 46 42))))))
-
-(deftest multiply-matrix-with-vector
- (let ((a #2A((1 2 3 4)
- (2 4 4 2)
- (8 6 4 1)
- (0 0 0 1)))
- (b (vector 1 2 3 1)))
- (check (equalp (matrix*vector a b) (vector 18 24 33 1)))))
-
-(deftest identity-matrix-returns-original-matrix
- (check (equalp
- (matrix*matrix identity-matrix #2A((1 2 3 4)
- (2 4 4 2)
- (8 6 4 1)
- (0 0 0 1)))
- #2A((1 2 3 4)
- (2 4 4 2)
- (8 6 4 1)
- (0 0 0 1)))))
-
-(deftest identity-matrix-times-tuple
- (check (equalp
- (matrix*vector identity-matrix (vector 1 2 3 4))
- (vector 1 2 3 4))))
-
-(deftest transpose-a-matrix
- (let ((a #2A((0 9 3 0)
- (9 8 0 8)
- (1 8 5 3)
- (0 0 5 6))))
- (check (equalp (transpose a) #2A((0 9 1 0)
- (9 8 8 0)
- (3 0 5 5)
- (0 8 3 6))))))
-
-(deftest transpose-identity-matrix
- (check (equalp (transpose identity-matrix)
- identity-matrix)))
-
-(deftest verify-2x2-determinant
- (let ((a #2A(( 1 5)
- (-3 2))))
- (check (equalp (determinant a) 17))))
-
-(deftest submatrix-of-3x3-is-2x2
- (let ((m #2A(( 1 5 0)
- (-3 2 7)
- ( 0 6 -3))))
- (check (equalp (submatrix m 0 2) #2A((-3 2)
- ( 0 6))))))
-
-(deftest submatrix-of-4x4-is-3x3
- (let ((m #2A((-6 1 1 6)
- (-8 5 8 6)
- (-1 0 8 2)
- (-7 1 -1 1))))
- (check (equalp (submatrix m 2 1) #2A((-6 1 6)
- (-8 8 6)
- (-7 -1 1))))))
-
-(deftest 3x3-matrix-minor
- (let* ((a #2A((3 5 0)
- (2 -1 7)
- (6 -1 5)))
- (b (submatrix a 1 0)))
- (check (equalp (determinant b) 25)
- (equalp (minor a 1 0) 25))))
-
-(deftest 3x3-matrix-cofactor
- (let ((a #2A((3 5 0)
- (2 -1 -7)
- (6 -1 5))))
- (check (equalp (minor a 0 0) -12)
- (equalp (cofactor a 0 0) -12)
- (equalp (minor a 1 0) 25)
- (equalp (cofactor a 1 0) -25))))
-
-(deftest 3x3-matrix-determinant
- (let ((a #2A(( 1 2 6)
- (-5 8 -4)
- ( 2 6 4))))
- (check (equalp (cofactor a 0 0) 56)
- (equalp (cofactor a 0 1) 12)
- (equalp (cofactor a 0 2) -46)
- (equalp (determinant a) -196))))
-
-(deftest 4x4-matrix-determinant
- (let ((a #2A((-2 -8 3 5)
- (-3 1 7 3)
- ( 1 2 -9 6)
- (-6 7 7 -9))))
- (check (equalp (cofactor a 0 0) 690)
- (equalp (cofactor a 0 1) 447)
- (equalp (cofactor a 0 2) 210)
- (equalp (cofactor a 0 3) 51)
- (equalp (determinant a) -4071))))
-
-(deftest invertibility-predicate
- (let ((a #2A((6 4 4 4)
- (5 5 7 6)
- (4 -9 3 -7)
- (9 1 7 -6))))
- (check (equalp (determinant a) -2120)
- (equalp (invertible? a) t))))
-
-(deftest invertibility-negative-case
- (let ((a #2A((-4 2 -2 -3)
- ( 9 6 2 6)
- ( 0 -5 1 -5)
- ( 0 0 0 0))))
- (check (equalp (determinant a) 0)
- (equalp (invertible? a) nil))))
-
-(deftest calculate-matrix-inverse
- (let* ((a #2A((-5 2 6 -8)
- ( 1 -5 1 8)
- ( 7 7 -6 -7)
- ( 1 -3 7 4)))
- (b (inverse a)))
- (check (equalp (determinant a) 532)
- (equalp (cofactor a 2 3) -160)
- (equalp (aref b 3 2) -160/532)
- (equalp (cofactor a 3 2) 105)
- (equalp (aref b 2 3) 105/532)
-
- (equalp b #2A(( 29/133 60/133 32/133 -6/133)
- (-215/266 -775/532 -59/133 277/532)
- ( -3/38 -17/76 -1/19 15/76)
- (-139/266 -433/532 -40/133 163/532))))))
-
-(deftest inverse-is-reversible
- (let* ((a #2A((-5 2 6 -8)
- ( 1 -5 1 8)
- ( 7 7 -6 -7)
- ( 1 -3 7 4)))
- (b (inverse a)))
- (check (equalp (inverse b) a))))
-
-(deftest inverse-undoes-multiplication
- (let* ((a #2A(( 3 -9 7 3)
- ( 3 -8 2 -9)
- (-4 4 4 1)
- (-6 5 -1 1)))
- (b #2A((8 2 2 2)
- (3 -1 7 0)
- (7 0 5 4)
- (6 -2 0 5)))
- (c (matrix*matrix a b)))
- (check (equalp (matrix*matrix c (inverse b)) a))))
-
-(deftest matrix-basics
- (multiply-4x4-matrices)
- (multiply-matrix-with-vector)
- (identity-matrix-returns-original-matrix)
- (identity-matrix-times-tuple)
- (transpose-a-matrix)
- (transpose-identity-matrix)
- (verify-2x2-determinant)
- (submatrix-of-3x3-is-2x2)
- (submatrix-of-4x4-is-3x3)
- (3x3-matrix-minor)
- (3x3-matrix-cofactor)
- (3x3-matrix-determinant)
- (4x4-matrix-determinant)
- (invertibility-predicate)
- (invertibility-negative-case)
- (calculate-matrix-inverse)
- (inverse-is-reversible)
- (inverse-undoes-multiplication))
-
-(deftest multiplying-translation-matrix
- (let ((transform (translation 5 -3 2))
- (p (point -3 4 5)))
- (check (equalp (matrix*vector transform p)
- (point 2 1 7)))))
-
-(deftest multiply-inverse-of-translation
- (let* ((transform (translation 5 -3 2))
- (inv (inverse transform))
- (p (point -3 4 5)))
- (check (equalp (matrix*vector inv p)
- (point -8 7 3)))))
-
-(deftest translation-of-a-vector
- (let ((transform (translation 5 -3 2))
- (v (vec3 -3 4 5)))
- (check (equalp (matrix*vector transform v) v))))
-
-(deftest scaling-matrix-to-point
- (let ((transform (scaling 2 3 4))
- (p (point -4 6 8)))
- (check (equalp (matrix*vector transform p)
- (point -8 18 32)))))
-
-(deftest scaling-matrix-to-vector
- (let ((transform (scaling 2 3 4))
- (v (vec3 -4 6 8)))
- (check (equalp (matrix*vector transform v)
- (vec3 -8 18 32)))))
-
-(deftest multiplying-inverse-of-scaling-matrix
- (let* ((transform (scaling 2 3 4))
- (inv (inverse transform))
- (v (vec3 -4 6 8)))
- (check (equalp (matrix*vector inv v)
- (vec3 -2 2 2)))))
-
-(deftest scaling-negatively-is-reflection
- (let ((transform (scaling -1 1 1))
- (p (point 2 3 4)))
- (check (equalp (matrix*vector transform p)
- (point -2 3 4)))))
-
-(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))))))
-
-(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))))))
-
-(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))))))
-
-(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))))))
-
-(deftest shearing-transforms-x-proportionally-to-y
- (let ((transform (shearing 1 0 0 0 0 0))
- (p (point 2 3 4)))
- (check (equalp (matrix*vector transform p)
- (point 5 3 4)))))
-
-(deftest shearing-transforms-x-proportionally-to-z
- (let ((transform (shearing 0 1 0 0 0 0))
- (p (point 2 3 4)))
- (check (equalp (matrix*vector transform p)
- (point 6 3 4)))))
-
-(deftest shearing-transforms-y-proportionally-to-x
- (let ((transform (shearing 0 0 1 0 0 0))
- (p (point 2 3 4)))
- (check (equalp (matrix*vector transform p)
- (point 2 5 4)))))
-
-(deftest shearing-transforms-y-proportionally-to-z
- (let ((transform (shearing 0 0 0 1 0 0))
- (p (point 2 3 4)))
- (check (equalp (matrix*vector transform p)
- (point 2 7 4)))))
-
-(deftest shearing-transforms-z-proportionally-to-x
- (let ((transform (shearing 0 0 0 0 1 0))
- (p (point 2 3 4)))
- (check (equalp (matrix*vector transform p)
- (point 2 3 6)))))
-
-(deftest shearing-transforms-z-proportionally-to-y
- (let ((transform (shearing 0 0 0 0 0 1))
- (p (point 2 3 4)))
- (check (equalp (matrix*vector transform p)
- (point 2 3 7)))))
-
-(deftest chaining-transformations
- (let ((a (rotation-x (/ pi 2)))
- (b (scaling 5 5 5))
- (c (translation 10 5 7))
- (p (point 1 0 1)))
- (check (equalp (matrix*vector (matrix*matrix c (matrix*matrix b a))
- p)
- (point 15 0 7)))))
-
-(deftest matrix-transformations
- (multiplying-translation-matrix)
- (multiply-inverse-of-translation)
- (translation-of-a-vector)
- (scaling-matrix-to-point)
- (scaling-matrix-to-vector)
- (multiplying-inverse-of-scaling-matrix)
- (scaling-negatively-is-reflection)
- (rotation-around-x-axis)
- (inverse-x-rotation-rotates-oppositely)
- (rotation-around-y-axis)
- (rotation-around-z-axis)
- (shearing-transforms-x-proportionally-to-y)
- (shearing-transforms-x-proportionally-to-z)
- (shearing-transforms-y-proportionally-to-x)
- (shearing-transforms-y-proportionally-to-z)
- (shearing-transforms-z-proportionally-to-x)
- (shearing-transforms-z-proportionally-to-y)
- (chaining-transformations))
-
-(deftest suite
- (vector-basics)
- (canvas-and-visuals)
- (matrix-basics)
- (matrix-transformations))
-
-;;; sample
-(defstruct projectile position velocity)
-(defstruct environment gravity wind)
-
-(defun tick (env proj)
- (let ((p (VECTOR+ (projectile-position proj) (projectile-velocity proj)))
- (v (VECTOR+ (projectile-velocity proj) (VECTOR+ (environment-gravity env)
- (environment-wind env)))))
- (make-projectile :position p :velocity v)))
-
-(defun projectile-tracking ()
- (do* ((env (make-environment :gravity (vec3 0 -0.1 0)
- :wind (vec3 -0.01 0 0)))
- (p (make-projectile :position (point 0 1 0)
- :velocity (normalize (vec3 1 1 0)))
- (tick env p)))
- ((if (<= (Y (projectile-position p)) 0) (return p)))
- (format t "~a~%" (projectile-position p))))
-
-(defun projectile-visualization ()
- (do* ((env (make-environment :gravity (vec3 0 -0.093 0)
- :wind (vec3 -0.01 0 0)))
- (p (make-projectile :position (point 0 1 0)
- :velocity (scale-vector (normalize (vec3 1 1.5 0)) 10))
- (tick env p))
- (c (make-canvas :width 900 :height 550)))
- ((<= (Y (projectile-position p)) 0)
- (ppm->file (canvas->ppm c) "/home/nolan/test-output.ppm"))
- (format t "~s ~s~%"
- (max 0 (floor (X (projectile-position p))))
- (max 0 (floor (- (canvas-height c) 100))))
- (write-pixel c
- (max 0 (floor (X (projectile-position p))))
- (max 0 (floor (- (canvas-height c) (Y (projectile-position p)))))
- (vector 255 255 255))))
-
-;; sample "clock face"
-(defun clockface ()
- (flet ((face-point (hour)
- (matrix*vector (matrix*matrix (translation 0 0 0) (rotation-z (* hour (/ pi 6))))
- (point 0 1 0)))
- (paint-with-offset (canvas p)
- (write-pixel canvas
- (+ 50 (* 30 (X p)))
- (+ 50 (* 30 (Y p)))
- (vector 255 255 255))))
- (let ((canvas (make-canvas :width 100 :height 100)))
- (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"))))