@@ 0,0 1,262 @@
+;;; test code:
+(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))
+
+;;; code:
+(defmacro defun-vec3-binop (binop)
+ `(defun ,(intern (concatenate 'string "VEC3" (string binop))) (v1 v2)
+ (vector (,binop (aref v1 0) (aref v2 0))
+ (,binop (aref v1 1) (aref v2 1))
+ (,binop (aref v1 2) (aref v2 2)))))
+
+(defun-vec3-binop +)
+(defun-vec3-binop -)
+(defun-vec3-binop *)
+(defun-vec3-binop /)
+
+(defmacro vec3-getters (aliases)
+ `(progn
+ ,@(loop for name in aliases
+ for index = 0 then (1+ index)
+ collect
+ `(defmacro ,name (vec3)
+ `(aref ,vec3 ,,index)))))
+
+(vec3-getters (RED GREEN BLUE))
+(vec3-getters (X Y Z))
+
+(defun negate-vec3 (v)
+ (VEC3- (vector 0 0 0) v))
+
+(defun scale-vec3 (v scalar)
+ (VEC3* v (vector scalar scalar scalar)))
+
+(defun magnitude (vec3)
+ (labels ((square (n) (expt n 2)))
+ (sqrt (+ (square (X vec3))
+ (square (Y vec3))
+ (square (Z vec3))))))
+
+(defun normalize (vec3)
+ (let ((m (magnitude vec3)))
+ (scale-vec3 vec3 (/ 1 m))))
+
+(defun dot-product (v1 v2)
+ (reduce #'+ (vec3* v1 v2)))
+
+(defun cross-product (v1 v2)
+ (vector (- (* (Y v1) (Z v2)) (* (Z v1) (Y v2)))
+ (- (* (Z v1) (X v2)) (* (X v1) (Z v2)))
+ (- (* (X v1) (Y v2)) (* (Y v1) (X v2)))))
+
+(defun blend (c1 c2)
+ (vec3* c1 c2))
+
+(defun create-canvas (width height)
+ (make-array (list width height) :initial-element (vector 0 0 0)))
+
+(defun canvas-height (c)
+ (nth 1 (array-dimensions c)))
+
+(defun canvas-width (c)
+ (nth 0 (array-dimensions c)))
+
+(defun write-pixel (canvas x y color)
+ (setf (aref canvas x y) color))
+
+(defun wrap (text width)
+ (setq text (concatenate 'string text " "))
+ (do* ((len (length text))
+ (lines (list))
+ (offset 0)
+ (previous 0 next)
+ (next (position #\Space text) (when (< (1+ previous) len)
+ (position #\Space text :start (1+ previous)))))
+ ((null next) (progn
+ (push (subseq text offset (1- len)) lines)
+ (nreverse lines)))
+ (when (> (- next offset) width)
+ (push (subseq text offset previous) lines)
+ (setq offset (1+ previous)))))
+
+(defun canvas-pixel-strings (c)
+ (labels ((pixel->string (v) (format nil "~s ~s ~s" (Red v) (Green v) (Blue v))))
+ (loop for pixel across (make-array (apply #'* (array-dimensions c)) :displaced-to c)
+ collect (pixel->string pixel))))
+
+(defun canvas->string (c)
+ (let* ((triplet-strings (canvas-pixel-strings c))
+ (single-long-string (format nil "~{~a~^ ~}" triplet-strings))
+ (fixed-width-strings (wrap single-long-string 70)))
+ (format nil "~{~a~^~%~}" fixed-width-strings)))
+
+(defun canvas->ppm (c)
+ (format nil "P3~%~s ~s~%255~%~a~%"
+ (canvas-width c) (canvas-height c) (canvas->string c)))
+
+;;; tests:
+(deftest adding-vec3
+ (let ((a (vector 3 -2 5))
+ (b (vector -2 3 1)))
+ (check (equalp (VEC3+ a b)
+ (vector 1 1 6)))))
+
+(deftest subtracting-vec3
+ (let ((a (vector 3 2 1))
+ (b (vector 5 6 7)))
+ (check (equalp (VEC3- a b)
+ (vector -2 -4 -6)))))
+
+(deftest point-minus-a-vector
+ (let ((p (vector 3 2 1))
+ (v (vector 5 6 7)))
+ (check (equalp (VEC3- p v)
+ (vector -2 -4 -6)))))
+
+(deftest subtracting-zero-vector
+ (let ((zero (vector 0 0 0))
+ (v (vector 1 -2 3)))
+ (check (equalp (VEC3- zero v)
+ (vector -1 2 -3)))))
+
+(deftest negating-a-vector
+ (let ((v (vector 1 -2 3)))
+ (check (equalp (negate-vec3 v)
+ (vector -1 2 -3)))))
+
+(deftest multiply-by-scalar
+ (let ((t1 (vector 1 -2 3 -4))
+ (scalar 3.5))
+ (check (equalp (scale-vec3 t1 scalar)
+ (vector 3.5 -7 10.5)))))
+
+(deftest multiply-by-scalar-fraction
+ (let ((v (vector 1 -2 3))
+ (scalar (/ 1 2)))
+ (check (equalp (scale-vec3 v scalar)
+ (vector 0.5 -1 1.5)))))
+
+(deftest dividing-scalar
+ (let ((v (vector 1 -2 3))
+ (scalar 2))
+ (check (equalp (scale-vec3 v (/ 1 scalar))
+ (vector 0.5 -1 1.5)))))
+
+(deftest magnitude-of-vector
+ (let ((v1 (vector 0 1 0))
+ (v2 (vector 0 0 1))
+ (v3 (vector 1 2 3))
+ (v4 (vector -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 (vector 4 0 0))
+ (v2 (vector 1 2 3)))
+ (check (equalp (normalize v1) (vector 1 0 0))
+ (equalp (normalize v2) (vector (/ 1 (sqrt 14))
+ (/ 2 (sqrt 14))
+ (/ 3 (sqrt 14)))))))
+
+(deftest normalize-magnitude-of-vector
+ (let ((v1 (vector 1 2 3)))
+ (check (float= (magnitude (normalize v1)) 1))))
+
+(deftest test-dot-product
+ (let ((v1 (vector 1 2 3))
+ (v2 (vector 2 3 4)))
+ (check (equalp (dot-product v1 v2) 20))))
+
+(deftest cross-product-results
+ (let ((v1 (vector 1 2 3))
+ (v2 (vector 2 3 4)))
+ (check (equalp (cross-product v1 v2) (vector -1 2 -1))
+ (equalp (cross-product v2 v1) (vector 1 -2 1)))))
+
+(deftest chapter-1
+ (adding-vec3)
+ (subtracting-vec3)
+ (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 (vector 1 0.2 0.4))
+ (c2 (vector 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 (create-canvas 10 20))
+ (w (canvas-width c))
+ (h (canvas-height c)))
+ (check (equalp w 10)
+ (equalp h 20)
+ (loop for i across (make-array (* w h) :displaced-to c)
+ always (equalp i (vector 0 0 0))))))
+
+(deftest canvas-write-pixel
+ (let ((canvas (create-canvas 10 20))
+ (color (vector 1 0 0)))
+ (write-pixel canvas 2 3 color)
+ (check (equalp (aref canvas 2 3) (vector 1 0 0)))))
+
+(deftest check-canvas-pixel-string
+ (let ((c (create-canvas 1 2)))
+ (check (equalp (canvas-pixel-strings c) (list "0 0 0" "0 0 0")))))
+
+(deftest check-canvas-to-string
+ (let ((c (create-canvas 1 2)))
+ (check (equalp (canvas->string c) "0 0 0 0 0 0"))))
+
+(deftest output-canvas-to-ppm
+ (check (equalp (canvas->ppm (create-canvas 3 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 chapter-2
+ (color-vector-getters)
+ (blending-colors)
+ (canvas-properties)
+ (canvas-write-pixel)
+ (check-canvas-pixel-string)
+ (check-canvas-to-string)
+ (output-canvas-to-ppm))
+
+(deftest suite
+ (chapter-1)
+ (chapter-2))