From 120fc6d530c3366ca281a1fee5ac5c0e9462caea Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Wed, 8 Apr 2020 17:01:39 -0400
Subject: render: color: Rewrite color*, color+, color-, color-inverse
 procedures.

* chickadee/render/color.scm (color*, color+, color-, color-inverse):
  Rewrite and inline.
---
 chickadee/render/color.scm | 67 +++++++++++++++++++++-------------------------
 1 file changed, 30 insertions(+), 37 deletions(-)

diff --git a/chickadee/render/color.scm b/chickadee/render/color.scm
index 0536848..52f98d7 100644
--- a/chickadee/render/color.scm
+++ b/chickadee/render/color.scm
@@ -139,43 +139,36 @@ a color object."
                     1.0)))
     (make-color red green blue alpha)))
 
-;; TODO: Optimize and inline
-(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+
-  (match-lambda*
-   ((($ <color> r1 g1 b1 a1) ($ <color> r2 g2 b2 a2))
-    (make-color (+ r1 r2)
-                (+ g1 g2)
-                (+ b1 b2)
-                (+ a1 a2)))))
-
-(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-inverse
-  (match-lambda
-   (($ <color> r g b a)
-    (make-color (- 1 r)
-                (- 1 g)
-                (- 1 b)
-                a)))) ; Do not alter alpha channel.
+(define-inlinable (color* a b)
+  (if (color? 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)))
+      ;; Scalar multiplication.
+      (make-color (* (color-r a) b)
+                  (* (color-g a) b)
+                  (* (color-b a) b)
+                  (* (color-a a) b))))
+
+(define-inlinable (color+ a 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-inlinable (color- a 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-inlinable (color-inverse color)
+  (make-color (- 1.0 (color-r color))
+              (- 1.0 (color-g color))
+              (- 1.0 (color-b color))
+              ;; Do not alter alpha channel.
+              (color-a color)))
 
 (define-inlinable (color-lerp start end alpha)
   (color+ (color* start (- 1.0 alpha))
-- 
cgit v1.2.3