diff options
author | David Thompson <dthompson2@worcester.edu> | 2024-01-30 14:39:11 -0500 |
---|---|---|
committer | David Thompson <dthompson2@worcester.edu> | 2024-02-22 08:11:29 -0500 |
commit | 3ab58897635d15a36b707e41ecacca77348fe5f2 (patch) | |
tree | 30f869b0eac7ecf6082dd0efe91aee754ce9a881 | |
parent | 3d7648b95385221741155b976477336acde6127f (diff) |
math: Convert quaternion to bytestruct.
-rw-r--r-- | chickadee/math/quaternion.scm | 64 |
1 files changed, 11 insertions, 53 deletions
diff --git a/chickadee/math/quaternion.scm b/chickadee/math/quaternion.scm index 064a648..17a9810 100644 --- a/chickadee/math/quaternion.scm +++ b/chickadee/math/quaternion.scm @@ -20,6 +20,7 @@ ;;; Code: (define-module (chickadee math quaternion) + #:use-module (chickadee data bytestruct) #:use-module (chickadee math) #:use-module (chickadee math vector) #:use-module (ice-9 format) @@ -28,45 +29,27 @@ #:use-module (system foreign) #:export (quaternion quaternion? - quaternion-w quaternion-x quaternion-y quaternion-z + quaternion-w make-identity-quaternion rotation->quaternion)) -(define-record-type <quaternion> - (wrap-quaternion bv pointer) +;; Should this even be its own type? Should probably just be a +;; generic 4D vector. +(define-byterecord-type <quaternion> + (quaternion x y z w) quaternion? - (bv unwrap-quaternion) - (pointer quaternion-pointer set-quaternion-pointer!)) - -(define (quaternion->pointer q) - "Return a foreign pointer to Q." - ;; Create foreign pointer lazily. - (or (quaternion-pointer q) - (let ((pointer (bytevector->pointer (unwrap-quaternion q)))) - (set-quaternion-pointer! q pointer) - pointer))) - -(define-inlinable (quaternion-ref q i) - (f32vector-ref (unwrap-quaternion q) i)) - -(define-inlinable (quaternion-set! q i x) - (f32vector-set! (unwrap-quaternion q) i x)) + (x f32 quaternion-x set-quaternion-x!) + (y f32 quaternion-y set-quaternion-y!) + (z f32 quaternion-z set-quaternion-z!) + (w f32 quaternion-w set-quaternion-w!)) (define-syntax-rule (with-new-quaternion name body ...) - (let ((name (wrap-quaternion (f32vector 0.0 0.0 0.0 0.0) #f))) + (let ((name (quaternion 0.0 0.0 0.0 0.0))) body ... name)) -(define-inlinable (quaternion x y z w) - "Return a new quaternion with values X, Y, Z, and W." - (with-new-quaternion q - (quaternion-set! q 0 x) - (quaternion-set! q 1 y) - (quaternion-set! q 2 z) - (quaternion-set! q 3 w))) - (define-inlinable (make-identity-quaternion) "Return the identity quaternion." (quaternion 0.0 0.0 0.0 1.0)) @@ -74,31 +57,6 @@ (define-inlinable (make-null-quaternion) (quaternion 0.0 0.0 0.0 0.0)) -(define-inlinable (quaternion-x q) - "Return the X coordinate of the quaternion Q." - (quaternion-ref q 0)) - -(define-inlinable (quaternion-y q) - "Return the Y coordinate of the quaternion Q." - (quaternion-ref q 1)) - -(define-inlinable (quaternion-z q) - "Return the Z coordinate of the quaternion Q." - (quaternion-ref q 2)) - -(define-inlinable (quaternion-w q) - "Return the W coordinate of the quaternion Q." - (quaternion-ref q 3)) - -(define (display-quaternion q port) - (format port "#<quaterion ~f ~f ~f ~f>" - (quaternion-x q) - (quaternion-y q) - (quaternion-z q) - (quaternion-w q))) - -(set-record-type-printer! <quaternion> display-quaternion) - (define-inlinable (quaternion-magnitude q) "Return the magnitude of the quaternion Q." (let ((w (quaternion-w q)) |