-----------------------------------------------------------------------------
-- |
-- Module      :  Palette.ColorSet
-- Copyright   :  (c) 2013 Jeffrey Rosenbluth
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  jeffrey.rosenbluth@gmail.com
--
-- Predefined sets of colors. Including the common html/css colors, The
-- colors from d3.js and the standard color wheel.
-- d3 Colors from https:\/\/github.com\/mbostock\/d3\/wiki\/Ordinal-Scales.
--
-----------------------------------------------------------------------------

module Data.Colour.Palette.ColorSet
       ( -- * Predefined color palettes

         -- ** Synonym for Colour Double

           Kolor

         -- ** RYB color wheel - red, rellow, blue
         -- *** Artist's pigment color wheel

         , rybColor

         -- ** Colors from d3.js

         , Brightness(..)
         , d3Colors1, d3Colors2, d3Colors4

         -- ** Common html colors

         , webColors, infiniteWebColors, getWebColor

       ) where

import Data.Array.IArray
import Data.List                (sortBy)
import Data.Colour.SRGB         (sRGB24read, toSRGB)
import Data.Colour.RGBSpace.HSV (hue)
import Data.Colour.Palette.Types

-- > import Data.Colour.Palette.ColorSet
-- > wheel [] = circle 1 # fc black
-- > wheel cs = wheel' # rotateBy r
-- >   where
-- >     wheel' = mconcat $ zipWith fc cs (iterateN n (rotateBy a) w)
-- >     n = length cs
-- >     a = 1 / (fromIntegral n) :: Turn
-- >     w = wedge 1 (0 :: Turn) a # lw 0
-- >     r = 1/4 - 1/(2*(fromIntegral n))

-- > rybWheel = wheel [rybColor i | i <- [0..23]]

-- | The 24 colors from the artist's RYB color wheel. 0 == red.
-- <<diagrams/src_Data_Colour_Palette_ColorSet_rybWheel.svg#diagram=rybWheel&width=300>>
rybColor :: Int -> Kolor
rybColor :: Int -> Kolor
rybColor Int
i = Array Int Kolor
rybColorA forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Int
i forall a. Integral a => a -> a -> a
`mod` Int
24)

-- A few hundred common html colors -------------------------------------------
-------------------------------------------------------------------------------
numColors :: Int
numColors :: Int
numColors = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Kolor]
webColorL

-- Number of colors to skip beteen choices from hueColors.
-- The idea is to skip enough similar colors so that the next color
-- is not too similar.
primeRepeat :: Int
primeRepeat :: Int
primeRepeat = Int
61

-- | Choose the `n`th color in an array @a@ skipping @skip@ colors
--   every time.
getWebColor :: Array Int (Kolor) -> Int -> Int -> Kolor
getWebColor :: Array Int Kolor -> Int -> Int -> Kolor
getWebColor Array Int Kolor
a Int
skip Int
n  = Array Int Kolor
a forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
idx
  where
    (Int
i, Int
k) = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds Array Int Kolor
a
    j :: Int
j = (Int
n forall a. Num a => a -> a -> a
* Int
skip) forall a. Integral a => a -> a -> a
`mod` Int
k
    idx :: Int
idx = forall a. Ord a => a -> a -> a
max Int
i Int
j

-- > web = [[webColors (19 * j + i) | i <- [0..19]] | j <- [0..14]]
-- > webcolors = grid web

-- | Return a color from webColorL arranged as to provide nice contrast
--   between near by colors.
--
-- <<diagrams/src_Data_Colour_Palette_ColorSet_webcolors.svg#diagram=webcolors&width=300>>
webColors :: Int -> Kolor
webColors :: Int -> Kolor
webColors Int
i = Array Int Kolor -> Int -> Int -> Kolor
getWebColor Array Int Kolor
webColorA Int
primeRepeat (Int
iforall a. Num a => a -> a -> a
+Int
1) -- Start with a blue.

-- | A List of webColors ordered as above, cycling infinitely many times.
infiniteWebColors :: [Kolor]
infiniteWebColors :: [Kolor]
infiniteWebColors = forall a. [a] -> [a]
cycle [Int -> Kolor
webColors Int
j | Int
j <- [Int
0..Int
numColorsforall a. Num a => a -> a -> a
-Int
1]]

