diff options
| -rw-r--r-- | chickadee/graphics/shader.scm | 18 | ||||
| -rw-r--r-- | chickadee/math/matrix.scm | 1166 |
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)) |