summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-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))