-- Colors from d3. ------------------------------------------------------------
-------------------------------------------------------------------------------

-- | Four levels of brightness for functions that take a @Brightness@ parameter.
--   For functions with only two levels of @Brightness@ we set @darkest == dark@
--   and @lightest == light@.
data Brightness = Darkest | Dark | Light | Lightest
  deriving (Brightness -> Brightness -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Brightness -> Brightness -> Bool
$c/= :: Brightness -> Brightness -> Bool
== :: Brightness -> Brightness -> Bool
$c== :: Brightness -> Brightness -> Bool
Eq)

-- > import Data.Colour.Palette.ColorSet
-- > gr = 1.618 -- golden ratio
-- >
-- > bar [] = centerXY $ square gr # fc black
-- > bar cs = centerXY $ hcat [square gr # scaleX s # fc k # lw 0 | k <- cs]
-- >   where s = gr / (fromIntegral (length cs))
--
-- > singles      = bar [d3Colors1 n | n <- [0..9]]

-- | Choose from one of 10 contrasting colors (0-9) borrowed from mbostock's d3.
--
-- <<diagrams/src_Data_Colour_Palette_ColorSet_singles.svg#diagram=singles&width=300>>
d3Colors1 :: Int ->  Kolor
d3Colors1 :: Int -> Kolor
d3Colors1 Int
n = Array Int Kolor
d3c10 forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Int
n forall a. Integral a => a -> a -> a
`mod` Int
10)

-- > d2 = [[d3Colors2  Dark  n | n <- [0..9]], [d3Colors2 Light n | n <- [0..9]]]
-- > pairs      = grid d2

-- > grid [] = centerXY $ square gr # fc black
-- > grid cs = centerXY $ vcat [bar c # scaleY s | c <- cs]
-- >   where s = 1 / (fromIntegral (length cs))

-- | Choose 0 for dark and 1 for light for each pair of 10 sets of contrasting
--   colors (0-9) from d3.
--
-- <<diagrams/src_Data_Colour_Palette_ColorSet_pairs.svg#diagram=pairs&width=300>>
d3Colors2 :: Brightness -> Int -> Kolor
d3Colors2 :: Brightness -> Int -> Kolor
d3Colors2 Brightness
b Int
n = Array (Int, Int) Kolor
d3c20 forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! ((Int
n forall a. Integral a => a -> a -> a
`mod` Int
10), Int
k)
  where k :: Int
k = if Brightness
b forall a. Eq a => a -> a -> Bool
== Brightness
Darkest Bool -> Bool -> Bool
|| Brightness
b forall a. Eq a => a -> a -> Bool
== Brightness
Dark then Int
0 else Int
1

-- > d4 = [[d3Colors4 b n | n <- [0..9]] | b <- [Darkest, Dark, Light, Lightest]]
-- > quads      = grid d4

-- | Choose from 4 levels of darkness - 0 for darkest, 3 - for lightest. From
--   10 quadruples of contrasting colors (0-9) from d3.
--
-- <<diagrams/src_Data_Colour_Palette_ColorSet_quads.svg#diagram=quads&width=300>>
d3Colors4 :: Brightness -> Int -> Kolor
d3Colors4 :: Brightness -> Int -> Kolor
d3Colors4 Brightness
b Int
n =Array (Int, Int) Kolor
d3c20bc forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! ((Int
n forall a. Integral a => a -> a -> a
`mod` Int
10), Int
k)
  where k :: Int
k = case Brightness
b of
              Brightness
Darkest  -> Int
0
              Brightness
Dark     -> Int
1
              Brightness
Light    -> Int
2
              Brightness
Lightest -> Int
3

-- Color data -----------------------------------------------------------------
-------------------------------------------------------------------------------

-- d3.scale.category10()
d3_10 :: [Kolor]
d3_10 :: [Kolor]
d3_10 = forall a b. (a -> b) -> [a] -> [b]
map forall b. (Ord b, Floating b) => String -> Colour b
sRGB24read
      [ String
"#1f77b4", String
"#ff7f0e", String
"#2ca02c", String
"#d62728", String
"#9467bd"
      , String
"#8c564b", String
"#e377c2", String
"#7f7f7f", String
"#bcbd22", String
"#17becf"]

d3c10 :: Array Int (Kolor)
d3c10 :: Array Int Kolor
d3c10 = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
9) [Kolor]
d3_10

