Support alpha channel in as-hex

src/garden/color.cljc

@@ -92,6 +92,12 @@
   (and (map? color)
        (every? color #{:red :green :blue})))
 
+(defn rgba?
+  "Return true if color is an RGBA color."
+  [color]
+  (and (map? color)
+       (every? color #{:red :green :blue :alpha})))
+
 (defn hsl?
   "Return true if color is an HSL color."
   [color]
@@ -140,6 +146,15 @@
                 (string/replace " " "0")))]
     (apply str "#" (map hex-part [r g b]))))
 
+(defn rgba->hex
+  "Convert an RGB color map to a hexadecimal color."
+  [{r :red g :green b :blue a :alpha}]
+  (letfn [(hex-part [v]
+            (-> (util/format "%2s" (util/int->string v 16))
+                (string/replace " " "0")))]
+    (str (apply str "#" (map hex-part [r g b]) )
+         (hex-part (int (* 256 a))))))
+
 (defn trim-one [x]
   (if (< 1 x) 1 x))
 
@@ -186,6 +201,24 @@
                         (hue->rgb m1 m2 (- h (/ 1.0 3)))])]
       (rgb [r g b]))))
 
+(defn hsla->rgba
+  "Convert an HSLA color map to an RGBA color map."
+  [{:keys  [hue saturation lightness alpha] :as color}]
+  (if (rgb? color)
+    color
+    (let [h (/ hue 360.0)
+          s (/ saturation 100.0)
+          l (/ lightness 100.0)
+          m2 (if (<= l 0.5)
+               (* l (inc s))
+               (- (+ l s) (* l s)))
+          m1 (- (* 2 l) m2)
+          [r g b] (map #(int (+ 0.5 (* % 0xff)))
+                       [(hue->rgb m1 m2 (+ h (/ 1.0 3)))
+                        (hue->rgb m1 m2 h)
+                        (hue->rgb m1 m2 (- h (/ 1.0 3)))])]
+      (rgba [r g b alpha]))))
+
 (defn- hue->rgb
   [m1 m2 h]
   (let [h (cond
@@ -203,6 +236,11 @@
   [color]
   (-> color hsl->rgb rgb->hex))
 
+(defn hsla->hex
+  "Convert an HSLA color map to a hexadecimal string."
+  [color]
+  (-> color hsla->rgba rgb->hex))
+
 (defn hex->hsl
   "Convert a hexadecimal color to an HSL color."
   [color]
@@ -223,10 +261,12 @@
   "Convert a color to a hexadecimal string."
   [x]
   (cond
-   (hex? x) x
-   (rgb? x) (rgb->hex x)
-   (hsl? x) (hsl->hex x)
-   :else (throw (ex-info (str "Can't convert " x " to a color.") {}))))
+    (rgba? x) (rgba->hex x)
+    (hsla? x) (hsla->hex x)
+    (hex? x)  x
+    (rgb? x)  (rgb->hex x)
+    (hsl? x)  (hsl->hex x)
+    :else     (throw (ex-info (str "Can't convert " x " to a color.") {}))))
 
 (defn as-rgb
   "Convert a color to a RGB."

test/garden/color_test.cljc

@@ -13,20 +13,41 @@
 (def hex-blue "#0000ff")
 (def hex-white "#ffffff")
 
+(def hexa-black "#00000080")
+(def hexa-red "#ff000080")
+(def hexa-green "#00ff0080")
+(def hexa-blue "#0000ff80")
+(def hexa-white "#ffffff80")
+
+
 (def rgb-black (color/rgb 0 0 0))
 (def rgb-red (color/rgb 255 0 0))
 (def rgb-green (color/rgb 0 255 0))
 (def rgb-blue (color/rgb 0 0 255))
 (def rgb-white (color/rgb 255 255 255))
 (def rgb-orange (color/rgb 255 133 27))
 
+(def rgba-black (color/rgba 0 0 0 0.5))
+(def rgba-red (color/rgba 255 0 0 0.5))
+(def rgba-green (color/rgba 0 255 0 0.5))
+(def rgba-blue (color/rgba 0 0 255 0.5))
+(def rgba-white (color/rgba 255 255 255 0.5))
+(def rgba-orange (color/rgba 255 133 27 0.5))
+
 (def hsl-black (color/hsl 0 0 0))
 (def hsl-red (color/hsl 0 100 50))
 (def hsl-green (color/hsl 120 100 50))
 (def hsl-blue (color/hsl 240 100 50))
 (def hsl-white (color/hsl 0 0 100))
 (def hsl-orange (color/hsl 530/19 100 940/17))
 
+(def hsla-black (color/hsla 0 0 0 0.5))
+(def hsla-red (color/hsla 0 100 50 0.5))
+(def hsla-green (color/hsla 120 100 50 0.5))
+(def hsla-blue (color/hsla 240 100 50 0.5))
+(def hsla-white (color/hsla 0 0 100 0.5))
+(def hsla-orange (color/hsla 530/19 100 940/17 0.5))
+
 (deftest color-conversion-test
   (testing "hex->rgb"
     (are [x y] (= x y)
@@ -43,6 +64,13 @@
       (color/rgb->hex rgb-green) hex-green
       (color/rgb->hex rgb-blue) hex-blue))
 
+  (testing "rgba->hex"
+    (are [x y] (= x y)
+      (color/rgba->hex rgba-black) hexa-black
+      (color/rgba->hex rgba-red) hexa-red
+      (color/rgba->hex rgba-green) hexa-green
+      (color/rgba->hex rgba-blue) hexa-blue))
+
   (testing "hsl->rgb"
     (are [x y] (= x y)
       (color/hsl->rgb hsl-black) rgb-black
@@ -51,14 +79,30 @@
       (color/hsl->rgb hsl-blue) rgb-blue
       (color/hsl->rgb hsl-white) rgb-white))
 
+  (testing "hsla->rgba"
+    (are [x y] (= x y)
+      (color/hsla->rgba hsla-black) rgba-black
+      (color/hsla->rgba hsla-red) rgba-red
+      (color/hsla->rgba hsla-green) rgba-green
+      (color/hsla->rgba hsla-blue) rgba-blue
+      (color/hsla->rgba hsla-white) rgba-white))
+
   (testing "rgb->hsl"
     (are [x y] (= x y)
       (color/rgb->hsl rgb-black) hsl-black
       (color/rgb->hsl rgb-red) hsl-red
       (color/rgb->hsl rgb-green) hsl-green
       (color/rgb->hsl rgb-blue) hsl-blue
       (color/rgb->hsl rgb-white) hsl-white
-      (color/rgb->hsl rgb-orange) hsl-orange)))
+      (color/rgb->hsl rgb-orange) hsl-orange))
+
+  (testing "as-hex"
+    (are [x y] (= x y)
+      (color/as-hex rgba-black) hexa-black
+      (color/as-hex rgba-red) hexa-red
+      (color/as-hex rgba-green) hexa-green
+      (color/as-hex rgba-blue) hexa-blue
+      (color/as-hex rgba-white) hexa-white)))
 
 (deftest color-math-test
   (testing "color+"