summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2024-01-30 14:40:14 -0500
committerDavid Thompson <dthompson2@worcester.edu>2024-02-22 08:11:29 -0500
commit9ed0bf5b55a524df86dd80ad0966924f8788c984 (patch)
treebaa4b23a370acc66ac2f6a54a2c52542c6560ffe
parentece5930f7a0e6c0d8e09538872a855843184a098 (diff)
math: Convert matrix3/matrix4 to bytestructs.
-rw-r--r--chickadee/graphics/shader.scm18
-rw-r--r--chickadee/math/matrix.scm1166
2 files changed, 471 insertions, 713 deletions
diff --git a/chickadee/graphics/shader.scm b/chickadee/graphics/shader.scm
index 1acd3ac..edde064 100644
--- a/chickadee/graphics/shader.scm
+++ b/chickadee/graphics/shader.scm
@@ -217,22 +217,24 @@
#:size (* 3 3 4) ; 3 rows x 3 columns x 4 byte floats
#:validator matrix3?
#:serializer
- (let ((matrix3-bv (@@ (chickadee math matrix) matrix3-bv)))
- (lambda (bv i m)
- (bytevector-copy! (matrix3-bv m) 0 bv i (* 3 3 4))))
+ (lambda (bv i m)
+ (bytestruct-pack! <matrix3> ((() m)) bv i))
#:setter (lambda (location count ptr)
(gl-uniform-matrix3fv location count #f ptr))
#:null (make-identity-matrix3))
(define-shader-primitive-type mat4
#:name 'mat4
- #:size 64 ; 4 rows x 4 columns = 16 floats x 4 bytes each = 64 bytes
+ #:size (bytestruct-sizeof <matrix4>) ; 4 rows x 4 columns = 16 floats x 4 bytes each = 64 bytes
#:validator matrix4?
#:serializer
- (let ((matrix4-bv (@@ (chickadee math matrix) matrix4-bv)))
- (lambda (bv i m)
- ;; 4 rows x 4 columns x 4 bytes per float = 4^3
- (bytevector-copy! (matrix4-bv m) 0 bv i (* 4 4 4))))
+ (lambda (bv i m)
+ ;; (match m
+ ;; (($ <matrix4> src offset)
+ ;; (bytevector-copy! src offset bv i
+ ;; (bytestruct-sizeof <matrix4>))))
+ (bytestruct-pack! <matrix4> ((() m)) bv i)
+ )
#:setter (lambda (location count ptr)
(gl-uniform-matrix4fv location count #f ptr))
#:null (make-identity-matrix4))
diff --git a/chickadee/math/matrix.scm b/chickadee/math/matrix.scm
index 9abc479..8ec7767 100644
--- a/chickadee/math/matrix.scm
+++ b/chickadee/math/matrix.scm
@@ -1,5 +1,5 @@
;;; Chickadee Game Toolkit
-;;; Copyright © 2016 David Thompson <dthompson2@worcester.edu>
+;;; Copyright © 2016, 2024 David Thompson <dthompson2@worcester.edu>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
@@ -17,15 +17,18 @@
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (rnrs bytevectors)
+ #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-4)
#:use-module (system foreign)
+ #:use-module (chickadee data bytestruct)
#:use-module (chickadee math)
#:use-module (chickadee math quaternion)
#:use-module (chickadee math rect)
#:use-module (chickadee math vector)
- #:export (make-matrix3
+ #:export (<matrix3>
+ make-matrix3
make-null-matrix3
make-identity-matrix3
matrix3?
@@ -45,6 +48,8 @@
matrix3-transform
matrix3-inverse!
matrix3-inverse
+
+ <matrix4>
make-matrix4
make-null-matrix4
make-identity-matrix4
@@ -86,176 +91,151 @@
matrix4-y
matrix4-z))
+(define-syntax define-square-matrix-type
+ (lambda (stx)
+ (syntax-case stx ()
+ ((_ (<matrix> dimension)
+ make-matrix make-null-matrix make-identity-matrix
+ matrix? matrix=?
+ matrix-ref matrix-set! matrix-init! matrix-identity!
+ matrix-copy matrix-copy!
+ matrix:* matrix-mul!)
+ (and (identifier? #'<matrix>)
+ (exact-integer? (syntax->datum #'dimension))
+ (identifier? #'make-matrix)
+ (identifier? #'make-null-matrix)
+ (identifier? #'make-identity-matrix)
+ (identifier? #'matrix?)
+ (identifier? #'matrix-ref)
+ (identifier? #'matrix-set!)
+ (identifier? #'matrix-init!)
+ (identifier? #'matrix-identity!)
+ (identifier? #'matrix-copy)
+ (identifier? #'matrix3-copy!)
+ (identifier? #'matrix:*)
+ (identifier? #'matrix-mul!))
+ (let* ((dim (syntax->datum #'dimension))
+ (n (* dim dim))
+ (name (format #f "matrix~a" dim)))
+ (define (index row column)
+ (+ (* row dim) column))
+ (define (matrix-map proc)
+ (append-map
+ (lambda (row)
+ (map (lambda (column)
+ (proc row column))
+ (iota dim)))
+ (iota dim)))
+ (define (make-args prefix)
+ (matrix-map
+ (lambda (row column)
+ (datum->syntax #f (string->symbol
+ (format #f "~a:~a-~a" prefix row column))))))
+ (let ((args (make-args 'e)))
+ #`(begin
+ (define-bytestruct <matrix> (array #,n f32)
+ #:printer
+ (lambda (m port)
+ (display "#<" port)
+ (display #,name port)
+ #,@(map (lambda (i)
+ #`(let ((x (bytestruct-ref <matrix> (#,i) m)))
+ (display " " port)
+ (display x port)))
+ (iota n))
+ (display ">" port)))
+ (define-bytestruct-predicate matrix? <matrix>)
+ (define (matrix=? a b)
+ (bytestruct=? <matrix> a b))
+ (define-inlinable (matrix-init! m #,@args)
+ (match m
+ (($ <matrix> bv offset)
+ (bytestruct-pack!
+ <matrix>
+ #,(map (lambda (i)
+ #`((#,i) #,(list-ref args i)))
+ (iota n))
+ bv offset))))
+ (define-inlinable (matrix-identity! m)
+ #,@(matrix-map
+ (lambda (row column)
+ (let ((i (index row column))
+ (x (if (= row column) 1.0 0.0)))
+ #`(bytestruct-set! <matrix> (#,i) m #,x)))))
+ (define (make-matrix #,@args)
+ (bytestruct-alloc <matrix>
+ #,@(map (lambda (i arg)
+ #`((#,i) #,arg))
+ (iota n) args)))
+ (define (make-null-matrix)
+ (bytestruct-alloc <matrix>))
+ (define (make-identity-matrix)
+ (let ((m (make-null-matrix)))
+ (matrix-identity! m)
+ m))
+ (define (matrix-copy! src dst)
+ (bytestruct-copy! <matrix> src dst))
+ (define (matrix-copy m)
+ (bytestruct-copy <matrix> m))
+ (define-inlinable (matrix-mul! dst a b)
+ #,(let ((args-a (make-args 'a))
+ (args-b (make-args 'b)))
+ #`(match a
+ (($ <matrix> bv-a offset-a)
+ (match b
+ (($ <matrix> bv-b offset-b)
+ (call-with-values
+ (lambda ()
+ (bytestruct-unpack <matrix>
+ #,(map list (iota n))
+ bv-a offset-a))
+ (lambda #,args-a
+ (call-with-values
+ (lambda ()
+ (bytestruct-unpack <matrix>
+ #,(map list (iota n))
+ bv-b offset-b))
+ (lambda #,args-b
+ (matrix-init!
+ dst
+ #,@(matrix-map
+ (lambda (row column)
+ (let ((i (index row column)))
+ #`(+ #,@(map (lambda (column-a row-b)
+ #`(* #,(list-ref args-a
+ (index row column-a))
+ #,(list-ref args-b
+ (index row-b column))))
+ (iota dim)
+ (iota dim)))))))))))))))))
+ (define matrix:*
+ (case-lambda
+ (() (make-identity-matrix))
+ ((a) a)
+ ((a b)
+ (let ((dst (make-null-matrix)))
+ (matrix-mul! dst a b)
+ dst))
+ ((a b . rest)
+ (apply matrix:* (matrix:* a b) rest)))))))))))
+
;;;
;;; 3x3 Matrix
;;;
-(define-record-type <matrix3>
- (%make-matrix3 bv)
- matrix3?
- (bv matrix3-bv))
-
-(define-inlinable (matrix3-set! matrix row column x)
- (f32vector-set! matrix (+ (* row 3) column) x))
-
-(define-inlinable (matrix3-ref matrix row column)
- (f32vector-ref matrix (+ (* row 3) column)))
-
-(define (display-matrix3 matrix port)
- (let ((m (matrix3-bv matrix)))
- (format port
- "#<matrix3 [[~f ~f ~f] [~f ~f ~f] [~f ~f ~f]]>"
- (matrix3-ref m 0 0)
- (matrix3-ref m 0 1)
- (matrix3-ref m 0 2)
- (matrix3-ref m 1 0)
- (matrix3-ref m 1 1)
- (matrix3-ref m 1 2)
- (matrix3-ref m 2 0)
- (matrix3-ref m 2 1)
- (matrix3-ref m 2 2))))
-
-(set-record-type-printer! <matrix3> display-matrix3)
-
-(define (init-matrix3 matrix
- aa ab ac
- ba bb bc
- ca cb cc)
- (let ((bv (matrix3-bv matrix)))
- (matrix3-set! bv 0 0 aa)
- (matrix3-set! bv 0 1 ab)
- (matrix3-set! bv 0 2 ac)
- (matrix3-set! bv 1 0 ba)
- (matrix3-set! bv 1 1 bb)
- (matrix3-set! bv 1 2 bc)
- (matrix3-set! bv 2 0 ca)
- (matrix3-set! bv 2 1 cb)
- (matrix3-set! bv 2 2 cc)))
-
-(define (make-null-matrix3)
- (let ((bv (make-bytevector 36)))
- (%make-matrix3 bv)))
-
-(define (make-matrix3 aa ab ac
- ba bb bc
- ca cb cc)
- "Return a new 3x3 matrix initialized with the given 9 values in
-column-major format."
- (let ((matrix (make-null-matrix3)))
- (init-matrix3 matrix
- aa ab ac
- ba bb bc
- ca cb cc)
- matrix))
-
-(define (matrix3= m1 m2)
- "Return #t if M1 is the same matrix as M2"
- (equal? (matrix3-bv m1) (matrix3-bv m2)))
-
-(define (matrix3-copy! src dest)
- "Copy the contents of matrix SRC to DEST."
- (bytevector-copy! (matrix3-bv src) 0 (matrix3-bv dest) 0 36))
-
-(define (matrix3-copy matrix)
- "Return a new 3x3 matrix that is a copy of MATRIX."
- (%make-matrix3 (bytevector-copy (matrix3-bv matrix))))
-
-(define (matrix3-mult! dest a b)
- "Multiply matrices A and B, storing the result in DEST."
- (let ((m1 (matrix3-bv a))
- (m2 (matrix3-bv b))
- (m3 (matrix3-bv dest)))
- (let ((m1-0-0 (matrix3-ref m1 0 0))
- (m1-0-1 (matrix3-ref m1 0 1))
- (m1-0-2 (matrix3-ref m1 0 2))
- (m1-1-0 (matrix3-ref m1 1 0))
- (m1-1-1 (matrix3-ref m1 1 1))
- (m1-1-2 (matrix3-ref m1 1 2))
- (m1-2-0 (matrix3-ref m1 2 0))
- (m1-2-1 (matrix3-ref m1 2 1))
- (m1-2-2 (matrix3-ref m1 2 2))
- (m2-0-0 (matrix3-ref m2 0 0))
- (m2-0-1 (matrix3-ref m2 0 1))
- (m2-0-2 (matrix3-ref m2 0 2))
- (m2-1-0 (matrix3-ref m2 1 0))
- (m2-1-1 (matrix3-ref m2 1 1))
- (m2-1-2 (matrix3-ref m2 1 2))
- (m2-2-0 (matrix3-ref m2 2 0))
- (m2-2-1 (matrix3-ref m2 2 1))
- (m2-2-2 (matrix3-ref m2 2 2)))
- (matrix3-set! m3 0 0
- (+ (* m1-0-0 m2-0-0)
- (* m1-0-1 m2-1-0)
- (* m1-0-2 m2-2-0)))
- (matrix3-set! m3 0 1
- (+ (* m1-0-0 m2-0-1)
- (* m1-0-1 m2-1-1)
- (* m1-0-2 m2-2-1)))
- (matrix3-set! m3 0 2
- (+ (* m1-0-0 m2-0-2)
- (* m1-0-1 m2-1-2)
- (* m1-0-2 m2-2-2)))
- (matrix3-set! m3 1 0
- (+ (* m1-1-0 m2-0-0)
- (* m1-1-1 m2-1-0)
- (* m1-1-2 m2-2-0)))
- (matrix3-set! m3 1 1
- (+ (* m1-1-0 m2-0-1)
- (* m1-1-1 m2-1-1)
- (* m1-1-2 m2-2-1)))
- (matrix3-set! m3 1 2
- (+ (* m1-1-0 m2-0-2)
- (* m1-1-1 m2-1-2)
- (* m1-1-2 m2-2-2)))
- (matrix3-set! m3 2 0
- (+ (* m1-2-0 m2-0-0)
- (* m1-2-1 m2-1-0)
- (* m1-2-2 m2-2-0)))
- (matrix3-set! m3 2 1
- (+ (* m1-2-0 m2-0-1)
- (* m1-2-1 m2-1-1)
- (* m1-2-2 m2-2-1)))
- (matrix3-set! m3 2 2
- (+ (* m1-2-0 m2-0-2)
- (* m1-2-1 m2-1-2)
- (* m1-2-2 m2-2-2))))))
-
-(define (matrix3* . matrices)
- "Return the product of MATRICES."
- (match matrices
- (() (make-identity-matrix3))
- ((a b)
- (let ((result (make-identity-matrix3)))
- (matrix3-mult! result a b)
- result))
- ((first . rest)
- (let loop ((temp (make-identity-matrix3))
- (prev (matrix3-copy first))
- (matrices rest))
- (match matrices
- (() prev)
- ((current . rest)
- (matrix3-mult! temp prev current)
- (loop prev temp rest)))))))
+(define-square-matrix-type (<matrix3> 3)
+ make-matrix3 make-null-matrix3 make-identity-matrix3
+ matrix3? matrix3=
+ matrix3-ref matrix3-set! matrix3-init! matrix3-identity!
+ matrix3-copy matrix3-copy!
+ matrix3* matrix3-mult!)
-(define (matrix3-identity! matrix)
- (init-matrix3 matrix
- 1.0 0.0 0.0
- 0.0 1.0 0.0
- 0.0 0.0 1.0))
-
-(define (make-identity-matrix3)
- (let ((m (make-null-matrix3)))
- (matrix3-identity! m)
- m))
-
-;; matrix3-transform!
(define (matrix3-translate! matrix v)
- (init-matrix3 matrix
- 1.0 0.0 0.0
- 0.0 1.0 0.0
- (vec2-x v) (vec2-y v) 1.0))
+ (matrix3-init! matrix
+ 1.0 0.0 0.0
+ 0.0 1.0 0.0
+ (vec2-x v) (vec2-y v) 1.0))
(define (matrix3-translate v)
(let ((m (make-null-matrix3)))
@@ -263,17 +243,17 @@ column-major format."
m))
(define (matrix3-scale! matrix s)
- (cond
- ((number? s)
- (init-matrix3 matrix
- s 0.0 0.0
- 0.0 s 0.0
- 0.0 0.0 1.0))
- ((vec2? s)
- (init-matrix3 matrix
- (vec2-x s) 0.0 0.0
- 0.0 (vec2-y s) 0.0
- 0.0 0.0 1.0))))
+ (match s
+ ((? real?)
+ (matrix3-init! matrix
+ s 0.0 0.0
+ 0.0 s 0.0
+ 0.0 0.0 1.0))
+ ((? vec2?)
+ (matrix3-init! matrix
+ (vec2-x s) 0.0 0.0
+ 0.0 (vec2-y s) 0.0
+ 0.0 0.0 1.0))))
(define (matrix3-scale s)
(let ((m (make-null-matrix3)))
@@ -283,10 +263,10 @@ column-major format."
(define (matrix3-rotate! matrix angle)
(let ((s (sin angle))
(c (cos angle)))
- (init-matrix3 matrix
- c s 0.0
- (- s) c 0.0
- 0.0 0.0 1.0)))
+ (matrix3-init! matrix
+ c s 0.0
+ (- s) c 0.0
+ 0.0 0.0 1.0)))
(define (matrix3-rotate angle)
(let ((m (make-null-matrix3)))
@@ -294,15 +274,17 @@ column-major format."
m))
(define-inlinable (matrix3-transform! matrix v)
- (let ((bv (matrix3-bv matrix))
- (x (vec2-x v))
+ (let ((x (vec2-x v))
(y (vec2-y v)))
- (set-vec2-x! v (+ (* x (matrix3-ref bv 0 0))
- (* y (matrix3-ref bv 1 0))
- (matrix3-ref bv 2 0)))
- (set-vec2-y! v (+ (* x (matrix3-ref bv 0 1))
- (* y (matrix3-ref bv 1 1))
- (matrix3-ref bv 2 1)))))
+ (call-with-values (lambda ()
+ (match matrix
+ (($ <matrix3> bv offset)
+ (bytestruct-unpack <matrix3>
+ ((0) (1) (3) (4) (6) (7))
+ bv offset))))
+ (lambda (aa ab ba bb ca cb)
+ (set-vec2-x! v (+ (* x aa) (* y ba) ca))
+ (set-vec2-y! v (+ (* x ab) (* y bb) cb))))))
(define (matrix3-transform matrix v)
(let ((new-v (vec2-copy v)))
@@ -314,40 +296,37 @@ column-major format."
;;
;; https://www.wikihow.com/Find-the-Inverse-of-a-3x3-Matrix
(define (matrix3-inverse! matrix target)
- (let* ((bv (matrix3-bv matrix))
- (a (matrix3-ref bv 0 0))
- (b (matrix3-ref bv 0 1))
- (c (matrix3-ref bv 0 2))
- (d (matrix3-ref bv 1 0))
- (e (matrix3-ref bv 1 1))
- (f (matrix3-ref bv 1 2))
- (g (matrix3-ref bv 2 0))
- (h (matrix3-ref bv 2 1))
- (i (matrix3-ref bv 2 2))
- ;; Calculate the determinants of the minor matrices of the
- ;; transpose of the original matrix.
- (a* (- (* e i) (* f h)))
- (b* (- (* b i) (* c h)))
- (c* (- (* b f) (* c e)))
- (d* (- (* d i) (* f g)))
- (e* (- (* a i) (* c g)))
- (f* (- (* a f) (* c d)))
- (g* (- (* d h) (* e g)))
- (h* (- (* a h) (* b g)))
- (i* (- (* a e) (* b d)))
- ;; Determinant and its inverse.
- (det (+ (- (* a a*) (* b d*)) (* c g*)))
- (invdet (/ 1.0 det)))
- ;; If the matrix cannot be inverted (determinant of 0), then just
- ;; bail out by resetting target to the identity matrix.
- (if (= det 0.0)
- (matrix3-identity! target)
- ;; Multiply by the inverse of the determinant to get the final
- ;; inverse matrix. Every other value is inverted.
- (init-matrix3 target
- (* a* invdet) (* (- b*) invdet) (* c* invdet)
- (* (- d*) invdet) (* e* invdet) (* (- f*) invdet)
- (* g* invdet) (* (- h*) invdet) (* i* invdet)))))
+ (call-with-values (lambda ()
+ (match matrix
+ (($ <matrix3> bv offset)
+ (bytestruct-unpack <matrix3>
+ ((0) (1) (2) (3) (4) (5) (6) (7) (8))
+ bv offset))))
+ (lambda (a b c d e f g h i)
+ ;; Calculate the determinants of the minor matrices of the
+ ;; transpose of the original matrix.
+ (let* ((a* (- (* e i) (* f h)))
+ (b* (- (* b i) (* c h)))
+ (c* (- (* b f) (* c e)))
+ (d* (- (* d i) (* f g)))
+ (e* (- (* a i) (* c g)))
+ (f* (- (* a f) (* c d)))
+ (g* (- (* d h) (* e g)))
+ (h* (- (* a h) (* b g)))
+ (i* (- (* a e) (* b d)))
+ ;; Determinant and its inverse.
+ (det (+ (- (* a a*) (* b d*)) (* c g*)))
+ (invdet (/ 1.0 det)))
+ ;; If the matrix cannot be inverted (determinant of 0), then just
+ ;; bail out by resetting target to the identity matrix.
+ (if (= det 0.0)
+ (matrix3-identity! target)
+ ;; Multiply by the inverse of the determinant to get the final
+ ;; inverse matrix. Every other value is inverted.
+ (matrix3-init! target
+ (* a* invdet) (* (- b*) invdet) (* c* invdet)
+ (* (- d*) invdet) (* e* invdet) (* (- f*) invdet)
+ (* g* invdet) (* (- h*) invdet) (* i* invdet)))))))
(define (matrix3-inverse matrix)
"Return the inverse of MATRIX."
@@ -360,242 +339,12 @@ column-major format."
;;; 4x4 Matrix
;;;
-(define-record-type <matrix4>
- (%make-matrix4 bv ptr)
- matrix4?
- (bv matrix4-bv)
- (ptr matrix4-ptr))
-
-(define-inlinable (matrix4-set! matrix row column x)
- (f32vector-set! matrix (+ (* row 4) column) x))
-
-(define-inlinable (matrix4-ref matrix row column)
- (f32vector-ref matrix (+ (* row 4) column)))
-
-(define (display-matrix4 matrix port)
- (let ((m (matrix4-bv matrix)))
- (format port
- "#<matrix4 [[~f ~f ~f ~f] [~f ~f ~f ~f] [~f ~f ~f ~f] [~f ~f ~f ~f]]>"
- (matrix4-ref m 0 0)
- (matrix4-ref m 0 1)
- (matrix4-ref m 0 2)
- (matrix4-ref m 0 3)
- (matrix4-ref m 1 0)
- (matrix4-ref m 1 1)
- (matrix4-ref m 1 2)
- (matrix4-ref m 1 3)
- (matrix4-ref m 2 0)
- (matrix4-ref m 2 1)
- (matrix4-ref m 2 2)
- (matrix4-ref m 2 3)
- (matrix4-ref m 3 0)
- (matrix4-ref m 3 1)
- (matrix4-ref m 3 2)
- (matrix4-ref m 3 3))))
-
-(set-record-type-printer! <matrix4> display-matrix4)
-
-(define (init-matrix4 matrix
- aa ab ac ad
- ba bb bc bd
- ca cb cc cd
- da db dc dd)
- (let ((bv (matrix4-bv matrix)))
- (matrix4-set! bv 0 0 aa)
- (matrix4-set! bv 0 1 ab)
- (matrix4-set! bv 0 2 ac)
- (matrix4-set! bv 0 3 ad)
- (matrix4-set! bv 1 0 ba)
- (matrix4-set! bv 1 1 bb)
- (matrix4-set! bv 1 2 bc)
- (matrix4-set! bv 1 3 bd)
- (matrix4-set! bv 2 0 ca)
- (matrix4-set! bv 2 1 cb)
- (matrix4-set! bv 2 2 cc)
- (matrix4-set! bv 2 3 cd)
- (matrix4-set! bv 3 0 da)
- (matrix4-set! bv 3 1 db)
- (matrix4-set! bv 3 2 dc)
- (matrix4-set! bv 3 3 dd)))
-
-(define (make-null-matrix4)
- (let ((bv (make-bytevector 64)))
- (%make-matrix4 bv (bytevector->pointer bv))))
-
-(define (make-matrix4 aa ab ac ad
- ba bb bc bd
- ca cb cc cd
- da db dc dd)
- "Return a new 4x4 matrix initialized with the given 16 values in
-column-major format."
- (let ((matrix (make-null-matrix4)))
- (init-matrix4 matrix
- aa ab ac ad
- ba bb bc bd
- ca cb cc cd
- da db dc dd)
- matrix))
-
-(define (matrix4= m1 m2)
- "Return #t if M1 is the same matrix as M2"
- (equal? (matrix4-bv m1) (matrix4-bv m2)))
-
-(define (matrix4-copy! src dest)
- "Copy the contents of matrix SRC to DEST."
- (bytevector-copy! (matrix4-bv src) 0 (matrix4-bv dest) 0 64))
-
-(define (matrix4-copy matrix)
- "Return a new 4x4 matrix that is a copy of MATRIX."
- (let ((bv (bytevector-copy (matrix4-bv matrix))))
- (%make-matrix4 bv (bytevector->pointer bv))))
-
-(define (matrix4-mult! dest a b)
- "Multiply matrices A and B, storing the result in DEST."
- (let ((m1 (matrix4-bv a))
- (m2 (matrix4-bv b))
- (m3 (matrix4-bv dest)))
- (let ((m1-0-0 (matrix4-ref m1 0 0))
- (m1-0-1 (matrix4-ref m1 0 1))
- (m1-0-2 (matrix4-ref m1 0 2))
- (m1-0-3 (matrix4-ref m1 0 3))
- (m1-1-0 (matrix4-ref m1 1 0))
- (m1-1-1 (matrix4-ref m1 1 1))
- (m1-1-2 (matrix4-ref m1 1 2))
- (m1-1-3 (matrix4-ref m1 1 3))
- (m1-2-0 (matrix4-ref m1 2 0))
- (m1-2-1 (matrix4-ref m1 2 1))
- (m1-2-2 (matrix4-ref m1 2 2))
- (m1-2-3 (matrix4-ref m1 2 3))
- (m1-3-0 (matrix4-ref m1 3 0))
- (m1-3-1 (matrix4-ref m1 3 1))
- (m1-3-2 (matrix4-ref m1 3 2))
- (m1-3-3 (matrix4-ref m1 3 3))
- (m2-0-0 (matrix4-ref m2 0 0))
- (m2-0-1 (matrix4-ref m2 0 1))
- (m2-0-2 (matrix4-ref m2 0 2))
- (m2-0-3 (matrix4-ref m2 0 3))
- (m2-1-0 (matrix4-ref m2 1 0))
- (m2-1-1 (matrix4-ref m2 1 1))
- (m2-1-2 (matrix4-ref m2 1 2))
- (m2-1-3 (matrix4-ref m2 1 3))
- (m2-2-0 (matrix4-ref m2 2 0))
- (m2-2-1 (matrix4-ref m2 2 1))
- (m2-2-2 (matrix4-ref m2 2 2))
- (m2-2-3 (matrix4-ref m2 2 3))
- (m2-3-0 (matrix4-ref m2 3 0))
- (m2-3-1 (matrix4-ref m2 3 1))
- (m2-3-2 (matrix4-ref m2 3 2))
- (m2-3-3 (matrix4-ref m2 3 3)))
- (matrix4-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)))
- (matrix4-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)))
- (matrix4-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)))
- (matrix4-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)))
- (matrix4-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)))
- (matrix4-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)))
- (matrix4-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)))
- (matrix4-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)))
- (matrix4-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)))
- (matrix4-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)))
- (matrix4-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)))
- (matrix4-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)))
- (matrix4-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)))
- (matrix4-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)))
- (matrix4-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)))
- (matrix4-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 (matrix4* . matrices)
- "Return the product of MATRICES."
- (match matrices
- (() (make-identity-matrix4))
- ((a b)
- (let ((result (make-identity-matrix4)))
- (matrix4-mult! result a b)
- result))
- ((first . rest)
- (let loop ((temp (make-identity-matrix4))
- (prev (matrix4-copy first))
- (matrices rest))
- (match matrices
- (() prev)
- ((current . rest)
- (matrix4-mult! temp prev current)
- (loop prev temp rest)))))))
-
-(define (matrix4-identity! matrix)
- (init-matrix4 matrix
- 1.0 0.0 0.0 0.0
- 0.0 1.0 0.0 0.0
- 0.0 0.0 1.0 0.0
- 0.0 0.0 0.0 1.0))
-
-(define (make-identity-matrix4)
- (let ((matrix (make-null-matrix4)))
- (matrix4-identity! matrix)
- matrix))
+(define-square-matrix-type (<matrix4> 4)
+ make-matrix4 make-null-matrix4 make-identity-matrix4
+ matrix4? matrix4=
+ matrix4-ref matrix4-set! matrix4-init! matrix4-identity!
+ matrix4-copy matrix4-copy!
+ matrix4* matrix4-mult!)
;; Dear reader (potentially my future self),
;;
@@ -619,128 +368,121 @@ column-major format."
(+ (* a (- (* e i) (* f h)))
(- (* b (- (* d i) (* f g))))
(* c (- (* d h) (* e g)))))
- (let* ((bv (matrix4-bv matrix))
- ;; Every element of the original matrix gets a letter:
- ;;
- ;; a b c d
- ;; e f g h
- ;; i j k l
- ;; m n o p
- (a (matrix4-ref bv 0 0))
- (b (matrix4-ref bv 0 1))
- (c (matrix4-ref bv 0 2))
- (d (matrix4-ref bv 0 3))
- (e (matrix4-ref bv 1 0))
- (f (matrix4-ref bv 1 1))
- (g (matrix4-ref bv 1 2))
- (h (matrix4-ref bv 1 3))
- (i (matrix4-ref bv 2 0))
- (j (matrix4-ref bv 2 1))
- (k (matrix4-ref bv 2 2))
- (l (matrix4-ref bv 2 3))
- (m (matrix4-ref bv 3 0))
- (n (matrix4-ref bv 3 1))
- (o (matrix4-ref bv 3 2))
- (p (matrix4-ref bv 3 3))
- ;; Calculate the determinants of the minor matrices of the
- ;; transpose of the original matrix:
- ;;
- ;; a e i m
- ;; b f j n
- ;; c g k o
- ;; d h l p
- ;;
- ;; A minor matrix is created by a picking an element of the
- ;; original matrix and eliminating its row and column. The
- ;; remaining 9 elements form a 3x3 minor matrix. There are
- ;; 16 of them:
- ;;
- ;; a------ --e---- ----i-- ------m
- ;; | f j n b | j n b f | n b f j |
- ;; | g k o c | k o c g | o c g k |
- ;; | h l p d | l p d h | p d h l |
- ;;
- ;; | e i m a | i m a e | m a e i |
- ;; b------ --f---- ----j-- ------n
- ;; | g k o c | k o c g | o c g k |
- ;; | h l p d | l p d h | p d h l |
- ;;
- ;; | e i m a | i m a e | m a e i |
- ;; | f j n b | j n b f | n b f j |
- ;; c------ --g---- ----k-- ------o
- ;; | h l p d | l p d h | p d h l |
- ;;
- ;; | e i m a | i m a e | m a e i |
- ;; | f j n b | j n b f | n b f j |
- ;; | g k o c | k o c g | o c g k |
- ;; d------ --h---- ----l-- ------p
- ;;
- ;; The determinant of each 3x3 minor matrix is the
- ;; combination of the determinants of the 3 2x2 minor-minor
- ;; matrices within.
- ;;
- ;; I'll show just one of these for brevity's sake:
- ;;
- ;; f j n f---- --j-- ----n
- ;; g k o -> | k o g | o g k |
- ;; h l p | l p h | p h l |
- ;;
- ;; So the determinant for this 3x3 minor matrix is:
- ;;
- ;; f(kp - ol) - j(gp - oh) + n(gl - kh)
- ;;
- ;; The 3x3-determinant helper function takes care of this for
- ;; all the minor matrices.
- ;;
- ;; From these values we create a new matrix of determinants.
- ;; These matrix elements are given letters, too, but with
- ;; asterisks at the end because they are more fun:
- ;;
- ;; a* b* c* d*
- ;; e* f* g* h*
- ;; i* j* k* l*
- ;; m* n* o* p*
- (a* (3x3-determinant f j n g k o h l p))
- (b* (3x3-determinant b j n c k o d l p))
- (c* (3x3-determinant b f n c g o d h p))
- (d* (3x3-determinant b f j c g k d h l))
- (e* (3x3-determinant e i m g k o h l p))
- (f* (3x3-determinant a i m c k o d l p))
- (g* (3x3-determinant a e m c g o d h p))
- (h* (3x3-determinant a e i c g k d h l))
- (i* (3x3-determinant e i m f j n h l p))
- (j* (3x3-determinant a i m b j n d l p))
- (k* (3x3-determinant a e m b f n d h p))
- (l* (3x3-determinant a e i b f j d h l))
- (m* (3x3-determinant e i m f j n g k o))
- (n* (3x3-determinant a i m b j n c k o))
- (o* (3x3-determinant a e m b f n c g o))
- (p* (3x3-determinant a e i b f j c h k))
- ;; Now we can calculate the determinant of the original
- ;; matrix using the determinants of minor matrices calculated
- ;; earlier. The only trick here is that we used a transposed
- ;; matrix before, so the determinant of the minor matrix of
- ;; 'd' in the original matrix has been assigned the name
- ;; 'm*', and so on.
- (det (+ (* a a*) (- (* b e*)) (* c i*) (- (* d m*))))
- (invdet (/ 1.0 det)))
- ;; If the matrix cannot be inverted (determinant of 0), then just
- ;; bail out by resetting target to the identity matrix.
- (if (= det 0.0)
- (matrix4-identity! target)
- ;; Multiply each element of the adjugate matrix by the inverse
- ;; of the determinant to get the final inverse matrix. Half
- ;; of the values are inverted to form the adjugate matrix:
- ;;
- ;; + - + - +a* -b* +c* -d*
- ;; - + - + -> -e* +f* -g* +h*
- ;; + - + - +i* -j* +k* -l*
- ;; - + - + -m* +n* -o* +p*
- (init-matrix4 target
- (* a* invdet) (* (- b*) invdet) (* c* invdet) (* (- d*) invdet)
- (* (- e*) invdet) (* f* invdet) (* (- g*) invdet) (* h* invdet)
- (* i* invdet) (* (- j*) invdet) (* k* invdet) (* (- l*) invdet)
- (* (- m*) invdet) (* n* invdet) (* (- o*) invdet) (* p* invdet)))))
+ ;; Every element of the original matrix gets a letter:
+ ;;
+ ;; a b c d
+ ;; e f g h
+ ;; i j k l
+ ;; m n o p
+ (call-with-values (lambda ()
+ (match matrix
+ (($ <matrix4> bv offset)
+ (bytestruct-unpack <matrix4>
+ ((0) (1) (2) (3)
+ (4) (5) (6) (7)
+ (8) (9) (10) (11)
+ (12) (13) (14) (15))
+ bv offset))))
+ (lambda (a b c d e f g h i j k l m n o p)
+ ;; Calculate the determinants of the minor matrices of the
+ ;; transpose of the original matrix:
+ ;;
+ ;; a e i m
+ ;; b f j n
+ ;; c g k o
+ ;; d h l p
+ ;;
+ ;; A minor matrix is created by a picking an element of the
+ ;; original matrix and eliminating its row and column. The
+ ;; remaining 9 elements form a 3x3 minor matrix. There are 16
+ ;; of them:
+ ;;
+
+ ;; a------ --e---- ----i-- ------m
+ ;; | f j n b | j n b f | n b f j |
+ ;; | g k o c | k o c g | o c g k |
+ ;; | h l p d | l p d h | p d h l |
+ ;;
+ ;; | e i m a | i m a e | m a e i |
+ ;; b------ --f---- ----j-- ------n
+ ;; | g k o c | k o c g | o c g k |
+ ;; | h l p d | l p d h | p d h l |
+ ;;
+ ;; | e i m a | i m a e | m a e i |
+ ;; | f j n b | j n b f | n b f j |
+ ;; c------ --g---- ----k-- ------o
+ ;; | h l p d | l p d h | p d h l |
+ ;;
+ ;; | e i m a | i m a e | m a e i |
+ ;; | f j n b | j n b f | n b f j |
+ ;; | g k o c | k o c g | o c g k |
+ ;; d------ --h---- ----l-- ------p
+ ;;
+ ;; The determinant of each 3x3 minor matrix is the combination
+ ;; of the determinants of the 3 2x2 minor-minor matrices within.
+ ;;
+ ;; I'll show just one of these for brevity's sake:
+ ;;
+ ;; f j n f---- --j-- ----n
+ ;; g k o -> | k o g | o g k |
+ ;; h l p | l p h | p h l |
+ ;;
+ ;; So the determinant for this 3x3 minor matrix is:
+ ;;
+ ;; f(kp - ol) - j(gp - oh) + n(gl - kh)
+ ;;
+ ;; The 3x3-determinant helper function takes care of this for
+ ;; all the minor matrices.
+ ;;
+ ;; From these values we create a new matrix of determinants.
+ ;; These matrix elements are given letters, too, but with
+ ;; asterisks at the end because they are more fun:
+ ;;
+ ;; a* b* c* d*
+ ;; e* f* g* h*
+ ;; i* j* k* l*
+ ;; m* n* o* p*
+ (let* ((a* (3x3-determinant f j n g k o h l p))
+ (b* (3x3-determinant b j n c k o d l p))
+ (c* (3x3-determinant b f n c g o d h p))
+ (d* (3x3-determinant b f j c g k d h l))
+ (e* (3x3-determinant e i m g k o h l p))
+ (f* (3x3-determinant a i m c k o d l p))
+ (g* (3x3-determinant a e m c g o d h p))
+ (h* (3x3-determinant a e i c g k d h l))
+ (i* (3x3-determinant e i m f j n h l p))
+ (j* (3x3-determinant a i m b j n d l p))
+ (k* (3x3-determinant a e m b f n d h p))
+ (l* (3x3-determinant a e i b f j d h l))
+ (m* (3x3-determinant e i m f j n g k o))
+ (n* (3x3-determinant a i m b j n c k o))
+ (o* (3x3-determinant a e m b f n c g o))
+ (p* (3x3-determinant a e i b f j c h k))
+ ;; Now we can calculate the determinant of the original
+ ;; matrix using the determinants of minor matrices calculated
+ ;; earlier. The only trick here is that we used a transposed
+ ;; matrix before, so the determinant of the minor matrix of
+ ;; 'd' in the original matrix has been assigned the name
+ ;; 'm*', and so on.
+ (det (+ (* a a*) (- (* b e*)) (* c i*) (- (* d m*))))
+ (invdet (/ 1.0 det)))
+ ;; If the matrix cannot be inverted (determinant of 0), then just
+ ;; bail out by resetting target to the identity matrix.
+ (if (= det 0.0)
+ (matrix4-identity! target)
+ ;; Multiply each element of the adjugate matrix by the inverse
+ ;; of the determinant to get the final inverse matrix. Half
+ ;; of the values are inverted to form the adjugate matrix:
+ ;;
+ ;; + - + - +a* -b* +c* -d*
+ ;; - + - + -> -e* +f* -g* +h*
+ ;; + - + - +i* -j* +k* -l*
+ ;; - + - + -m* +n* -o* +p*
+ (matrix4-init! target
+ (* a* invdet) (* (- b*) invdet) (* c* invdet) (* (- d*) invdet)
+ (* (- e*) invdet) (* f* invdet) (* (- g*) invdet) (* h* invdet)
+ (* i* invdet) (* (- j*) invdet) (* k* invdet) (* (- l*) invdet)
+ (* (- m*) invdet) (* n* invdet) (* (- o*) invdet) (* p* invdet)))))))
(define (matrix4-inverse matrix)
"Return the inverse of MATRIX."
@@ -749,14 +491,14 @@ column-major format."
new-matrix))
(define (orthographic-projection! matrix left right top bottom near far)
- (init-matrix4 matrix
- (/ 2 (- right left)) 0.0 0.0 0.0
- 0.0 (/ 2 (- top bottom)) 0.0 0.0
- 0.0 0.0 (/ 2 (- far near)) 0.0
- (- (/ (+ right left) (- right left)))
- (- (/ (+ top bottom) (- top bottom)))
- (- (/ (+ far near) (- far near)))
- 1.0))
+ (matrix4-init! matrix
+ (/ 2 (- right left)) 0.0 0.0 0.0
+ 0.0 (/ 2 (- top bottom)) 0.0 0.0
+ 0.0 0.0 (/ 2 (- far near)) 0.0
+ (- (/ (+ right left) (- right left)))
+ (- (/ (+ top bottom) (- top bottom)))
+ (- (/ (+ far near) (- far near)))
+ 1.0))
(define (orthographic-projection left right top bottom near far)
"Return a new matrix4 that represents an orthographic projection for
@@ -768,11 +510,11 @@ plane TOP and BOTTOM, and the depth clipping plane NEAR and FAR."
(define (perspective-projection! matrix field-of-vision aspect-ratio near far)
(let ((f (cotan (/ field-of-vision 2))))
- (init-matrix4 matrix
- (/ f aspect-ratio) 0 0 0
- 0 f 0 0
- 0 0 (/ (+ far near) (- near far)) -1
- 0 0 (/ (* 2 far near) (- near far)) 0)))
+ (matrix4-init! matrix
+ (/ f aspect-ratio) 0 0 0
+ 0 f 0 0
+ 0 0 (/ (+ far near) (- near far)) -1
+ 0 0 (/ (* 2 far near) (- near far)) 0)))
(define (perspective-projection field-of-vision aspect-ratio near far)
"Return a new matrix4 that represents a perspective projection with
@@ -787,14 +529,14 @@ clipping plane NEAR and FAR."
(let* ((zaxis (vec3-normalize (vec3- at eye)))
(xaxis (vec3-normalize (vec3-cross zaxis (vec3-normalize up))))
(yaxis (vec3-cross xaxis zaxis)))
- (init-matrix4 matrix
- (vec3-x xaxis) (vec3-x yaxis) (- (vec3-x zaxis)) 0.0
- (vec3-y xaxis) (vec3-y yaxis) (- (vec3-y zaxis)) 0.0
- (vec3-z xaxis) (vec3-z yaxis) (- (vec3-z zaxis)) 0.0
- (- (vec3-dot xaxis eye))
- (- (vec3-dot yaxis eye))
- (vec3-dot zaxis eye)
- 1.0)))
+ (matrix4-init! matrix
+ (vec3-x xaxis) (vec3-x yaxis) (- (vec3-x zaxis)) 0.0
+ (vec3-y xaxis) (vec3-y yaxis) (- (vec3-y zaxis)) 0.0
+ (vec3-z xaxis) (vec3-z yaxis) (- (vec3-z zaxis)) 0.0
+ (- (vec3-dot xaxis eye))
+ (- (vec3-dot yaxis eye))
+ (vec3-dot zaxis eye)
+ 1.0)))
(define (look-at eye at up)
"Return a new matrix4 that looks toward the position AT from the
@@ -806,23 +548,23 @@ position EYE, with the top of the viewport facing UP."
(define (matrix4-translate! matrix v)
(cond
((vec2? v)
- (init-matrix4 matrix
- 1.0 0.0 0.0 0.0
- 0.0 1.0 0.0 0.0
- 0.0 0.0 1.0 0.0
- (vec2-x v) (vec2-y v) 0.0 1.0))
+ (matrix4-init! matrix
+ 1.0 0.0 0.0 0.0
+ 0.0 1.0 0.0 0.0
+ 0.0 0.0 1.0 0.0
+ (vec2-x v) (vec2-y v) 0.0 1.0))
((rect? v)
- (init-matrix4 matrix
- 1.0 0.0 0.0 0.0
- 0.0 1.0 0.0 0.0
- 0.0 0.0 1.0 0.0
- (rect-x v) (rect-y v) 0.0 1.0))
+ (matrix4-init! matrix
+ 1.0 0.0 0.0 0.0
+ 0.0 1.0 0.0 0.0
+ 0.0 0.0 1.0 0.0
+ (rect-x v) (rect-y v) 0.0 1.0))
((vec3? v)
- (init-matrix4 matrix
- 1.0 0.0 0.0 0.0
- 0.0 1.0 0.0 0.0
- 0.0 0.0 1.0 0.0
- (vec3-x v) (vec3-y v) (vec3-z v) 1.0))))
+ (matrix4-init! matrix
+ 1.0 0.0 0.0 0.0
+ 0.0 1.0 0.0 0.0
+ 0.0 0.0 1.0 0.0
+ (vec3-x v) (vec3-y v) (vec3-z v) 1.0))))
(define (matrix4-translate v)
(let ((matrix (make-null-matrix4)))
@@ -834,16 +576,16 @@ position EYE, with the top of the viewport facing UP."
(let ((x (vec3-x s))
(y (vec3-y s))
(z (vec3-z s)))
- (init-matrix4 matrix
- x 0.0 0.0 0.0
- 0.0 y 0.0 0.0
- 0.0 0.0 z 0.0
- 0.0 0.0 0.0 1.0))
- (init-matrix4 matrix
- s 0.0 0.0 0.0
- 0.0 s 0.0 0.0
- 0.0 0.0 s 0.0
- 0.0 0.0 0.0 1.0)))
+ (matrix4-init! matrix
+ x 0.0 0.0 0.0
+ 0.0 y 0.0 0.0
+ 0.0 0.0 z 0.0
+ 0.0 0.0 0.0 1.0))
+ (matrix4-init! matrix
+ s 0.0 0.0 0.0
+ 0.0 s 0.0 0.0
+ 0.0 0.0 s 0.0
+ 0.0 0.0 0.0 1.0)))
(define (matrix4-scale s)
(let ((matrix (make-null-matrix4)))
@@ -862,23 +604,23 @@ position EYE, with the top of the viewport facing UP."
(z (quaternion-z q))
(w (quaternion-w q))
(n (/ 2.0 (+ (* x x) (* y y) (* z z) (* w w)))))
- (init-matrix4 matrix
- (- 1.0 (* n y y) (* n z z))
- (- (* n x y) (* n z w))
- (+ (* n x z) (* n y w))
- 0.0
- (+ (* n x y) (* n z w))
- (- 1.0 (* n x x) (* n z z))
- (- (* n y z) (* n x w))
- 0.0
- (- (* n x z) (* n y w))
- (+ (* n y z) (* n x w))
- (- 1.0 (* n x x) (* n y y))
- 0.0
- 0.0
- 0.0
- 0.0
- 1.0)))
+ (matrix4-init! matrix
+ (- 1.0 (* n y y) (* n z z))
+ (- (* n x y) (* n z w))
+ (+ (* n x z) (* n y w))
+ 0.0
+ (+ (* n x y) (* n z w))
+ (- 1.0 (* n x x) (* n z z))
+ (- (* n y z) (* n x w))
+ 0.0
+ (- (* n x z) (* n y w))
+ (+ (* n y z) (* n x w))
+ (- 1.0 (* n x x) (* n y y))
+ 0.0
+ 0.0
+ 0.0
+ 0.0
+ 1.0)))
(define (matrix4-rotate q)
(let ((matrix (make-null-matrix4)))
@@ -888,11 +630,11 @@ position EYE, with the top of the viewport facing UP."
(define (matrix4-rotate-x! matrix angle)
(let ((c (cos angle))
(s (sin angle)))
- (init-matrix4 matrix
- 1.0 0.0 0.0 0.0
- 0.0 c (- s) 0.0
- 0.0 s c 0.0
- 0.0 0.0 0.0 1.0)))
+ (matrix4-init! matrix
+ 1.0 0.0 0.0 0.0
+ 0.0 c (- s) 0.0
+ 0.0 s c 0.0
+ 0.0 0.0 0.0 1.0)))
(define (matrix4-rotate-x angle)
"Return a new matrix that rotates about the X axis by ANGLE radians."
@@ -903,11 +645,11 @@ position EYE, with the top of the viewport facing UP."
(define (matrix4-rotate-y! matrix angle)
(let ((c (cos angle))
(s (sin angle)))
- (init-matrix4 matrix
- c 0.0 (- s) 0.0
- 0.0 1.0 0.0 0.0
- s 0.0 c 0.0
- 0.0 0.0 0.0 1.0)))
+ (matrix4-init! matrix
+ c 0.0 (- s) 0.0
+ 0.0 1.0 0.0 0.0
+ s 0.0 c 0.0
+ 0.0 0.0 0.0 1.0)))
(define (matrix4-rotate-y angle)
"Return a new matrix that rotates about the Y axis by ANGLE radians."
@@ -918,11 +660,11 @@ position EYE, with the top of the viewport facing UP."
(define (matrix4-rotate-z! matrix angle)
(let ((c (cos angle))
(s (sin angle)))
- (init-matrix4 matrix
- c (- s) 0.0 0.0
- s c 0.0 0.0
- 0.0 0.0 1.0 0.0
- 0.0 0.0 0.0 1.0)))
+ (matrix4-init! matrix
+ c (- s) 0.0 0.0
+ s c 0.0 0.0
+ 0.0 0.0 1.0 0.0
+ 0.0 0.0 0.0 1.0)))
(define (matrix4-rotate-z angle)
"Return a new matrix that rotates the Z axis by ANGLE radians."
@@ -944,8 +686,9 @@ position EYE, with the top of the viewport facing UP."
vector or rect, ROTATION, a scalar representing a rotation about the Z
axis, SCALE, a 2D vector, and SHEAR, a 2D vector. The transformation
happens with respect to ORIGIN, a 2D vector."
- (let* ((bv (matrix4-bv matrix))
- (x (vec2-x position))
+ (unless (real? rotation)
+ (error "expected real number for rotation" rotation))
+ (let* ((x (vec2-x position))
(y (vec2-y position))
(ox (vec2-x origin))
(oy (vec2-y origin))
@@ -959,56 +702,69 @@ happens with respect to ORIGIN, a 2D vector."
(r (+ (* s sx) (* c sy ky)))
(s (- (* c sx kx) (* s sy)))
(t (* c sy)))
- (bytevector-fill! bv 0)
- (f32vector-set! bv 0 q)
- (f32vector-set! bv 1 r)
- (f32vector-set! bv 4 s)
- (f32vector-set! bv 5 t)
- (f32vector-set! bv 10 1.0)
- (f32vector-set! bv 12 (- x (* ox q) (* oy s)))
- (f32vector-set! bv 13 (- y (* ox r) (* oy t)))
- (f32vector-set! bv 15 1.0)))
+ (matrix4-init! matrix
+ q r 0.0 0.0
+ s t 0.0 0.0
+ 0.0 0.0 1.0 0.0
+ (- x (* ox q) (* oy s))
+ (- y (* ox r) (* oy t))
+ 0.0 1.0)))
+
+(lambda (bv angle)
+ (unless (and (real? angle) (inexact? angle))
+ (error "expected inexact real" angle))
+ (f32vector-set! bv 0 (cos angle)))
(define-inlinable (matrix4-transform-x matrix x y)
- (let ((bv (matrix4-bv matrix)))
- (+ (* x (matrix4-ref bv 0 0))
- (* y (matrix4-ref bv 1 0))
- (matrix4-ref bv 3 0))))
+ (call-with-values (lambda ()
+ (match matrix
+ (($ <matrix4> bv offset)
+ (bytestruct-unpack <matrix4>
+ ((0) (4) (12))
+ bv offset))))
+ (lambda (aa ba da)
+ (+ (* x aa) (* y ba) da))))
(define-inlinable (matrix4-transform-y matrix x y)
- (let ((bv (matrix4-bv matrix)))
- (+ (* x (matrix4-ref bv 0 1))
- (* y (matrix4-ref bv 1 1))
- (matrix4-ref bv 3 1))))
+ (call-with-values (lambda ()
+ (match matrix
+ (($ <matrix4> bv offset)
+ (bytestruct-unpack <matrix4>
+ ((1) (5) (13))
+ bv offset))))
+ (lambda (ab bb db)
+ (+ (* x ab) (* y bb) db))))
(define-inlinable (matrix4-transform-vec2! matrix v)
- (let ((bv (matrix4-bv matrix))
- (x (vec2-x v))
- (y (vec2-y v)))
- (set-vec2-x! v (+ (* x (matrix4-ref bv 0 0))
- (* y (matrix4-ref bv 1 0))
- (matrix4-ref bv 3 0)))
- (set-vec2-y! v (+ (* x (matrix4-ref bv 0 1))
- (* y (matrix4-ref bv 1 1))
- (matrix4-ref bv 3 1)))))
+ (call-with-values (lambda ()
+ (match matrix
+ (($ <matrix4> bv offset)
+ (bytestruct-unpack <matrix4>
+ ((0) (1) (4) (5) (12) (13))
+ bv offset))))
+ (lambda (aa ab ba bb da db)
+ (let ((x (vec2-x v))
+ (y (vec2-y v)))
+ (set-vec2-x! v (+ (* x aa) (* y ba) da))
+ (set-vec2-y! v (+ (* x ab) (* y bb) db))))))
(define-inlinable (matrix4-transform-vec3! matrix v)
- (let ((bv (matrix4-bv matrix))
- (x (vec3-x v))
- (y (vec3-y v))
- (z (vec3-z v)))
- (set-vec3-x! v (+ (* x (matrix4-ref bv 0 0))
- (* y (matrix4-ref bv 1 0))
- (* z (matrix4-ref bv 2 0))
- (matrix4-ref bv 3 0)))
- (set-vec3-y! v (+ (* x (matrix4-ref bv 0 1))
- (* y (matrix4-ref bv 1 1))
- (* z (matrix4-ref bv 2 1))
- (matrix4-ref bv 3 1)))
- (set-vec3-z! v (+ (* x (matrix4-ref bv 0 2))
- (* y (matrix4-ref bv 1 2))
- (* z (matrix4-ref bv 2 2))
- (matrix4-ref bv 3 2)))))
+ (call-with-values (lambda ()
+ (match matrix
+ (($ <matrix4> bv offset)
+ (bytestruct-unpack <matrix4>
+ ((0) (1) (2)
+ (4) (5) (6)
+ (8) (9) (10)
+ (12) (13) (14))
+ bv offset))))
+ (lambda (aa ab ac ba bb bc ca cb cc da db dc)
+ (let ((x (vec3-x v))
+ (y (vec3-y v))
+ (z (vec3-z v)))
+ (set-vec3-x! v (+ (* x aa) (* y ba) (* z ca) da))
+ (set-vec3-y! v (+ (* x ab) (* y bb) (* z cb) db))
+ (set-vec3-z! v (+ (* x ac) (* y bc) (* z cc) dc))))))
(define-inlinable (matrix4-transform-vec2 matrix v)
(let ((new-v (vec2-copy v)))
@@ -1021,10 +777,10 @@ happens with respect to ORIGIN, a 2D vector."
new-v))
(define-inlinable (matrix4-x matrix)
- (matrix4-ref (matrix4-bv matrix) 3 0))
+ (bytestruct-ref <matrix4> (12) matrix))
(define-inlinable (matrix4-y matrix)
- (matrix4-ref (matrix4-bv matrix) 3 1))
+ (bytestruct-ref <matrix4> (13) matrix))
(define-inlinable (matrix4-z matrix)
- (matrix4-ref (matrix4-bv matrix) 3 2))
+ (bytestruct-ref <matrix4> (14) matrix))