@@ 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 @@ 0 0 0 0 0 0 0 0 0 0
(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 @@ 0 0 0 0 0 0 0 0 0 0
(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 @@ 0 0 0 0 0 0 0 0 0 0
(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"))))