{-# LANGUAGE OverloadedStrings #-}
module Clay.Color where

import Data.Char (isHexDigit)
import Data.String
import Text.Printf

import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Read as Text

import Clay.Property
import Clay.Common

-- * Color datatype.

data Color
  = Rgba Integer Integer Integer Float
  | Hsla Integer Float   Float   Float
  | Other Value
  deriving (Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
(Int -> Color -> ShowS)
-> (Color -> String) -> ([Color] -> ShowS) -> Show Color
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Color] -> ShowS
$cshowList :: [Color] -> ShowS
show :: Color -> String
$cshow :: Color -> String
showsPrec :: Int -> Color -> ShowS
$cshowsPrec :: Int -> Color -> ShowS
Show, Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c== :: Color -> Color -> Bool
Eq)

-- * Color constructors.

rgba :: Integer -> Integer -> Integer -> Float -> Color
rgba :: Integer -> Integer -> Integer -> Float -> Color
rgba = Integer -> Integer -> Integer -> Float -> Color
Rgba

rgb :: Integer -> Integer -> Integer -> Color
rgb :: Integer -> Integer -> Integer -> Color
rgb Integer
r Integer
g Integer
b = Integer -> Integer -> Integer -> Float -> Color
rgba Integer
r Integer
g Integer
b Float
1

hsla :: Integer -> Float -> Float -> Float -> Color
hsla :: Integer -> Float -> Float -> Float -> Color
hsla = Integer -> Float -> Float -> Float -> Color
Hsla

hsl :: Integer -> Float -> Float -> Color
hsl :: Integer -> Float -> Float -> Color
hsl Integer
r Float
g Float
b = Integer -> Float -> Float -> Float -> Color
hsla Integer
r Float
g Float
b Float
1

grayish :: Integer -> Color
grayish :: Integer -> Color
grayish Integer
g = Integer -> Integer -> Integer -> Color
rgb Integer
g Integer
g Integer
g

transparent :: Color
transparent :: Color
transparent = Integer -> Integer -> Integer -> Float -> Color
rgba Integer
0 Integer
0 Integer
0 Float
0

-- * Setting individual color components.

setR :: Integer -> Color -> Color
setR :: Integer -> Color -> Color
setR Integer
r (Rgba Integer
_ Integer
g Integer
b Float
a) = Integer -> Integer -> Integer -> Float -> Color
Rgba Integer
r Integer
g Integer
b Float
a
setR Integer
_ Color
o              = Color
o

setG :: Integer -> Color -> Color
setG :: Integer -> Color -> Color
setG Integer
g (Rgba Integer
r Integer
_ Integer
b Float
a) = Integer -> Integer -> Integer -> Float -> Color
Rgba Integer
r Integer
g Integer
b Float
a
setG Integer
_ Color
o              = Color
o

setB :: Integer -> Color -> Color
setB :: Integer -> Color -> Color
setB Integer
b (Rgba Integer
r Integer
g Integer
_ Float
a) = Integer -> Integer -> Integer -> Float -> Color
Rgba Integer
r Integer
g Integer
b Float
a
setB Integer
_ Color
o              = Color
o

setA :: Float -> Color -> Color
setA :: Float -> Color -> Color
setA Float
a (Rgba Integer
r Integer
g Integer
b Float
_) = Integer -> Integer -> Integer -> Float -> Color
Rgba Integer
r Integer
g Integer
b Float
a
setA Float
a (Hsla Integer
r Float
g Float
b Float
_) = Integer -> Float -> Float -> Float -> Color
Hsla Integer
r Float
g Float
b Float
a
setA Float
_ Color
o              = Color
o

-- * Color conversions.

toRgba :: Color -> Color
toRgba :: Color -> Color
toRgba Color
color =
    case Color
color of
        Hsla Integer
h Float
s Float
l Float
a -> (Float, Float, Float) -> Float -> Color
toRgba' (Float, Float, Float)
rgb' Float
a
              where sextant :: Float
sextant = Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
h Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
60.0
                    chroma :: Float
chroma = (Float
s Float -> Float -> Float
forall a. Num a => a -> a -> a
*) (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float
1.0 Float -> Float -> Float
forall a. Num a => a -> a -> a
-) (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ (Float
2.0 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
l) Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
1.0
                    x :: Float
x = (Float
chroma Float -> Float -> Float
forall a. Num a => a -> a -> a
*) (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float
1.0 Float -> Float -> Float
forall a. Num a => a -> a -> a
-) (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ (Float
sextant Float -> Float -> Float
forall a. RealFrac a => a -> a -> a
`fracMod` Float
2) Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
1.0
                    lightnessAdjustment :: Float
lightnessAdjustment = Float
l Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Float
chroma Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2.0)

                    toRgbPart :: Float -> c
toRgbPart Float
component = Float -> c
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> c) -> (Float -> Float) -> Float -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
255.0) (Float -> c) -> Float -> c
forall a b. (a -> b) -> a -> b
$ Float
component Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
lightnessAdjustment
                    toRgba' :: (Float, Float, Float) -> Float -> Color
toRgba' (Float
r, Float
g, Float
b) = Integer -> Integer -> Integer -> Float -> Color
Rgba (Float -> Integer
forall c. Integral c => Float -> c
toRgbPart Float
r) (Float -> Integer
forall c. Integral c => Float -> c
toRgbPart Float
g) (Float -> Integer
forall c. Integral c => Float -> c
toRgbPart Float
b)

                    rgb' :: (Float, Float, Float)
