summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--sly/math/transform.scm144
1 files changed, 136 insertions, 8 deletions
diff --git a/sly/math/transform.scm b/sly/math/transform.scm
index 31881e1..38fd464 100644
--- a/sly/math/transform.scm
+++ b/sly/math/transform.scm
@@ -31,7 +31,6 @@
#:use-module (sly math)
#:use-module (sly math vector)
#:use-module (sly math quaternion)
- #:use-module (sly wrappers gsl)
#:export (make-transform null-transform identity-transform
transform? transform-matrix
transpose transform-vector2
@@ -52,10 +51,10 @@
(define (make-4x4-matrix)
(make-f32vector 16))
-(define (matrix-set! matrix row column x)
+(define-inlinable (matrix-set! matrix row column x)
(f32vector-set! matrix (+ (* row 4) column) x))
-(define (matrix-ref matrix row column)
+(define-inlinable (matrix-ref matrix row column)
(f32vector-ref matrix (+ (* row 4) column)))
(define (make-transform aa ab ac ad
@@ -151,12 +150,141 @@ called without any arguments."
result))
(reduce mul identity-transform transforms))
+;; This could be described as a loop, but the result would be much
+;; slower matrix multiplication. To enable Guile's optimizer to unbox
+;; floating point ops and reduce reads/writes, each matrix element is
+;; bound as a local, the loop is completely unrolled, and matrix-ref
+;; and matrix-set! are inlined.
(define (transform*! dest a b)
- (cblas-sgemm cblas-row-major cblas-no-trans cblas-no-trans
- 4 4 4 1
- (transform->pointer a) 4
- (transform->pointer b) 4
- 0 (transform->pointer dest) 4))
+ (let ((m1 (transform-matrix a))
+ (m2 (transform-matrix b))
+ (m3 (transform-matrix dest)))
+ (let ((m1-0-0 (matrix-ref m1 0 0))
+ (m1-0-1 (matrix-ref m1 0 1))
+ (m1-0-2 (matrix-ref m1 0 2))
+ (m1-0-3 (matrix-ref m1 0 3))
+ (m1-1-0 (matrix-ref m1 1 0))
+ (m1-1-1 (matrix-ref m1 1 1))
+ (m1-1-2 (matrix-ref m1 1 2))
+ (m1-1-3 (matrix-ref m1 1 3))
+ (m1-2-0 (matrix-ref m1 2 0))
+ (m1-2-1 (matrix-ref m1 2 1))
+ (m1-2-2 (matrix-ref m1 2 2))
+ (m1-2-3 (matrix-ref m1 2 3))
+ (m1-3-0 (matrix-ref m1 3 0))
+ (m1-3-1 (matrix-ref m1 3 1))
+ (m1-3-2 (matrix-ref m1 3 2))
+ (m1-3-3 (matrix-ref m1 3 3))
+ (m2-0-0 (matrix-ref m2 0 0))
+ (m2-0-1 (matrix-ref m2 0 1))
+ (m2-0-2 (matrix-ref m2 0 2))
+ (m2-0-3 (matrix-ref m2 0 3))
+ (m2-1-0 (matrix-ref m2 1 0))
+ (m2-1-1 (matrix-ref m2 1 1))
+ (m2-1-2 (matrix-ref m2 1 2))
+ (m2-1-3 (matrix-ref m2 1 3))
+ (m2-2-0 (matrix-ref m2 2 0))
+ (m2-2-1 (matrix-ref m2 2 1))
+ (m2-2-2 (matrix-ref m2 2 2))
+ (m2-2-3 (matrix-ref m2 2 3))
+ (m2-3-0 (matrix-ref m2 3 0))
+ (m2-3-1 (matrix-ref m2 3 1))
+ (m2-3-2 (matrix-ref m2 3 2))
+ (m2-3-3 (matrix-ref m2 3 3)))
+
+ (matrix-set! m3 0 0
+ (+ (* m1-0-0 m2-0-0)
+ (* m1-0-1 m2-1-0)
+ (* m1-0-2 m2-2-0)
+ (* m1-0-3 m2-3-0)))
+ (matrix-set! m3 0 1
+ (+ (* m1-0-0 m2-0-1)
+ (* m1-0-1 m2-1-1)
+ (* m1-0-2 m2-2-1)
+ (* m1-0-3 m2-3-1)))
+ (matrix-set! m3 0 2
+ (+ (* m1-0-0 m2-0-2)
+ (* m1-0-1 m2-1-2)
+ (* m1-0-2 m2-2-2)
+ (* m1-0-3 m2-3-2)))
+ (matrix-set! m3 0 3
+ (+ (* m1-0-0 m2-0-3)
+ (* m1-0-1 m2-1-3)
+ (* m1-0-2 m2-2-3)
+ (* m1-0-3 m2-3-3)))
+ (matrix-set! m3 1 0
+ (+ (* m1-1-0 m2-0-0)
+ (* m1-1-1 m2-1-0)
+ (* m1-1-2 m2-2-0)
+ (* m1-1-3 m2-3-0)))
+ (matrix-set! m3 1 1
+ (+ (* m1-1-0 m2-0-1)
+ (* m1-1-1 m2-1-1)
+ (* m1-1-2 m2-2-1)
+ (* m1-1-3 m2-3-1)))
+ (matrix-set! m3 1 2
+ (+ (* m1-1-0 m2-0-2)
+ (* m1-1-1 m2-1-2)
+ (* m1-1-2 m2-2-2)
+ (* m1-1-3 m2-3-2)))
+ (matrix-set! m3 1 3
+ (+ (* m1-1-0 m2-0-3)
+ (* m1-1-1 m2-1-3)
+ (* m1-1-2 m2-2-3)
+ (* m1-1-3 m2-3-3)))
+ (matrix-set! m3 2 0
+ (+ (* m1-2-0 m2-0-0)
+ (* m1-2-1 m2-1-0)
+ (* m1-2-2 m2-2-0)
+ (* m1-2-3 m2-3-0)))
+ (matrix-set! m3 2 1
+ (+ (* m1-2-0 m2-0-1)
+ (* m1-2-1 m2-1-1)
+ (* m1-2-2 m2-2-1)
+ (* m1-2-3 m2-3-1)))
+ (matrix-set! m3 2 2
+ (+ (* m1-2-0 m2-0-2)
+ (* m1-2-1 m2-1-2)
+ (* m1-2-2 m2-2-2)
+ (* m1-2-3 m2-3-2)))
+ (matrix-set! m3 2 3
+ (+ (* m1-2-0 m2-0-3)
+ (* m1-2-1 m2-1-3)
+ (* m1-2-2 m2-2-3)
+ (* m1-2-3 m2-3-3)))
+ (matrix-set! m3 3 0
+ (+ (* m1-3-0 m2-0-0)
+ (* m1-3-1 m2-1-0)
+ (* m1-3-2 m2-2-0)
+ (* m1-3-3 m2-3-0)))
+ (matrix-set! m3 3 1
+ (+ (* m1-3-0 m2-0-1)
+ (* m1-3-1 m2-1-1)
+ (* m1-3-2 m2-2-1)
+ (* m1-3-3 m2-3-1)))
+ (matrix-set! m3 3 2
+ (+ (* m1-3-0 m2-0-2)
+ (* m1-3-1 m2-1-2)
+ (* m1-3-2 m2-2-2)
+ (* m1-3-3 m2-3-2)))
+ (matrix-set! m3 3 3
+ (+ (* m1-3-0 m2-0-3)
+ (* m1-3-1 m2-1-3)
+ (* m1-3-2 m2-2-3)
+ (* m1-3-3 m2-3-3))))))
+
+(define (translate! t . args)
+ (match args
+ (($ <vector2> x y)
+ (make-transform 1 0 0 0
+ 0 1 0 0
+ 0 0 1 0
+ x y 0 1))
+ (($ <vector3> x y z)
+ (make-transform 1 0 0 0
+ 0 1 0 0
+ 0 0 1 0
+ x y z 1))))
(define translate
(match-lambda