-- d3.scale.category20()
d3_20 :: [Kolor]
d3_20 :: [Kolor]
d3_20 = forall a b. (a -> b) -> [a] -> [b]
map forall b. (Ord b, Floating b) => String -> Colour b
sRGB24read
      [ String
"#1f77b4", String
"#aec7e8", String
"#ff7f0e", String
"#ffbb78", String
"#2ca02c"
      , String
"#98df8a", String
"#d62728", String
"#ff9896", String
"#9467bd", String
"#c5b0d5"
      , String
"#8c564b", String
"#c49c94", String
"#e377c2", String
"#f7b6d2", String
"#7f7f7f"
      , String
"#c7c7c7", String
"#bcbd22", String
"#dbdb8d", String
"#17becf", String
"#9edae5"]

d3c20 ::  Array (Int, Int) (Kolor)
d3c20 :: Array (Int, Int) Kolor
d3c20 = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray ((Int
0,Int
0),(Int
9,Int
1)) [Kolor]
d3_20

-- d3.scale.category20b() and d3.scale.category20c()
d3_40 :: [Kolor]
d3_40 :: [Kolor]
d3_40 = forall a b. (a -> b) -> [a] -> [b]
map forall b. (Ord b, Floating b) => String -> Colour b
sRGB24read
      [ String
"#393b79", String
"#5254a3", String
"#6b6ecf", String
"#9c9ede", String
"#637939"
      , String
"#8ca252", String
"#b5cf6b", String
"#cedb9c", String
"#8c6d31", String
"#bd9e39"
      , String
"#e7ba52", String
"#e7cb94", String
"#843c39", String
"#ad494a", String
"#d6616b"
      , String
"#e7969c", String
"#7b4173", String
"#a55194", String
"#ce6dbd", String
"#de9ed6"
      , String
"#3182bd", String
"#6baed6", String
"#9ecae1", String
"#c6dbef", String
"#e6550d"
      , String
"#fd8d3c", String
"#fdae6b", String
"#fdd0a2", String
"#31a354", String
"#74c476"
      , String
"#a1d99b", String
"#c7e9c0", String
"#756bb1", String
"#9e9ac8", String
"#bcbddc"
      , String
"#dadaeb", String
"#636363", String
"#969696", String
"#bdbdbd", String
"#d9d9d9"]

d3c20bc ::  Array (Int, Int) (Kolor)
d3c20bc :: Array (Int, Int) Kolor
d3c20bc = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray ((Int
0,Int
0),(Int
9,Int
3)) [Kolor]
d3_40

