diff options
| author | David Thompson <dthompson2@worcester.edu> | 2018-01-17 12:00:29 -0500 |
|---|---|---|
| committer | David Thompson <dthompson2@worcester.edu> | 2018-01-17 12:00:29 -0500 |
| commit | 4912d9bd202115e6a2d2a22d3414310f8ac63ff2 (patch) | |
| tree | 346404863df2b8bf653b772e810d3cc33659e745 | |
| parent | 8cbb7eed56c4b5edd780c2d51aaa0a4c3eab7350 (diff) | |
math: matrix: Add matrix4-2d-transform! procedure.
* chickadee/math/matrix.scm (matrix4-2d-transform): New procedure.
| -rw-r--r-- | chickadee/math/matrix.scm | 42 |
1 files changed, 42 insertions, 0 deletions
diff --git a/chickadee/math/matrix.scm b/chickadee/math/matrix.scm index af206f4..e462cd2 100644 --- a/chickadee/math/matrix.scm +++ b/chickadee/math/matrix.scm @@ -44,6 +44,7 @@ matrix4-rotate matrix4-rotate-z! matrix4-rotate-z + matrix4-2d-transform! transform!)) ;; 4x4 matrix @@ -377,6 +378,47 @@ clipping plane NEAR and FAR." (matrix4-rotate-z! matrix angle) matrix)) +(define matrix4-2d-transform! + (let ((tmp (make-null-matrix4)) + (offset (vec2 0.0 0.0)) + (null-vec2 (vec2 0.0 0.0)) + (default-scale (vec2 1.0 1.0))) + (lambda* (matrix + #:key + (origin null-vec2) + (position null-vec2) + (rotation 0.0) + (scale default-scale) + (skew null-vec2)) + "Store in MATRIX the transformation described by POSITION, a 2D +vector or rect, ROTATION, a scalar representing a rotation about the Z +access, SCALE, a 2D vector, and SKEW, a 2D vector. The transformation +happens with respect to ORIGIN, a 2D vector." + (let* ((bv (matrix4-bv matrix)) + (x (vec2-x position)) + (y (vec2-y position)) + (ox (vec2-x origin)) + (oy (vec2-x origin)) + (sx (vec2-x scale)) + (sy (vec2-y scale)) + (kx (vec2-x skew)) + (ky (vec2-y skew)) + (c (cos rotation)) + (s (sin rotation)) + (q (- (* c sx) (* s sy ky))) + (r (+ (* s sx) (* c sx ky))) + (s (- (* c sx kx) (* s sy))) + (t (+ (* s sx kx) (* c sy)))) + (bytevector-fill! bv 0) + (f32vector-set! bv 10 1.0) + (f32vector-set! bv 15 1.0) + (f32vector-set! bv 0 q) + (f32vector-set! bv 1 r) + (f32vector-set! bv 4 s) + (f32vector-set! bv 5 t) + (f32vector-set! bv 12 (- x (* ox q) (* oy s))) + (f32vector-set! bv 13 (- y (* ox r) (* oy t))))))) + (define-inlinable (transform! matrix v) (let ((bv (matrix4-bv matrix)) (x (vec2-x v)) |