From 1484dbd1b7348af77fb8771183b9feb8a5b7fd60 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Fri, 23 Feb 2024 08:32:48 -0500
Subject: graphics: color: Use bytestructs.

---
 chickadee/graphics/color.scm  | 33 ++++++++++-----------------------
 chickadee/graphics/shader.scm | 12 ++++--------
 2 files changed, 14 insertions(+), 31 deletions(-)

diff --git a/chickadee/graphics/color.scm b/chickadee/graphics/color.scm
index 1611f89..ed89082 100644
--- a/chickadee/graphics/color.scm
+++ b/chickadee/graphics/color.scm
@@ -20,6 +20,7 @@
 ;;; Code:
 
 (define-module (chickadee graphics color)
+  #:use-module (chickadee data bytestruct)
   #:use-module (chickadee graphics engine)
   #:use-module (chickadee graphics gl)
   #:use-module (chickadee math)
@@ -28,7 +29,8 @@
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
   #:use-module (srfi srfi-1)
-  #:export (make-color
+  #:export (<color>
+            make-color
             make-color8
             color?
             color-r
@@ -128,31 +130,16 @@
             color-mask-blue?
             color-mask-alpha?))
 
-(define-record-type <color>
-  (wrap-color bv)
+(define-byterecord-type <color>
+  (%make-color r g b a)
   color?
-  (bv unwrap-color))
-
-(define-inlinable (color-r color)
-  (f32vector-ref (unwrap-color color) 0))
-
-(define-inlinable (color-g color)
-  (f32vector-ref (unwrap-color color) 1))
-
-(define-inlinable (color-b color)
-  (f32vector-ref (unwrap-color color) 2))
-
-(define-inlinable (color-a color)
-  (f32vector-ref (unwrap-color color) 3))
-
-(define (display-color c port)
-  (format port "#<color r: ~1,3f, g: ~1,3f, b: ~1,3f, a: ~1,3f>"
-          (color-r c) (color-g c) (color-b c) (color-a c)))
-
-(set-record-type-printer! <color> display-color)
+  (r f32 color-r)
+  (g f32 color-g)
+  (b f32 color-b)
+  (a f32 color-a))
 
 (define* (make-color r g b #:optional (a 1.0))
-  (wrap-color (f32vector r g b a)))
+  (%make-color r g b a))
 
 (define* (make-color8 r g b #:optional (a 255))
   (make-color (/ r 255.0) (/ g 255.0) (/ b 255.0) (/ a 255.0)))
diff --git a/chickadee/graphics/shader.scm b/chickadee/graphics/shader.scm
index edde064..3d8d369 100644
--- a/chickadee/graphics/shader.scm
+++ b/chickadee/graphics/shader.scm
@@ -198,17 +198,13 @@
   #:validator (lambda (x) (or (rect? x) (color? x)))
   #:serializer
   (let ((unwrap-rect (@@ (chickadee math rect) unwrap-rect)))
-    (lambda (bv i v)
+    (lambda (bv i x)
       ;; As of now, there is no vec4 Scheme type, but we do want to
       ;; accept colors and rects as vec4s since there is no special
       ;; color or rect type in GLSL.
-      (if (rect? v)
-          (bytevector-copy! (unwrap-rect v) 0 bv i 16)
-          (begin
-            (bytevector-ieee-single-native-set! bv i (color-r v))
-            (bytevector-ieee-single-native-set! bv (+ i 4) (color-g v))
-            (bytevector-ieee-single-native-set! bv (+ i 8) (color-b v))
-            (bytevector-ieee-single-native-set! bv (+ i 12) (color-a v))))))
+      (if (rect? x)
+          (bytevector-copy! (unwrap-rect x) 0 bv i 16)
+          (bytestruct-pack! <color> ((() x)) bv i))))
   #:setter gl-uniform4fv
   #:null (make-null-rect))
 
-- 
cgit v1.2.3