-- List of commonly used html colors.
htmlColors :: [Kolor]
htmlColors :: [Kolor]
htmlColors = forall a b. (a -> b) -> [a] -> [b]
map forall b. (Ord b, Floating b) => String -> Colour b
sRGB24read
  [ String
"#000000", String
"#2c3539", String
"#2b1b17", String
"#34282c", String
"#25383c", String
"#3b3131", String
"#413839"
  , String
"#463e3f", String
"#4c4646", String
"#504a4b", String
"#565051", String
"#5c5858", String
"#625d5d", String
"#666362"
  , String
"#6d6968", String
"#726e6d", String
"#736f6e", String
"#837e7c", String
"#848482", String
"#b6b6b4", String
"#d1d0ce"
  , String
"#e5e4e2", String
"#bcc6cc", String
"#98afc7", String
"#6d7b8d", String
"#657383", String
"#616d7e", String
"#646d7e"
  , String
"#566d7e", String
"#737ca1", String
"#4863a0", String
"#2b547e", String
"#2b3856", String
"#151b54", String
"#000080"
  , String
"#342d7e", String
"#15317e", String
"#151b8d", String
"#0000a0", String
"#0020c2", String
"#0041c2", String
"#2554c7"
  , String
"#1569c7", String
"#2b60de", String
"#1f45fc", String
"#6960ec", String
"#736aff", String
"#357ec7", String
"#488ac7"
  , String
"#3090c7", String
"#659ec7", String
"#87afc7", String
"#95b9c7", String
"#728fce", String
"#2b65ec", String
"#306eff"
  , String
"#157dec", String
"#1589ff", String
"#6495ed", String
"#6698ff", String
"#38acec", String
"#56a5ec", String
"#5cb3ff"
  , String
"#3bb9ff", String
"#79baec", String
"#82cafa", String
"#82caff", String
"#a0cfec", String
"#b7ceec", String
"#b4cfec"
  , String
"#c2dfff", String
"#c6deff", String
"#afdcec", String
"#addfff", String
"#bdedff", String
"#cfecec", String
"#e0ffff"
  , String
"#ebf4fa", String
"#f0f8ff", String
"#f0ffff", String
"#ccffff", String
"#93ffe8", String
"#9afeff", String
"#7fffd4"
  , String
"#00ffff", String
"#7dfdfe", String
"#57feff", String
"#8eebec", String
"#50ebec", String
"#4ee2ec", String
"#81d8d0"
  , String
"#92c7c7", String
"#77bfc7", String
"#78c7c7", String
"#48cccd", String
"#43c6db", String
"#46c7c7", String
"#43bfc7"
  , String
"#3ea99f", String
"#3b9c9c", String
"#438d80", String
"#348781", String
"#307d7e", String
"#5e7d7e", String
"#4c787e"
  , String
"#008080", String
"#4e8975", String
"#78866b", String
"#617c58", String
"#728c00", String
"#667c26", String
"#254117"
  , String
"#306754", String
"#347235", String
"#437c17", String
"#387c44", String
"#347c2c", String
"#347c17", String
"#348017"
  , String
"#4e9258", String
"#6aa121", String
"#4aa02c", String
"#41a317", String
"#3ea055", String
"#6cbb3c", String
"#6cc417"
  , String
"#4cc417", String
"#52d017", String
"#4cc552", String
"#54c571", String
"#99c68e", String
"#89c35c", String
"#85bb65"
  , String
"#8bb381", String
"#9cb071", String
"#b2c248", String
"#9dc209", String
"#a1c935", String
"#7fe817", String
"#59e817"
  , String
"#57e964", String
"#64e986", String
"#5efb6e", String
"#00ff00", String
"#5ffb17", String
"#87f717", String
"#8afb17"
  , String
"#6afb92", String
"#98ff98", String
"#b5eaaa", String
"#c3fdb8", String
"#ccfb5d", String
"#b1fb17", String
"#bce954"
  , String
"#edda74", String
"#ede275", String
"#ffe87c", String
"#ffff00", String
"#fff380", String
"#ffffc2", String
"#ffffcc"
  , String
"#fff8c6", String
"#fff8dc", String
"#f5f5dc", String
"#faebd7", String
"#ffebcd", String
"#f3e5ab", String
"#ece5b6"
  , String
"#ffe5b4", String
"#ffdb58", String
"#ffd801", String
"#fdd017", String
"#eac117", String
"#f2bb66", String
"#fbb917"
  , String
"#fbb117", String
"#ffa62f", String
"#e9ab17", String
"#e2a76f", String
"#deb887", String
"#ffcba4", String
"#c9be62"
  , String
"#e8a317", String
"#ee9a4d", String
"#c8b560", String
"#d4a017", String
"#c2b280", String
"#c7a317", String
"#c68e17"
  , String
"#b5a642", String
"#ada96e", String
"#c19a6b", String
"#cd7f32", String
"#c88141", String
"#c58917", String
"#af7817"
  , String
"#b87333", String
"#966f33", String
"#806517", String
"#827839", String
"#827b60", String
"#786d5f", String
"#493d26"
  , String
"#483c32", String
"#6f4e37", String
"#835c3b", String
"#7f5217", String
"#7f462c", String
"#c47451", String
"#c36241"
  , String
"#c35817", String
"#c85a17", String
"#cc6600", String
"#e56717", String
"#e66c2c", String
"#f87217", String
"#f87431"
  , String
"#e67451", String
"#ff8040", String
"#f88017", String
"#ff7f50", String
"#f88158", String
"#f9966b", String
"#e78a61"
  , String
"#e18b6b", String
"#e77471", String
"#f75d59", String
"#e55451", String
"#e55b3c", String
"#ff0000", String
"#ff2400"
  , String
"#f62217", String
"#f70d1a", String
"#f62817", String
"#e42217", String
"#e41b17", String
"#dc381f", String
"#c34a2c"
  , String
"#c24641", String
"#c04000", String
"#c11b17", String
"#9f000f", String
"#990012", String
"#8c001a", String
"#7e3517"
  , String
"#8a4117", String
"#7e3817", String
"#800517", String
"#810541", String
"#7d0541", String
"#7e354d", String
"#7d0552"
  , String
"#7f4e52", String
"#7f5a58", String
"#7f525d", String
"#b38481", String
"#c5908e", String
"#c48189", String
"#c48793"
  , String
"#e8adaa", String
"#edc9af", String
"#fdd7e4", String
"#fcdfff", String
"#ffdfdd", String
"#fbbbb9", String
"#faafbe"
  , String
"#faafba", String
"#f9a7b0", String
"#e7a1b0", String
"#e799a3", String
"#e38aae", String
"#f778a1", String
"#e56e94"
  , String
"#f660ab", String
"#fc6c85", String
"#f6358a", String
"#f52887", String
"#e45e9d", String
"#e4287c", String
"#f535aa"
  , String
"#ff00ff", String
"#e3319d", String
"#f433ff", String
"#d16587", String
"#c25a7c", String
"#ca226b", String
"#c12869"
  , String
"#c12267", String
"#c25283", String
"#c12283", String
"#b93b8f", String
"#7e587e", String
"#571b7e", String
"#583759"
  , String
"#4b0082", String
"#461b7e", String
"#4e387e", String
"#614051", String
"#5e5a80", String
"#6a287e", String
"#7d1b7e"
  , String
"#a74ac7", String
"#b048b5", String
"#6c2dc7", String
"#842dce", String
"#8d38c9", String
"#7a5dc7", String
"#7f38ec"
  , String
"#8e35ef", String
"#893bff", String
"#8467d7", String
"#a23bec", String
"#b041ff", String
"#c45aec", String
"#9172ec"
  , String
"#9e7bff", String
"#d462ff", String
"#e238ec", String
"#c38ec7", String
"#c8a2c8", String
"#e6a9ec", String
"#e0b0ff"
  , String
"#f9b7ff", String
"#d2b9d3", String
"#e9cfec", String
"#ebdde2", String
"#e3e4fa", String
"#fdeef4", String
"#fff5ee"
  , String
"#fefcff", String
"#ffffff" ]

