math: matrix: Add look-at/look-at! procedures.

1 files changed, 23 insertions, 0 deletions

diff --git a/chickadee/math/matrix.scm b/chickadee/math/matrix.scm
index 6931a2c..f16e583 100644
--- a/chickadee/math/matrix.scm
+++ b/chickadee/math/matrix.scm
@@ -51,6 +51,8 @@
             matrix4-identity!
             orthographic-projection
             perspective-projection
+            look-at!
+            look-at
             matrix4-translate!
             matrix4-translate
             matrix4-scale!
@@ -540,6 +542,27 @@ clipping plane NEAR and FAR."
                   0 0 (/ (+ far near) (- near far)) -1
                   0 0 (/ (* 2 far near) (- near far)) 0)))
 
+(define (look-at! matrix eye at up)
+  ;; TODO: Eliminate allocation of vectors.
+  (let* ((zaxis (vec3-normalize (vec3- at eye)))
+         (xaxis (vec3-normalize (vec3-cross zaxis (vec3-normalize up))))
+         (yaxis (vec3-cross xaxis zaxis)))
+    (init-matrix4 matrix
+                  (vec3-x xaxis) (vec3-x yaxis) (- (vec3-x zaxis)) 0.0
+                  (vec3-y xaxis) (vec3-y yaxis) (- (vec3-y zaxis)) 0.0
+                  (vec3-z xaxis) (vec3-z yaxis) (- (vec3-z zaxis)) 0.0
+                  (- (vec3-dot-product xaxis eye))
+                  (- (vec3-dot-product yaxis eye))
+                  (vec3-dot-product zaxis eye)
+                  1.0)))
+
+(define (look-at eye at up)
+  "Return a new matrix4 that looks toward the position AT from the
+position EYE, with the top of the viewport facing UP."
+  (let ((matrix (make-null-matrix4)))
+    (look-at! matrix eye at up)
+    matrix))
+
 (define (matrix4-translate! matrix v)
   (cond
    ((vec2? v)