diff options
| -rw-r--r-- | 2d/color.scm | 77 |
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)) |