From e6f37f4d005229264ee25e4424553776d8e0f0d8 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sun, 6 Jan 2019 22:48:14 -0500
Subject: render: color: Use f32vector under the hood.

* chickadee/render/color.scm (<color>): Use a single field for storing
bytevector.
(make-color): Wrap f32vector.
(color-r, color-g, color-b, color-a): Fetch channel values from
f32vector.
(color): New procedure.
---
 chickadee/render/color.scm | 62 +++++++++++++++++++++++++---------------------
 1 file changed, 34 insertions(+), 28 deletions(-)

diff --git a/chickadee/render/color.scm b/chickadee/render/color.scm
index 47ad769..387e6d2 100644
--- a/chickadee/render/color.scm
+++ b/chickadee/render/color.scm
@@ -26,7 +26,7 @@
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-1)
   #:use-module (chickadee math)
-  #:export (make-color
+  #:export (color make-color
             color?
             color-r color-g color-b color-a
             rgba rgb transparency
@@ -44,20 +44,32 @@
             tango-aluminium-4 tango-aluminium-5 tango-aluminium-6))
 
 (define-record-type <color>
-  (%make-color r g b a)
+  (wrap-color bv)
   color?
-  (r color-r)
-  (g color-g)
-  (b color-b)
-  (a color-a))
-
-(define (make-color r g b a)
-  "Return a newly allocated color with the given RGBA channel values.
-Each channel is clamped to the range [0, 1]."
-  (%make-color (clamp 0 1 r)
-               (clamp 0 1 g)
-               (clamp 0 1 b)
-               (clamp 0 1 a)))
+  (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-inlinable (make-color r g b a)
+  (wrap-color
+   (f32vector
+    (clamp 0.0 1.0 r)
+    (clamp 0.0 1.0 g)
+    (clamp 0.0 1.0 b)
+    (clamp 0.0 1.0 a))))
+
+(define-inlinable (color r g b a)
+  (make-color r g b a))
 
 (define (color-component color-code offset)
   "Return the value of an 8-bit color channel in the range [0,1] for
@@ -71,31 +83,25 @@ the integer COLOR-CODE, given an OFFSET in bits."
   "Translate an RGBA format string COLOR-CODE into a color object.
 For example: #xffffffff will return a color with RGBA values 1, 1, 1,
 1."
-  (%make-color (color-component color-code 24)
-               (color-component color-code 16)
-               (color-component color-code 8)
-               (color-component color-code 0)))
+  (make-color (color-component color-code 24)
+              (color-component color-code 16)
+              (color-component color-code 8)
+              (color-component color-code 0)))
 
 (define (rgb color-code)
   "Translate an RGB format string COLOR-CODE into a color object.
 For example: #xffffff will return a color with RGBA values 1, 1, 1,
 1."
-  (%make-color (color-component color-code 16)
-               (color-component color-code 8)
-               (color-component color-code 0)
-               1.0))
+  (make-color (color-component color-code 16)
+              (color-component color-code 8)
+              (color-component color-code 0)
+              1.0))
 
 (define (transparency alpha)
   "Create a new color that is white with a transparency value of
 ALPHA.  ALPHA is clamped to the range [0, 1]."
   (make-color 1 1 1 alpha))
 
-;; (define-method (* (a <<color>>) (b <<color>>))
-;;   (make-color (* (color-r a) (color-r b))
-;;               (* (color-g a) (color-g b))
-;;               (* (color-b a) (color-b b))
-;;               (* (color-a a) (color-a b))))
-
 ;; TODO: Optimize and inline
 (define color*
   (match-lambda*
-- 
cgit v1.2.3