diff options
| -rw-r--r-- | sly/color.scm | 78 | ||||
| -rw-r--r-- | sly/transition.scm | 2 |
2 files changed, 35 insertions, 45 deletions
diff --git a/sly/color.scm b/sly/color.scm index 143e750..4b82df7 100644 --- a/sly/color.scm +++ b/sly/color.scm @@ -22,6 +22,7 @@ ;;; Code: (define-module (sly color) + #:use-module (ice-9 match) #:use-module (gl) #:use-module (srfi srfi-9) #:use-module (srfi srfi-1) @@ -119,53 +120,42 @@ For example: #xffffff will return a color with RGBA values 1, 1, 1, (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* + (match-lambda* + ((($ <color> r1 g1 b1 a1) ($ <color> r2 g2 b2 a2)) + (make-color (* r1 r2) + (* g1 g2) + (* b1 b2) + (* a1 a2))) + ((($ <color> r g b a) (? number? k)) + (make-color (* r k) + (* g k) + (* b k) + (* a k))))) -(define (color-scale c k) - "Multiple the RGBA channels of the color C by the scalar K." - (make-color (* (color-r c) k) - (* (color-g c) k) - (* (color-b c) k) - (* (color-a c) k))) +(define color+ + (match-lambda* + ((($ <color> r1 g1 b1 a1) ($ <color> r2 g2 b2 a2)) + (make-color (+ r1 r2) + (+ g1 g2) + (+ b1 b2) + (+ a1 a2))))) -(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- + (match-lambda* + ((($ <color> r1 g1 b1 a1) ($ <color> r2 g2 b2 a2)) + (make-color (- r1 r2) + (- g1 g2) + (- b1 b2) + (- a1 a2))))) -(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))) +(define color-inverse + (match-lambda + (($ <color> r g b a) + (make-color (- 1 r) + (- 1 g) + (- 1 b) + a)))) ; Do not alter alpha channel. ;;; ;;; Pre-defined Colors diff --git a/sly/transition.scm b/sly/transition.scm index c923980..7910962 100644 --- a/sly/transition.scm +++ b/sly/transition.scm @@ -114,7 +114,7 @@ range [0, 1]." (define number-interpolate (interpolator + *)) (define vector-interpolate (interpolator v+ v*)) -(define color-interpolate (interpolator color+ color-scale)) +(define color-interpolate (interpolator color+ color*)) (define (guess-interpolator a b) (define (both? pred) |