rgb' | Integer
h Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0   Bool -> Bool -> Bool
&& Integer
h Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<  Integer
60 = (Float
chroma, Float
x     ,  Float
0)
                         | Integer
h Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
60  Bool -> Bool -> Bool
&& Integer
h Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
120 = (Float
x     , Float
chroma,  Float
0)
                         | Integer
h Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
120 Bool -> Bool -> Bool
&& Integer
h Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
180 = (Float
0     , Float
chroma,  Float
x)
                         | Integer
h Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
180 Bool -> Bool -> Bool
&& Integer
h Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
240 = (Float
0     , Float
x     ,  Float
chroma)
                         | Integer
h Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
240 Bool -> Bool -> Bool
&& Integer
h Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
300 = (Float
x     , Float
0     ,  Float
chroma)
                         | Bool
otherwise           = (Float
chroma, Float
0     ,  Float
x)

        c :: Color
c@(Rgba Integer
_ Integer
_ Integer
_ Float
_) -> Color
c
        
        Other Value
_          -> String -> Color
forall a. HasCallStack => String -> a
error String
"Invalid to pass Other to toRgba."


toHsla :: Color -> Color
toHsla :: Color -> Color
toHsla Color
color =
    case Color
color of
        Rgba Integer
redComponent Integer
greenComponent Integer
blueComponent Float
alphaComponent -> Integer -> Float -> Float -> Float -> Color
Hsla Integer
h (Float -> Int -> Float
forall a. RealFrac a => a -> Int -> a
decimalRound Float
s Int
3) (Float -> Int -> Float
forall a. RealFrac a => a -> Int -> a
decimalRound Float
l Int
3) Float
alphaComponent
            where r :: Float
r = Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
redComponent   Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
255.0
                  g :: Float
g = Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
greenComponent Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
255.0
                  b :: Float
b = Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
blueComponent  Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
255.0

                  minColor :: Float
minColor = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Float
r, Float
g, Float
b]
                  maxColor :: Float
maxColor = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Float
r, Float
g, Float
b]
                  delta :: Float
delta = Float
maxColor Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
minColor

                  l :: Float
l = (Float
minColor Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
maxColor) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2.0
                  s :: Float
s = if Float
delta Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0.0 then Float
0.0
                      else (Float
delta Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/) (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float
1.0 Float -> Float -> Float
forall a. Num a => a -> a -> a
-) (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ (Float
2.0 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
l) Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
1.0

                  h' :: Float
h' | Float
delta Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0.0 = Float
0.0
                     | Float
r Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
maxColor = ((Float
g Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
b) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
delta) Float -> Float -> Float
forall a. RealFrac a => a -> a -> a
`fracMod` Float
6.0
                     | Float
g Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
maxColor = ((Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
r) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
delta) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
2.0
                     | Bool
otherwise     = ((Float
r Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
g) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
delta) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
4.0

                  h'' :: Integer
h'' = Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Integer) -> Float -> Integer
forall a b. (a -> b) -> a -> b
$ Float
60 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
h'
                  h :: Integer
h = if Integer
h'' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then Integer
h''Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
360 else Integer
h''

        c :: Color
c@(Hsla Integer
_ Float
_ Float
_ Float
_) -> Color
c
        
        Other Value
_          -> String -> Color
forall a. HasCallStack => String -> a
error String
"Invalid to pass Other to toHsla."

-- * Computing with colors.

(*.) :: Color -> Integer -> Color
*. :: Color -> Integer -> Color
(*.) (Rgba Integer
r Integer
g Integer
b Float
a) Integer
i = Integer -> Integer -> Integer -> Float -> Color
Rgba (Integer -> Integer
forall a. (Ord a, Num a) => a -> a
clamp (Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i)) (Integer -> Integer
forall a. (Ord a, Num a) => a -> a
clamp (Integer
g Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i)) (Integer -> Integer
forall a. (Ord a, Num a) => a -> a
clamp (Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i)) Float
a
(*.) Color
o              Integer
_ = Color
o
infixl 7 *.

(+.) :: Color -> Integer -> Color
+. :: Color -> Integer -> Color
(+.) (Rgba Integer
r Integer
g Integer
b Float
a) Integer
i = Integer -> Integer -> Integer -> Float -> Color
Rgba (Integer -> Integer
forall a. (Ord a, Num a) => a -> a
clamp (Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
i)) (Integer -> Integer
forall a. (Ord a, Num a) => a -> a
clamp (Integer
g Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
i)) (Integer -> Integer
forall a. (Ord a, Num a) => a -> a
clamp (Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
i)) Float
a
(+.) Color
o              Integer
_ = Color
o
infixl 6 +.

(-.) :: Color -> Integer -> Color
-. :: Color -> Integer -> Color
(-.) (Rgba Integer
r Integer
g Integer
b Float
a) Integer
i = Integer -> Integer -> Integer -> Float -> Color
Rgba (Integer -> Integer
forall a. (Ord a, Num a) => a -> a
clamp (Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
i)) (Integer -> Integer
forall a. (Ord a, Num a) => a -> a
clamp (Integer
g Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
i)) (Integer -> Integer
forall a. (Ord a, Num a) => a -> a
clamp (Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
i)) Float
a
(-.) Color
o              Integer
_ = Color
o
infixl 6 -.

