From 3ab58897635d15a36b707e41ecacca77348fe5f2 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Tue, 30 Jan 2024 14:39:11 -0500
Subject: math: Convert quaternion to bytestruct.

---
 chickadee/math/quaternion.scm | 64 ++++++++-----------------------------------
 1 file changed, 11 insertions(+), 53 deletions(-)

(limited to 'chickadee')

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))
-- 
cgit v1.2.3