# HG changeset patch
# User Nolan Prescott <mail@nprescott.com>
# Date 1585011054 14400
#      Mon Mar 23 20:50:54 2020 -0400
# Node ID 6a9fc9ef38104db1d8dc602d290272c203f1390c
# Parent  9005fdd530b2d6731cd0d5916ce32df16480b444
add shearing transformations

include "clock face" example

diff --git a/tracer.lisp b/tracer.lisp
--- a/tracer.lisp
+++ b/tracer.lisp
@@ -76,8 +76,10 @@
 
 (defun write-pixel (canvas x y color)
   (destructuring-bind (n m) (array-dimensions (canvas-body canvas))
-    (if (and (< x n) (< y m))
-        (setf (aref (canvas-body canvas) x y) color))))
+    (if (and (< x n) (< y m)
+             (>= x 0) (>= y 0))
+        (setf (aref (canvas-body canvas) (floor x) (floor y)) color)
+        (format t "not writing <~s, ~s>~%" x y))))
 
 (defun wrap (text width)
   (setq text (concatenate 'string text " "))
@@ -671,6 +673,57 @@
     (check (not (member nil (mapcar #'float= hq-values hq-actuals)))
            (not (member nil (mapcar #'float= fq-values fq-actuals))))))
 
+(defun shearing (xy xx yx yz zx zy)
+  (make-array '(4 4) :initial-contents `((  1 ,xy ,xx 0)
+                                         (,yx   1 ,yz 0)
+                                         (,zx ,zy   1 0)
+                                         (  0   0   0 1))))
+
+(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)
@@ -682,7 +735,14 @@
   (rotation-around-x-axis)
   (inverse-x-rotation-rotates-oppositely)
   (rotation-around-y-axis)
-  (rotation-around-z-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)
@@ -725,3 +785,18 @@
                  (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"))))