diff options
| -rw-r--r-- | chickadee/render/color.scm | 62 |
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* |