From 96c3f78cb95df3ed246827624b7ced0df0182544 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Sun, 3 Aug 2014 20:36:38 -0400 Subject: Add look-at procedure. * sly/transform.scm (look-at): New procedure. --- sly/transform.scm | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/sly/transform.scm b/sly/transform.scm index f8bba23..df6c52a 100644 --- a/sly/transform.scm +++ b/sly/transform.scm @@ -32,7 +32,8 @@ transpose transform-vector2 transform+ transform* scale translate rotate-x rotate-y rotate-z - orthographic-projection perspective-projection)) + orthographic-projection perspective-projection + look-at)) (define-record-type (%make-transform matrix) @@ -218,3 +219,14 @@ depth clipping plane NEAR and FAR." 0 f 0 0 0 0 (/ (+ far near) (- near far)) -1 0 0 (/ (* 2 far near) (- near far)) 0))) + +(define* (look-at eye center #:optional (up #(0 1 0))) + (let* ((forward (normalize (v- center eye))) + (side (normalize (vcross forward up))) + (up (normalize (vcross side forward)))) + (transform* + (make-transform (vx side) (vx up) (- (vx forward)) 0 + (vy side) (vy up) (- (vy forward)) 0 + (vz side) (vz up) (- (vz forward)) 0 + 0 0 0 1) + (translate (v- eye))))) -- cgit v1.2.3