summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2024-01-30 14:39:11 -0500
committerDavid Thompson <dthompson2@worcester.edu>2024-02-22 08:11:29 -0500
commit3ab58897635d15a36b707e41ecacca77348fe5f2 (patch)
tree30f869b0eac7ecf6082dd0efe91aee754ce9a881
parent3d7648b95385221741155b976477336acde6127f (diff)
math: Convert quaternion to bytestruct.
-rw-r--r--chickadee/math/quaternion.scm64
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))