summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson@member.fsf.org>2014-03-30 20:23:35 -0400
committerDavid Thompson <dthompson@member.fsf.org>2014-03-30 20:23:35 -0400
commit0f24bdf11f806d7b4ad19e256cf1d5f0cda1b5e4 (patch)
tree0f9b6463389cf0ef3582507e57582d851eeab523
parenta41698dd54e83b9acaa8f1718e854c064f6c4f9b (diff)
Expand color API.
* 2d/color.scm (color*, color+, color-, color-inverse): New procedures. (use-color): Delete it. (make-color): Clamp channels to the range [0, 1]. (rgba, rgb): Use low-level color constructor.
-rw-r--r--2d/color.scm77
1 files changed, 61 insertions, 16 deletions
diff --git a/2d/color.scm b/2d/color.scm
index f66c659..e52cf48 100644
--- a/2d/color.scm
+++ b/2d/color.scm
@@ -32,9 +32,12 @@
color-g
color-b
color-a
- use-color
rgba
rgb
+ color*
+ color+
+ color-
+ color-inverse
white
black
red
@@ -43,19 +46,20 @@
magenta))
(define-record-type <color>
- (make-color r g b a)
+ (%make-color r g b a)
color?
(r color-r)
(g color-g)
(b color-b)
(a color-a))
-(define (use-color color)
- "Set the current OpenGL color state to the contents of COLOR."
- (gl-color (color-r color)
- (color-g color)
- (color-b color)
- (color-a color)))
+(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)))
(define (color-component color-code offset)
"Return the value of an 8-bit color channel in the range [0,1] for
@@ -69,19 +73,60 @@ 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))
+ (%make-color (color-component color-code 16)
+ (color-component color-code 8)
+ (color-component color-code 0)
+ 1))
+
+(define (color* a b)
+ "Multiply the RGBA channels of colors A and B."
+ (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))))
+
+(define (color+ a b)
+ "Add the RGBA channels of colors A and B."
+ (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))))
+
+(define (color- a b)
+ "Subtract the RGBA channels of colors A and B."
+ (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))))
+
+(define (color-inverse color)
+ "Create a new color that is the inverse of COLOR. The alpha channel
+is left unchanged."
+ (make-color (- 1 (color-r color))
+ (- 1 (color-g color))
+ (- 1 (color-b color))
+ (color-a color)))
;; Pre-defined colors.
(define white (rgb #xffffff))