clamp :: Ord a => Num a => a -> a
clamp :: a -> a
clamp a
i = a -> a -> a
forall a. Ord a => a -> a -> a
max (a -> a -> a
forall a. Ord a => a -> a -> a
min a
i (Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
255 :: Integer))) (Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
0 :: Integer))

lighten :: Float -> Color -> Color
lighten :: Float -> Color -> Color
lighten Float
factor Color
color =
    case Color
color of
        c :: Color
c@(Hsla {}) -> Color -> Color
toHsla (Color -> Color) -> Color -> Color
forall a b. (a -> b) -> a -> b
$ Float -> Color -> Color
lighten Float
factor (Color -> Color
toRgba Color
c)
        c :: Color
c@(Rgba {}) -> Float -> Color -> Color -> Color
lerp Float
factor Color
c (Integer -> Integer -> Integer -> Float -> Color
Rgba Integer
255 Integer
255 Integer
255 Float
255)
        Other Value
_     -> String -> Color
forall a. HasCallStack => String -> a
error String
"Other cannot be lightened."

darken :: Float -> Color -> Color
darken :: Float -> Color -> Color
darken Float
factor Color
color =
    case Color
color of
        c :: Color
c@(Hsla {}) -> Color -> Color
toHsla (Color -> Color) -> Color -> Color
forall a b. (a -> b) -> a -> b
$ Float -> Color -> Color
darken Float
factor (Color -> Color
toRgba Color
c)
        c :: Color
c@(Rgba {}) -> Float -> Color -> Color -> Color
lerp Float
factor Color
c (Integer -> Integer -> Integer -> Float -> Color
Rgba Integer
0 Integer
0 Integer
0 Float
255)
        Other Value
_     -> String -> Color
forall a. HasCallStack => String -> a
error String
"Other cannot be darkened."

