# HG changeset patch # User Nolan Prescott # Date 1585016162 14400 # Mon Mar 23 22:16:02 2020 -0400 # Node ID eab2502021c0b1feadb1465785bb42e550a07967 # Parent e57252cd8161e33ba39a55de23eba6b058d62784 move code around (into packages) I'm not sure this is how packages _really_ work, but it's a start diff --git a/sample.lisp b/sample.lisp new file mode 100644 --- /dev/null +++ b/sample.lisp @@ -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")))) diff --git a/tests.lisp b/tests.lisp new file mode 100644 --- /dev/null +++ b/tests.lisp @@ -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)) diff --git a/tracer.lisp b/tracer.lisp --- a/tracer.lisp +++ b/tracer.lisp @@ -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"))))