# HG changeset patch
# User Nolan Prescott <git@nprescott.com>
# Date 1584588266 14400
#      Wed Mar 18 23:24:26 2020 -0400
# Node ID 2961f9309494a4259ba2800b4f889b6c56ab1739
# Parent  0000000000000000000000000000000000000000
rudimentary vector operations and PPM output

not sure about the "test code", I've switched from the PCL style
harness to a shorter (2 macros!) version using `assert` very similar
to 1am. The output is bad but I don't have a better idea yet.

diff --git a/tracer.lisp b/tracer.lisp
new file mode 100644
--- /dev/null
+++ b/tracer.lisp
@@ -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))