lerp :: Float -> Color -> Color -> Color
lerp :: Float -> Color -> Color -> Color
lerp Float
factor Color
startColor Color
boundColor =
    case (Color
startColor, Color
boundColor) of
        (Other Value
_, Color
_) -> String -> Color
forall a. HasCallStack => String -> a
error String
"Other cannot be lerped." 
        (Color
_, Other Value
_) -> String -> Color
forall a. HasCallStack => String -> a
error String
"Other cannot be lerped." 
        (color :: Color
color@(Hsla {}), Color
bound) -> Color -> Color
toHsla (Color -> Color) -> Color -> Color
forall a b. (a -> b) -> a -> b
$ Float -> Color -> Color -> Color
lerp Float
factor (Color -> Color
toRgba Color
color) Color
bound

        (Color
start, color :: Color
color@(Hsla {})) -> Color -> Color
toHsla (Color -> Color) -> Color -> Color
forall a b. (a -> b) -> a -> b
$ Float -> Color -> Color -> Color
lerp Float
factor Color
start (Color -> Color
toRgba Color
color)

        (Rgba Integer
r Integer
g Integer
b Float
a, Rgba Integer
r' Integer
g' Integer
b' Float
a') ->
            Integer -> Integer -> Integer -> Float -> Color
Rgba
                (Float -> Integer -> Integer -> Integer
lerpComponent Float
factor Integer
r Integer
r')
                (Float -> Integer -> Integer -> Integer
lerpComponent Float
factor Integer
g Integer
g')
                (Float -> Integer -> Integer -> Integer
lerpComponent Float
factor Integer
b Integer
b')
                (Float -> Float -> Float -> Float
lerpAlpha Float
factor Float
a Float
a')
            where lerpComponent :: Float -> Integer -> Integer -> Integer
                  lerpComponent :: Float -> Integer -> Integer -> Integer
lerpComponent Float
amount Integer
start Integer
bound =
                    let difference :: Integer
difference = Integer
bound Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
start
                        adjustment :: Integer
adjustment = Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Integer) -> Float -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
difference Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
amount
                    in Integer -> Integer
forall a. (Ord a, Num a) => a -> a
clamp (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer
start Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
adjustment
                  lerpAlpha :: Float -> Float -> Float -> Float
                  lerpAlpha :: Float -> Float -> Float -> Float
lerpAlpha Float
amount Float
start Float
bound =
                    let difference :: Float
difference = Float
bound Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
start
                        adjustment :: Float
adjustment = Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Float) -> Integer -> Float
forall a b. (a -> b) -> a -> b
$ (Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Integer) -> Float -> Integer
forall a b. (a -> b) -> a -> b
$ Float
difference Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
amount :: Integer)
                    in Float -> Float
forall a. (Ord a, Num a) => a -> a
clamp (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
start Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
adjustment

-------------------------------------------------------------------------------

instance Val Color where
  value :: Color -> Value
value Color
clr =
    case Color
clr of
      Rgba Integer
r Integer
g Integer
b Float
1.0 -> Prefixed -> Value
Value (Prefixed -> Value) -> Prefixed -> Value
forall a b. (a -> b) -> a -> b
$[Prefixed] -> Prefixed
forall a. Monoid a => [a] -> a
mconcat [Prefixed
"#",  Integer -> Prefixed
p' Integer
r, Integer -> Prefixed
p' Integer
g, Integer -> Prefixed
p' Integer
b]
      Rgba Integer
r Integer
g Integer
b Float
a   -> Prefixed -> Value
Value (Prefixed -> Value) -> Prefixed -> Value
forall a b. (a -> b) -> a -> b
$[Prefixed] -> Prefixed
forall a. Monoid a => [a] -> a
mconcat [Prefixed
"rgba(", Integer -> Prefixed
p Integer
r, Prefixed
",", Integer -> Prefixed
p Integer
g, Prefixed
",", Integer -> Prefixed
p Integer
b, Prefixed
",", Float -> Prefixed
ah Float
a, Prefixed
")"]
      Hsla Integer
h Float
s Float
l Float
1.0 -> Prefixed -> Value
Value (Prefixed -> Value) -> Prefixed -> Value
forall a b. (a -> b) -> a -> b
$[Prefixed] -> Prefixed
forall a. Monoid a => [a] -> a
mconcat [Prefixed
"hsl(",  Integer -> Prefixed
p Integer
h, Prefixed
",", Float -> Prefixed
f Float
s, Prefixed
",", Float -> Prefixed
f Float
l,            Prefixed
")"]
      Hsla Integer
h Float
s Float
l Float
a   -> Prefixed -> Value
Value (Prefixed -> Value) -> Prefixed -> Value
forall a b. (a -> b) -> a -> b
$[Prefixed] -> Prefixed
forall a. Monoid a => [a] -> a
mconcat [Prefixed
"hsla(", Integer -> Prefixed
p Integer
h, Prefixed
",", Float -> Prefixed
f Float
s, Prefixed
",", Float -> Prefixed
f Float
l, Prefixed
",", Float -> Prefixed
ah Float
a, Prefixed
")"]
      Other Value
o        -> Value
o
    where p :: Integer -> Prefixed
p  = String -> Prefixed
forall a. IsString a => String -> a
fromString (String -> Prefixed) -> (Integer -> String) -> Integer -> Prefixed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show
          p' :: Integer -> Prefixed
p' = String -> Prefixed
forall a. IsString a => String -> a
fromString (String -> Prefixed) -> (Integer -> String) -> Integer -> Prefixed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Integer -> String
forall r. PrintfType r => String -> r
printf String
"%02x"
          f :: Float -> Prefixed
f  = String -> Prefixed
forall a. IsString a => String -> a
fromString (String -> Prefixed) -> (Float -> String) -> Float -> Prefixed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Float -> String
forall r. PrintfType r => String -> r
printf String
"%.4f%%"
          ah :: Float -> Prefixed
ah = String -> Prefixed
forall a. IsString a => String -> a
fromString (String -> Prefixed) -> (Float -> String) -> Float -> Prefixed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
6 ShowS -> (Float -> String) -> Float -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> String
forall a. Show a => a -> String
show

instance None    Color where none :: Color
none    = Value -> Color
Other Value
"none"
instance Auto    Color where auto :: Color
auto    = Value -> Color
Other Value
"auto"
instance Inherit Color where inherit :: Color
inherit = Value -> Color
Other Value
"inherit"
instance Other   Color where other :: Value -> Color
other   = Value -> Color
Other

instance IsString Color where
  fromString :: String -> Color
fromString = Text -> Color
parse (Text -> Color) -> (String -> Text) -> String -> Color
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

parse :: Text -> Color
parse :: Text -> Color
parse Text
t =
  case Text -> Maybe (Char, Text)
Text.uncons Text
t of
    Just (Char
'#', Text
cs) | (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
isHexDigit Text
cs ->
      case Text -> String
Text.unpack Text
cs of
        [Char
a, Char
b, Char
c, Char
d, Char
e, Char
f, Char
g, Char
h] -> Integer -> Integer -> Integer -> Float -> Color
rgba (Char -> Char -> Integer
forall c. Integral c => Char -> Char -> c
hex Char
a Char
b) (Char -> Char -> Integer
forall c. Integral c => Char -> Char -> c
hex Char
c Char
d) (Char -> Char -> Integer
forall c. Integral c => Char -> Char -> c
hex Char
e Char
f) (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Char -> Integer
forall c. Integral c => Char -> Char -> c
hex Char
g Char
h :: Integer) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
255.0)
        [Char
a, Char
b, Char
c, Char
d, Char
e, Char
f      ] -> Integer -> Integer -> Integer -> Color
rgb  (Char -> Char -> Integer
forall c. Integral c => Char -> Char -> c
hex Char
a Char
b) (Char -> Char -> Integer
forall c. Integral c => Char -> Char -> c
hex Char
c Char
d) (Char -> Char -> Integer
forall c. Integral c => Char -> Char -> c
hex Char
e Char
f)
        [Char
a, Char
b, Char
c, Char
d            ] -> Integer -> Integer -> Integer -> Float -> Color
rgba (Char -> Char -> Integer
forall c. Integral c => Char -> Char -> c
hex Char
a Char
a) (Char -> Char -> Integer
forall c. Integral c => Char -> Char -> c
hex Char
b Char
b) (Char -> Char -> Integer
forall c. Integral c => Char -> Char -> c
hex Char
c Char
c) (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Char -> Integer
forall c. Integral c => Char -> Char -> c
hex Char
d Char
d :: Integer) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
255.0)
        [Char
a, Char
b, Char
c               ] -> Integer -> Integer -> Integer -> Color
rgb  (Char -> Char -> Integer
forall c. Integral c => Char -> Char -> c
hex Char
a Char
a) (Char -> Char -> Integer
forall c. Integral c => Char -> Char -> c
hex Char
b Char
b) (Char -> Char -> Integer
forall c. Integral c => Char -> Char -> c
hex Char
c Char
c)
        String
_                        -> Color
forall a. a
err
    Maybe (Char, Text)
_                            -> Color
forall a. a
err

  where
    hex :: Char -> Char -> c
hex Char
a Char
b = (String -> c) -> ((c, Text) -> c) -> Either String (c, Text) -> c
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> c
forall a. a
err (c, Text) -> c
forall a b. (a, b) -> a
fst (Reader c
forall a. Integral a => Reader a
Text.hexadecimal (Char -> Text
Text.singleton Char
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
Text.singleton Char
b))
    err :: a
err = String -> a
forall a. HasCallStack => String -> a
error String
"Invalid color string"

-------------------------------------------------------------------------------

-- * List of color values by name.

aliceblue, antiquewhite, aqua, aquamarine, azure, beige, bisque, black,
  blanchedalmond, blue, blueviolet, brown, burlywood, cadetblue, chartreuse,
  chocolate, coral, cornflowerblue, cornsilk, crimson, cyan, darkblue,
  darkcyan, darkgoldenrod, darkgray, darkgreen, darkgrey, darkkhaki,
  darkmagenta, darkolivegreen, darkorange, darkorchid, darkred, darksalmon,
  darkseagreen, darkslateblue, darkslategray, darkslategrey, darkturquoise,
  darkviolet, deeppink, deepskyblue, dimgray, dimgrey, dodgerblue, firebrick,
  floralwhite, forestgreen, fuchsia, gainsboro, ghostwhite, gold, goldenrod,
  gray, green, greenyellow, grey, honeydew, hotpink, indianred, indigo, ivory,
  khaki, lavender, lavenderblush, lawngreen, lemonchiffon, lightblue,
  lightcoral, lightcyan, lightgoldenrodyellow, lightgray, lightgreen,
  lightgrey, lightpink, lightsalmon, lightseagreen, lightskyblue,
  lightslategray, lightslategrey, lightsteelblue, lightyellow, lime, limegreen,
  linen, magenta, maroon, mediumaquamarine, mediumblue, mediumorchid,
  mediumpurple, mediumseagreen, mediumslateblue, mediumspringgreen,
  mediumturquoise, mediumvioletred, midnightblue, mintcream, mistyrose,
  moccasin, navajowhite, navy, oldlace, olive, olivedrab, orange, orangered,
  orchid, palegoldenrod, palegreen, paleturquoise, palevioletred, papayawhip,
  peachpuff, peru, pink, plum, powderblue, purple, red, rosybrown, royalblue,
  saddlebrown, salmon, sandybrown, seagreen, seashell, sienna, silver, skyblue,
  slateblue, slategray, slategrey, snow, springgreen, steelblue, tan, teal,
  thistle, tomato, turquoise, violet, wheat, white, whitesmoke, yellow,
  yellowgreen :: Color

aliceblue :: Color
aliceblue            = Integer -> Integer -> Integer -> Color
rgb Integer
240 Integer
248 Integer
255
antiquewhite :: Color
antiquewhite         = Integer -> Integer -> Integer -> Color
rgb Integer
250 Integer
235 Integer
215
aqua :: Color
aqua                 = Integer -> Integer -> Integer -> Color
rgb   Integer
0 Integer
255 Integer
255
aquamarine :: Color
aquamarine           = Integer -> Integer -> Integer -> Color
rgb Integer
127 Integer
255 Integer
212
azure :: Color
azure                = Integer -> Integer -> Integer -> Color
rgb Integer
240 Integer
255 Integer
255
beige :: Color
beige                = Integer -> Integer -> Integer -> Color
rgb Integer
245 Integer
245 Integer
220
bisque :: Color
bisque               = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
228 Integer
196
black :: Color
black                = Integer -> Integer -> Integer -> Color
rgb   Integer
0   Integer
0   Integer
0
blanchedalmond :: Color
blanchedalmond       = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
235 Integer
205
blue :: Color
blue                 = Integer -> Integer -> Integer -> Color
rgb   Integer
0   Integer
0 Integer
255
blueviolet :: Color
blueviolet           = Integer -> Integer -> Integer -> Color
rgb Integer
138  Integer
43 Integer
226
brown :: Color
brown                = Integer -> Integer -> Integer -> Color
rgb Integer
165  Integer
42  Integer
42
burlywood :: Color
burlywood            = Integer -> Integer -> Integer -> Color
rgb Integer
222 Integer
184 Integer
135
cadetblue :: Color
cadetblue            = Integer -> Integer -> Integer -> Color
rgb  Integer
95 Integer
158 Integer
160
chartreuse :: Color
chartreuse           = Integer -> Integer -> Integer -> Color
rgb Integer
127 Integer
255   Integer
0
chocolate :: Color
chocolate            = Integer -> Integer -> Integer -> Color
rgb Integer
210 Integer
105  Integer
30
coral :: Color
coral                = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
127  Integer
80
cornflowerblue :: Color
cornflowerblue       = Integer -> Integer -> Integer -> Color
rgb Integer
100 Integer
149 Integer
237
cornsilk :: Color
cornsilk             = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
248 Integer
220
crimson :: Color
crimson              = Integer -> Integer -> Integer -> Color
rgb Integer
220  Integer
20  Integer
60
cyan :: Color
cyan                 = Integer -> Integer -> Integer -> Color
rgb   Integer
0 Integer
255 Integer
255
darkblue :: Color
darkblue             = Integer -> Integer -> Integer -> Color
rgb   Integer
0   Integer
0 Integer
139
darkcyan :: Color
darkcyan             = Integer -> Integer -> Integer -> Color
rgb   Integer
0 Integer
139 Integer
139
darkgoldenrod :: Color
darkgoldenrod        = Integer -> Integer -> Integer -> Color
rgb Integer
184 Integer
134  Integer
11
darkgray :: Color
darkgray             = Integer -> Integer -> Integer -> Color
rgb Integer
169 Integer
169 Integer
169
darkgreen :: Color
darkgreen            = Integer -> Integer -> Integer -> Color
rgb   Integer
0 Integer
100   Integer
0
darkgrey :: Color
darkgrey             = Integer -> Integer -> Integer -> Color
rgb Integer
169 Integer
169 Integer
169
darkkhaki :: Color
darkkhaki            = Integer -> Integer -> Integer -> Color
rgb Integer
189 Integer
183 Integer
107
darkmagenta :: Color
darkmagenta          = Integer -> Integer -> Integer -> Color
rgb Integer
139   Integer
0 Integer
139
darkolivegreen :: Color
darkolivegreen       = Integer -> Integer -> Integer -> Color
rgb  Integer
85 Integer
107  Integer
47
darkorange :: Color
darkorange           = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
140   Integer
0
darkorchid :: Color
darkorchid           = Integer -> Integer -> Integer -> Color
rgb Integer
153  Integer
50 Integer
204
darkred :: Color
darkred              = Integer -> Integer -> Integer -> Color
rgb Integer
139   Integer
0   Integer
0
darksalmon :: Color
darksalmon           = Integer -> Integer -> Integer -> Color
rgb Integer
233 Integer
150 Integer
122
darkseagreen :: Color
darkseagreen         = Integer -> Integer -> Integer -> Color
rgb Integer
143 Integer
188 Integer
143
darkslateblue :: Color
darkslateblue        = Integer -> Integer -> Integer -> Color
rgb  Integer
72  Integer
61 Integer
139
darkslategray :: Color
darkslategray        = Integer -> Integer -> Integer -> Color
rgb  Integer
47  Integer
79  Integer
79
darkslategrey :: Color
darkslategrey        = Integer -> Integer -> Integer -> Color
rgb  Integer
47  Integer
79  Integer
79
darkturquoise :: Color
darkturquoise        = Integer -> Integer -> Integer -> Color
rgb   Integer
0 Integer
206 Integer
209
darkviolet :: Color
darkviolet           = Integer -> Integer -> Integer -> Color
rgb Integer
148   Integer
0 Integer
211
deeppink :: Color
deeppink             = Integer -> Integer -> Integer -> Color
rgb Integer
255  Integer
20 Integer
147
deepskyblue :: Color
deepskyblue          = Integer -> Integer -> Integer -> Color
rgb   Integer
0 Integer
191 Integer
255
dimgray :: Color
dimgray              = Integer -> Integer -> Integer -> Color
rgb Integer
105 Integer
105 Integer
105
dimgrey :: Color
dimgrey              = Integer -> Integer -> Integer -> Color
rgb Integer
105 Integer
105 Integer
105
dodgerblue :: Color
dodgerblue           = Integer -> Integer -> Integer -> Color
rgb  Integer
30 Integer
144 Integer
255
firebrick :: Color
firebrick            = Integer -> Integer -> Integer -> Color
rgb Integer
178  Integer
34  Integer
34
floralwhite :: Color
floralwhite          = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
250 Integer
240
forestgreen :: Color
forestgreen          = Integer -> Integer -> Integer -> Color
rgb Integer
34  Integer
139  Integer
34
fuchsia :: Color
fuchsia              = Integer -> Integer -> Integer -> Color
rgb Integer
255   Integer
0 Integer
255
gainsboro :: Color
gainsboro            = Integer -> Integer -> Integer -> Color
rgb Integer
220 Integer
220 Integer
220
ghostwhite :: Color
ghostwhite           = Integer -> Integer -> Integer -> Color
rgb Integer
248 Integer
248 Integer
255
gold :: Color
gold                 = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
215   Integer
0
goldenrod :: Color
goldenrod            = Integer -> Integer -> Integer -> Color
rgb Integer
218 Integer
165  Integer
32
gray :: Color
gray                 = Integer -> Integer -> Integer -> Color
rgb Integer
128 Integer
128 Integer
128
green :: Color
green                = Integer -> Integer -> Integer -> Color
rgb   Integer
0 Integer
128   Integer
0
greenyellow :: Color
greenyellow          = Integer -> Integer -> Integer -> Color
rgb Integer
173 Integer
255  Integer
47
grey :: Color
grey                 = Integer -> Integer -> Integer -> Color
rgb Integer
128 Integer
128 Integer
128
honeydew :: Color
honeydew             = Integer -> Integer -> Integer -> Color
rgb Integer
240 Integer
255 Integer
240
hotpink :: Color
hotpink              = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
105 Integer
180
indianred :: Color
indianred            = Integer -> Integer -> Integer -> Color
rgb Integer
205  Integer
92  Integer
92
indigo :: Color
indigo               = Integer -> Integer -> Integer -> Color
rgb Integer
75    Integer
0 Integer
130
ivory :: Color
ivory                = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
255 Integer
240
khaki :: Color
khaki                = Integer -> Integer -> Integer -> Color
rgb Integer
240 Integer
230 Integer
140
lavender :: Color
lavender             = Integer -> Integer -> Integer -> Color
rgb Integer
230 Integer
230 Integer
250
lavenderblush :: Color
lavenderblush        = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
240 Integer
245
lawngreen :: Color
lawngreen            = Integer -> Integer -> Integer -> Color
rgb Integer
124 Integer
252   Integer
0
lemonchiffon :: Color
lemonchiffon         = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
250 Integer
205
lightblue :: Color
lightblue            = Integer -> Integer -> Integer -> Color
rgb Integer
173 Integer
216 Integer
230
lightcoral :: Color
lightcoral           = Integer -> Integer -> Integer -> Color
rgb Integer
240 Integer
128 Integer
128
lightcyan :: Color
lightcyan            = Integer -> Integer -> Integer -> Color
rgb Integer
224 Integer
255 Integer
255
lightgoldenrodyellow :: Color
lightgoldenrodyellow = Integer -> Integer -> Integer -> Color
rgb Integer
250 Integer
250 Integer
210
lightgray :: Color
lightgray            = Integer -> Integer -> Integer -> Color
rgb Integer
211 Integer
211 Integer
211
lightgreen :: Color
lightgreen           = Integer -> Integer -> Integer -> Color
rgb Integer
144 Integer
238 Integer
144
lightgrey :: Color
lightgrey            = Integer -> Integer -> Integer -> Color
rgb Integer
211 Integer
211 Integer
211
lightpink :: Color
lightpink            = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
182 Integer
193
lightsalmon :: Color
lightsalmon          = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
160 Integer
122
lightseagreen :: Color
lightseagreen        = Integer -> Integer -> Integer -> Color
rgb  Integer
32 Integer
178 Integer
170
lightskyblue :: Color
lightskyblue         = Integer -> Integer -> Integer -> Color
rgb Integer
135 Integer
206 Integer
250
lightslategray :: Color
lightslategray       = Integer -> Integer -> Integer -> Color
rgb Integer
119 Integer
136 Integer
153
lightslategrey :: Color
lightslategrey       = Integer -> Integer -> Integer -> Color
rgb Integer
119 Integer
136 Integer
153
lightsteelblue :: Color
lightsteelblue       = Integer -> Integer -> Integer -> Color
rgb Integer
176 Integer
196 Integer
222
lightyellow :: Color
lightyellow          = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
255 Integer
224
lime :: Color
lime                 = Integer -> Integer -> Integer -> Color
rgb   Integer
0 Integer
255   Integer
0
limegreen :: Color
limegreen            = Integer -> Integer -> Integer -> Color
rgb  Integer
50 Integer
205  Integer
50
linen :: Color
linen                = Integer -> Integer -> Integer -> Color
rgb Integer
250 Integer
240 Integer
230
magenta :: Color
magenta              = Integer -> Integer -> Integer -> Color
rgb Integer
255   Integer
0 Integer
255
maroon :: Color
maroon               = Integer -> Integer -> Integer -> Color
rgb Integer
128   Integer
0   Integer
0
mediumaquamarine :: Color
mediumaquamarine     = Integer -> Integer -> Integer -> Color
rgb Integer
102 Integer
205 Integer
170
mediumblue :: Color
mediumblue           = Integer -> Integer -> Integer -> Color
rgb   Integer
0   Integer
0 Integer
205
mediumorchid :: Color
mediumorchid         = Integer -> Integer -> Integer -> Color
rgb Integer
186  Integer
85 Integer
211
mediumpurple :: Color
mediumpurple         = Integer -> Integer -> Integer -> Color
rgb Integer
147 Integer
112 Integer
219
mediumseagreen :: Color
mediumseagreen       = Integer -> Integer -> Integer -> Color
rgb  Integer
60 Integer
179 Integer
113
mediumslateblue :: Color
mediumslateblue      = Integer -> Integer -> Integer -> Color
rgb Integer
123 Integer
104 Integer
238
mediumspringgreen :: Color
mediumspringgreen    = Integer -> Integer -> Integer -> Color
rgb   Integer
0 Integer
250 Integer
154
mediumturquoise :: Color
mediumturquoise      = Integer -> Integer -> Integer -> Color
rgb  Integer
72 Integer
209 Integer
204
mediumvioletred :: Color
mediumvioletred      = Integer -> Integer -> Integer -> Color
rgb Integer
199  Integer
21 Integer
133
midnightblue :: Color
midnightblue         = Integer -> Integer -> Integer -> Color
rgb  Integer
25  Integer
25 Integer
112
mintcream :: Color
mintcream            = Integer -> Integer -> Integer -> Color
rgb Integer
245 Integer
255 Integer
250
mistyrose :: Color
mistyrose            = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
228 Integer
225
moccasin :: Color
moccasin             = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
228 Integer
181
navajowhite :: Color
navajowhite          = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
222 Integer
173
navy :: Color
navy                 = Integer -> Integer -> Integer -> Color
rgb   Integer
0   Integer
0 Integer
128
oldlace :: Color
oldlace              = Integer -> Integer -> Integer -> Color
rgb Integer
253 Integer
245 Integer
230
olive :: Color
olive                = Integer -> Integer -> Integer -> Color
rgb Integer
128 Integer
128   Integer
0
olivedrab :: Color
olivedrab            = Integer -> Integer -> Integer -> Color
rgb Integer
107 Integer
142  Integer
35
orange :: Color
orange               = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
165   Integer
0
orangered :: Color
orangered            = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
69    Integer
0
orchid :: Color
orchid               = Integer -> Integer -> Integer -> Color
rgb Integer
218 Integer
112 Integer
214
palegoldenrod :: Color
palegoldenrod        = Integer -> Integer -> Integer -> Color
rgb Integer
238 Integer
232 Integer
170
palegreen :: Color
palegreen            = Integer -> Integer -> Integer -> Color
rgb Integer
152 Integer
251 Integer
152
paleturquoise :: Color
paleturquoise        = Integer -> Integer -> Integer -> Color
rgb Integer
175 Integer
238 Integer
238
palevioletred :: Color
palevioletred        = Integer -> Integer -> Integer -> Color
rgb Integer
219 Integer
112 Integer
147
papayawhip :: Color
papayawhip           = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
239 Integer
213
peachpuff :: Color
peachpuff            = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
218 Integer
185
peru :: Color
peru                 = Integer -> Integer -> Integer -> Color
rgb Integer
205 Integer
133  Integer
63
pink :: Color
pink                 = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
192 Integer
203
plum :: Color
plum                 = Integer -> Integer -> Integer -> Color
rgb Integer
221 Integer
160 Integer
221
powderblue :: Color
powderblue           = Integer -> Integer -> Integer -> Color
rgb Integer
176 Integer
224 Integer
230
purple :: Color
purple               = Integer -> Integer -> Integer -> Color
rgb Integer
128   Integer
0 Integer
128
red :: Color
red                  = Integer -> Integer -> Integer -> Color
rgb Integer
255   Integer
0   Integer
0
rosybrown :: Color
rosybrown            = Integer -> Integer -> Integer -> Color
rgb Integer
188 Integer
143 Integer
143
royalblue :: Color
royalblue            = Integer -> Integer -> Integer -> Color
rgb  Integer
65 Integer
105 Integer
225
saddlebrown :: Color
saddlebrown          = Integer -> Integer -> Integer -> Color
rgb Integer
139  Integer
69  Integer
19
salmon :: Color
salmon               = Integer -> Integer -> Integer -> Color
rgb Integer
250 Integer
128 Integer
114
sandybrown :: Color
sandybrown           = Integer -> Integer -> Integer -> Color
rgb Integer
244 Integer
164  Integer
96
seagreen :: Color
seagreen             = Integer -> Integer -> Integer -> Color
rgb  Integer
46 Integer
139  Integer
87
seashell :: Color
seashell             = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
245 Integer
238
sienna :: Color
sienna               = Integer -> Integer -> Integer -> Color
rgb Integer
160  Integer
82  Integer
45
silver :: Color
silver               = Integer -> Integer -> Integer -> Color
rgb Integer
192 Integer
192 Integer
192
skyblue :: Color
skyblue              = Integer -> Integer -> Integer -> Color
rgb Integer
135 Integer
206 Integer
235
slateblue :: Color
slateblue            = Integer -> Integer -> Integer -> Color
rgb Integer
106  Integer
90 Integer
205
slategray :: Color
slategray            = Integer -> Integer -> Integer -> Color
rgb Integer
112 Integer
128 Integer
144
slategrey :: Color
slategrey            = Integer -> Integer -> Integer -> Color
rgb Integer
112 Integer
128 Integer
144
snow :: Color
snow                 = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
250 Integer
250
springgreen :: Color
springgreen          = Integer -> Integer -> Integer -> Color
rgb   Integer
0 Integer
255 Integer
127
steelblue :: Color
steelblue            = Integer -> Integer -> Integer -> Color
rgb  Integer
70 Integer
130 Integer
180
tan :: Color
tan                  = Integer -> Integer -> Integer -> Color
rgb Integer
210 Integer
180 Integer
140
teal :: Color
teal                 = Integer -> Integer -> Integer -> Color
rgb   Integer
0 Integer
128 Integer
128
thistle :: Color
thistle              = Integer -> Integer -> Integer -> Color
rgb Integer
216 Integer
191 Integer
216
tomato :: Color
tomato               = Integer -> Integer -> Integer -> Color
rgb Integer
255  Integer
99  Integer
71
turquoise :: Color
turquoise            = Integer -> Integer -> Integer -> Color
rgb  Integer
64 Integer
224 Integer
208
violet :: Color
violet               = Integer -> Integer -> Integer -> Color
rgb Integer
238 Integer
130 Integer
238
wheat :: Color
wheat                = Integer -> Integer -> Integer -> Color
rgb Integer
245 Integer
222 Integer
179
white :: Color
white                = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
255 Integer
255
whitesmoke :: Color
whitesmoke           = Integer -> Integer -> Integer -> Color
rgb Integer
245 Integer
245 Integer
245
yellow :: Color
yellow               = Integer -> Integer -> Integer -> Color
rgb Integer
255 Integer
255   Integer
0
yellowgreen :: Color
yellowgreen          = Integer -> Integer -> Integer -> Color
rgb Integer
154 Integer
205  Integer
50