webColorL :: [Kolor]
webColorL :: [Kolor]
webColorL = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\Kolor
x Kolor
y -> Kolor -> Double
f Kolor
x forall a. Ord a => a -> a -> Ordering
`compare` Kolor -> Double
f Kolor
y) [Kolor]
htmlColors
  where f :: Kolor -> Double
f = forall a. (Fractional a, Ord a) => RGB a -> a
hue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. (Ord b, Floating b) => Colour b -> RGB b
toSRGB

webColorA :: Array Int (Kolor)
webColorA :: Array Int Kolor
webColorA = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0, Int
numColorsforall a. Num a => a -> a -> a
-Int
1) [Kolor]
webColorL

rybColors :: [Kolor]
rybColors :: [Kolor]
rybColors =  forall a b. (a -> b) -> [a] -> [b]
map forall b. (Ord b, Floating b) => String -> Colour b
sRGB24read
  [ String
"#ff0000", String
"#ff4900", String
"#ff7400", String
"#ff9200", String
"#ffaa00"
  , String
"#ffbf00", String
"#ffd300", String
"#ffe800", String
"#ffff00", String
"#ccf600"
  , String
"#9fee00", String
"#67e300", String
"#00cc00", String
"#00af64", String
"#009999"
  , String
"#0b61a4", String
"#1240ab", String
"#1b1bb3", String
"#3914af", String
"#530fad"
  , String
"#7109aa", String
"#a600a6", String
"#cd0074", String
"#e40045"]

rybColorA :: Array Int (Kolor)
rybColorA :: Array Int Kolor
rybColorA = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
23) [Kolor]
rybColors