diff options
| author | David Thompson <dthompson2@worcester.edu> | 2014-08-03 20:36:38 -0400 |
|---|---|---|
| committer | David Thompson <dthompson2@worcester.edu> | 2014-08-25 19:33:07 -0400 |
| commit | 96c3f78cb95df3ed246827624b7ced0df0182544 (patch) | |
| tree | 694717f482f6808a772ef0df39e390841f904367 | |
| parent | 908223915a494151e306cca6d9a9a6c2a2f1e429 (diff) | |
Add look-at procedure.
* sly/transform.scm (look-at): New procedure.
| -rw-r--r-- | sly/transform.scm | 14 |
1 files changed, 13 insertions, 1 deletions
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 <transform> (%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))))) |