diff options
| -rw-r--r-- | sly/math/transform.scm | 91 | ||||
| -rw-r--r-- | sly/render/context.scm | 5 | ||||
| -rw-r--r-- | sly/render/shader.scm | 4 |
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)))) |