summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2015-08-25 06:41:46 -0400
committerDavid Thompson <dthompson2@worcester.edu>2015-08-25 06:41:46 -0400
commita0b33ff9274b0fb682e36a42e3aa70ce5581df7c (patch)
treeb34f0315c365e171c2245ed77367ccccd40111c2
parent273c77383226dcce24a2f5af461cb4afb7244f9f (diff)
Optimize matrix operations.
Guile's array procedures are slow, so switch to using raw bytevectors instead. Additionally, converting the bytevector to a pointer is also slow, so the pointer is now cached for redundant calls. There's more to be done, but this was low hanging fruit. * sly/math/transform.scm (<transform>)[ptr]: New field. (transform-ptr): New accessor. (set-transform-ptr!): New setter. (make-4x4-matrix): Implement using bytevectors. (matrix-set!, matrix-ref): New procedures. (make-transform, transform-vector2, transform-position): Use 'matrix-set!' and 'matrix-ref'. (transpose, transform+, transform*): Use new transform constructor. (transform->pointer): Cache pointer. * sly/render/context.scm (copy-transform!): Use 'bytevector-copy!' * sly/render/shader.scm: Use 'transform->pointer' in the transform uniform setter.
-rw-r--r--sly/math/transform.scm91
-rw-r--r--sly/render/context.scm5
-rw-r--r--sly/render/shader.scm4
3 files changed, 57 insertions, 43 deletions
diff --git a/sly/math/transform.scm b/sly/math/transform.scm
index 5d65e4c..31881e1 100644
--- a/sly/math/transform.scm
+++ b/sly/math/transform.scm
@@ -25,6 +25,7 @@
#:use-module (system foreign)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-4)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-42)
#:use-module (sly math)
@@ -35,6 +36,7 @@
transform? transform-matrix
transpose transform-vector2
transform-position
+ transform->pointer
transform+ transform* transform*!
scale translate rotate-x rotate-y rotate-z rotate
build-transform
@@ -42,12 +44,19 @@
look-at))
(define-record-type <transform>
- (%make-transform matrix)
+ (%make-transform matrix ptr)
transform?
- (matrix transform-matrix))
+ (matrix transform-matrix)
+ (ptr transform-ptr set-transform-ptr!))
(define (make-4x4-matrix)
- (make-typed-array 'f32 0 4 4))
+ (make-f32vector 16))
+
+(define (matrix-set! matrix row column x)
+ (f32vector-set! matrix (+ (* row 4) column) x))
+
+(define (matrix-ref matrix row column)
+ (f32vector-ref matrix (+ (* row 4) column)))
(define (make-transform aa ab ac ad
ba bb bc bd
@@ -56,26 +65,26 @@
"Return a new transform initialized with the given 16 values in
column-major format."
(let ((matrix (make-4x4-matrix)))
- (array-set! matrix aa 0 0)
- (array-set! matrix ab 0 1)
- (array-set! matrix ac 0 2)
- (array-set! matrix ad 0 3)
- (array-set! matrix ba 1 0)
- (array-set! matrix bb 1 1)
- (array-set! matrix bc 1 2)
- (array-set! matrix bd 1 3)
- (array-set! matrix ca 2 0)
- (array-set! matrix cb 2 1)
- (array-set! matrix cc 2 2)
- (array-set! matrix cd 2 3)
- (array-set! matrix da 3 0)
- (array-set! matrix db 3 1)
- (array-set! matrix dc 3 2)
- (array-set! matrix dd 3 3)
- (%make-transform matrix)))
+ (matrix-set! matrix 0 0 aa)
+ (matrix-set! matrix 0 1 ab)
+ (matrix-set! matrix 0 2 ac)
+ (matrix-set! matrix 0 3 ad)
+ (matrix-set! matrix 1 0 ba)
+ (matrix-set! matrix 1 1 bb)
+ (matrix-set! matrix 1 2 bc)
+ (matrix-set! matrix 1 3 bd)
+ (matrix-set! matrix 2 0 ca)
+ (matrix-set! matrix 2 1 cb)
+ (matrix-set! matrix 2 2 cc)
+ (matrix-set! matrix 2 3 cd)
+ (matrix-set! matrix 3 0 da)
+ (matrix-set! matrix 3 1 db)
+ (matrix-set! matrix 3 2 dc)
+ (matrix-set! matrix 3 3 dd)
+ (%make-transform matrix #f)))
(define null-transform
- (%make-transform (make-4x4-matrix)))
+ (%make-transform (make-4x4-matrix) #f))
(define identity-transform
(make-transform 1 0 0 0
@@ -88,29 +97,29 @@ column-major format."
(let ((m1 (transform-matrix transform))
(m2 (make-4x4-matrix)))
(do-ec (: r 4) (: c 4)
- (array-set! m2 (array-ref m1 r c)
- c r))
- (%make-transform m2)))
+ (matrix-set! m2 c r
+ (matrix-ref m1 r c)))
+ (%make-transform m2 #f)))
(define (transform-vector2 transform v)
"Apply TRANSFORM to the 2D vector V."
(let ((m (transform-matrix transform))
(x (vx v))
(y (vy v)))
- (vector2 (+ (* x (array-ref m 0 0))
- (* y (array-ref m 0 1))
- (array-ref m 0 3))
- (+ (* x (array-ref m 1 0))
- (* y (array-ref m 1 1))
- (array-ref m 1 3)))))
+ (vector2 (+ (* x (matrix-ref m 0 0))
+ (* y (matrix-ref m 0 1))
+ (matrix-ref m 0 3))
+ (+ (* x (matrix-ref m 1 0))
+ (* y (matrix-ref m 1 1))
+ (matrix-ref m 1 3)))))
(define (transform-position transform)
"Return a vector3 containing the positional data stored in
TRANSFORM."
(let ((matrix (transform-matrix transform)))
- (vector3 (array-ref matrix 3 0)
- (array-ref matrix 3 1)
- (array-ref matrix 3 2))))
+ (vector3 (matrix-ref matrix 3 0)
+ (matrix-ref matrix 3 1)
+ (matrix-ref matrix 3 2))))
(define (transform+ . transforms)
"Return the sum of TRANSFORM. Return 'null-transform' if called
@@ -120,20 +129,24 @@ without any arguments."
(m2 (transform-matrix b))
(m3 (make-4x4-matrix)))
(do-ec (: r 4) (: c 4)
- (let ((x (+ (array-ref m1 r c)
- (array-ref m2 r c))))
- (array-set! m3 x r c)))
- (%make-transform m3)))
+ (let ((x (+ (matrix-ref m1 r c)
+ (matrix-ref m2 r c))))
+ (matrix-set! m3 r c x)))
+ (%make-transform m3 #f)))
(reduce add null-transform transforms))
(define (transform->pointer t)
- (bytevector->pointer (array-contents (transform-matrix t))))
+ (let ((ptr (transform-ptr t)))
+ (or ptr
+ (let ((ptr (bytevector->pointer (transform-matrix t))))
+ (set-transform-ptr! t ptr)
+ ptr))))
(define (transform* . transforms)
"Return the product of TRANSFORMS. Return identity-transform if
called without any arguments."
(define (mul a b)
- (let ((result (%make-transform (make-4x4-matrix))))
+ (let ((result (%make-transform (make-4x4-matrix) #f)))
(transform*! result a b)
result))
(reduce mul identity-transform transforms))
diff --git a/sly/render/context.scm b/sly/render/context.scm
index fe16104..a83b612 100644
--- a/sly/render/context.scm
+++ b/sly/render/context.scm
@@ -22,6 +22,7 @@
;;; Code:
(define-module (sly render context)
+ #:use-module (rnrs bytevectors)
#:use-module (ice-9 match)
#:use-module (ice-9 q)
#:use-module (srfi srfi-9)
@@ -155,7 +156,9 @@
(compose q-pop! render-context-transform-stack))
(define (copy-transform! src dest)
- (array-copy! (transform-matrix src) (transform-matrix dest)))
+ (bytevector-copy! (transform-matrix src) 0
+ (transform-matrix dest) 0
+ 64))
;; emacs: (put 'with-transform-excursion 'scheme-indent-function 1)
(define-syntax-rule (with-transform-excursion context body ...)
diff --git a/sly/render/shader.scm b/sly/render/shader.scm
index 9f80d2a..392ebc5 100644
--- a/sly/render/shader.scm
+++ b/sly/render/shader.scm
@@ -353,9 +353,7 @@ location."
(register-uniform-setter! transform?
(lambda (location t)
- (let ((pointer
- (bytevector->pointer
- (array-contents (transform-matrix t)))))
+ (let ((pointer (transform->pointer t)))
(glUniformMatrix4fv location 1 #f
pointer))))