summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2019-01-06 22:48:14 -0500
committerDavid Thompson <dthompson2@worcester.edu>2019-01-06 22:48:14 -0500
commite6f37f4d005229264ee25e4424553776d8e0f0d8 (patch)
treed729462cf3bf0c2d5761f095f8bd6c3862754f75
parentc93716843828ccff80831294008a8456d9cadc4f (diff)
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.
-rw-r--r--chickadee/render/color.scm62
1 files 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*