From 0d4bf44b59b0d27ccb6bb36378b45fa5b6ae321a Mon Sep 17 00:00:00 2001
From: Igor Brejc <igor.brejc@gmail.com>
Date: Sun, 27 Dec 2020 11:34:17 +0100
Subject: [PATCH] Implemented color parsing, experimenting with some color
 mixing for age groups, but I'm not too satisfied (#770)

---
 src/visualizations/Colors.fs                  | 35 +++++++++++++++++++
 .../DataAnalysis/AgeGroupsTimeline.fs         | 12 ++++++-
 src/visualizations/Types.fs                   |  2 +-
 3 files changed, 47 insertions(+), 2 deletions(-)

diff --git a/src/visualizations/Colors.fs b/src/visualizations/Colors.fs
index cd2467c50..fe8546ef3 100644
--- a/src/visualizations/Colors.fs
+++ b/src/visualizations/Colors.fs
@@ -1,5 +1,7 @@
 module Colors
 
+open System
+
 type RgbaColor = uint32
 
 let inline r(color: RgbaColor) = byte (color >>> 24)
@@ -35,3 +37,36 @@ let inline toHex(color: RgbaColor): string =
     match alpha with
     | 0xffuy -> sprintf "#%02x%02x%02x" (r color) (g color) (b color)
     | _ -> sprintf "#%02x%02x%02x%02x" alpha (r color) (g color) (b color)
+
+let fromHex (hexValue: string): RgbaColor =
+    let rec parseNextChar
+            (accumulatedValue: uint32) (hexChars: char list): uint32 =
+        match hexChars.Length with
+        | 0 -> accumulatedValue
+        | _ ->
+            let chr = Char.ToLower(hexChars.[0])
+            let digitValue: uint32 =
+                match chr with
+                | chr when chr >= '0' && chr <= '9' -> (uint32)chr - (uint32)'0'
+                | chr when chr >= 'a' && chr <= 'f' ->
+                    (uint32)chr - (uint32)'a' + 10u
+                | _ -> invalidArg "hexValue" "Unsupported hex color value."
+
+            let accumulatedValueShifted =
+                (accumulatedValue <<< 4) ||| digitValue
+
+            parseNextChar accumulatedValueShifted (hexChars |> List.tail)
+
+    let parseToInt() =
+        match hexValue.[0] with
+        | '#' ->
+            let hexChars = hexValue |> Seq.toList |> List.tail
+            parseNextChar 0u hexChars
+        | _ -> invalidArg "hexValue" "Unsupported hex color value."
+
+    match hexValue.Length with
+    | 7 ->
+        let intValue = parseToInt()
+        (intValue <<< 8) ||| 0xffu
+
+    | _ -> invalidArg "hexValue" "Unsupported hex color value."
diff --git a/src/visualizations/DataAnalysis/AgeGroupsTimeline.fs b/src/visualizations/DataAnalysis/AgeGroupsTimeline.fs
index 2ce0c6168..cb89f934c 100644
--- a/src/visualizations/DataAnalysis/AgeGroupsTimeline.fs
+++ b/src/visualizations/DataAnalysis/AgeGroupsTimeline.fs
@@ -192,11 +192,21 @@ let getAgeGroupTimelineAllSeriesData
         if hasAnyNonZeroValues then
             let points = ageGroupTimeline |> mapAllPoints
 
+            let baseColorOfAgeGroupHex = AgeGroup.colorOfAgeGroup index
+            let baseColorOfAgeGroup = Colors.fromHex baseColorOfAgeGroupHex
+            printfn "color=%A" baseColorOfAgeGroup
+            let mixinColor = Colors.fromHex "#8C71A8"
+            printfn "mixinColor=%A" mixinColor
+            let mixedColor =
+                Colors.mixColors baseColorOfAgeGroup mixinColor 0.3
+            let mixedColorHex = Colors.toHex mixedColor
+            printfn "mixedColorHex=%A" mixedColorHex
+
             pojo {|
                  ``type`` = "column"
                  visible = true
                  name = ageGroupKey.Label
-                 color = AgeGroup.ColorOfAgeGroup index
+                 color = mixedColorHex
                  data = points
                  animation = false
             |} |> Some
diff --git a/src/visualizations/Types.fs b/src/visualizations/Types.fs
index e40946d52..b9252fed3 100644
--- a/src/visualizations/Types.fs
+++ b/src/visualizations/Types.fs
@@ -66,7 +66,7 @@ type AgeGroup =
       Female : int option
       All : int option } with
 
-    static member ColorOfAgeGroup ageGroupIndex =
+    static member colorOfAgeGroup ageGroupIndex =
         let colors =
             [| "#FFEEBA"; "#FFDA6B";"#E9B825";"#AEEFDB";"#52C4A2";"#33AB87"
                "#189A73";"#F4B2E0";"#D559B0";"#B01C83" |]