{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
module CodeWorld.Color where
import Control.DeepSeq
import GHC.Generics (Generic)
data Color
= RGBA
!Double
!Double
!Double
!Double
deriving (forall x. Rep Color x -> Color
forall x. Color -> Rep Color x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Color x -> Color
$cfrom :: forall x. Color -> Rep Color x
Generic, Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
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
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)
instance NFData Color
type Colour = Color
pattern RGB :: Double -> Double -> Double -> Color
pattern $bRGB :: Double -> Double -> Double -> Color
$mRGB :: forall {r}.
Color -> (Double -> Double -> Double -> r) -> ((# #) -> r) -> r
RGB r g b = RGBA r g b 1
pattern HSL :: Double -> Double -> Double -> Color
pattern $bHSL :: Double -> Double -> Double -> Color
$mHSL :: forall {r}.
Color -> (Double -> Double -> Double -> r) -> ((# #) -> r) -> r
HSL h s l <-
(toHSL -> Just (h, s, l))
where
HSL Double
h Double
s Double
l = Double -> Double -> Double -> Color
fromHSL Double
h Double
s Double
l
fence :: Double -> Double
fence :: Double -> Double
fence = forall a. Ord a => a -> a -> a
max Double
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
min Double
1
wrapNum :: Double -> Double -> Double
wrapNum :: Double -> Double -> Double
wrapNum Double
lim Double
x = Double
x forall a. Num a => a -> a -> a
- forall a. Num a => Integer -> a
fromInteger (forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
x forall a. Fractional a => a -> a -> a
/ Double
lim)) forall a. Num a => a -> a -> a
* Double
lim
fenceColor :: Color -> Color
fenceColor :: Color -> Color
fenceColor (RGBA Double
r Double
g Double
b Double
a) = Double -> Double -> Double -> Double -> Color
RGBA (Double -> Double
fence Double
r) (Double -> Double
fence Double
g) (Double -> Double
fence Double
b) (Double -> Double
fence Double
a)
fromHSL :: Double -> Double -> Double -> Color
fromHSL :: Double -> Double -> Double -> Color
fromHSL (Double -> Double -> Double
wrapNum (Double
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi) -> Double
h) (Double -> Double
fence -> Double
s) (Double -> Double
fence -> Double
l) = Double -> Double -> Double -> Double -> Color
RGBA Double
r Double
g Double
b Double
1
where
m1 :: Double
m1 = Double
l forall a. Num a => a -> a -> a
* Double
2 forall a. Num a => a -> a -> a
- Double
m2
m2 :: Double
m2
| Double
l forall a. Ord a => a -> a -> Bool
<= Double
0.5 = Double
l forall a. Num a => a -> a -> a
* (Double
s forall a. Num a => a -> a -> a
+ Double
1)
| Bool
otherwise = Double
l forall a. Num a => a -> a -> a
+ Double
s forall a. Num a => a -> a -> a
- Double
l forall a. Num a => a -> a -> a
* Double
s
r :: Double
r = forall {a}. (Ord a, Fractional a) => a -> a -> a -> a
convert Double
m1 Double
m2 (Double
h forall a. Fractional a => a -> a -> a
/ Double
2 forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a
pi forall a. Num a => a -> a -> a
+ Double
1 forall a. Fractional a => a -> a -> a
/ Double
3)
g :: Double
g = forall {a}. (Ord a, Fractional a) => a -> a -> a -> a
convert Double
m1 Double
m2 (Double
h forall a. Fractional a => a -> a -> a
/ Double
2 forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a
pi)
b :: Double
b = forall {a}. (Ord a, Fractional a) => a -> a -> a -> a
convert Double
m1 Double
m2 (Double
h forall a. Fractional a => a -> a -> a
/ Double
2 forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a
pi forall a. Num a => a -> a -> a
- Double
1 forall a. Fractional a => a -> a -> a
/ Double
3)
convert :: a -> a -> a -> a
convert a
m1 a
m2 a
h
| a
h forall a. Ord a => a -> a -> Bool
< a
0 = a -> a -> a -> a
convert a
m1 a
m2 (a
h forall a. Num a => a -> a -> a
+ a
1)
| a
h forall a. Ord a => a -> a -> Bool
> a
1 = a -> a -> a -> a
convert a
m1 a
m2 (a
h forall a. Num a => a -> a -> a
- a
1)
| a
h forall a. Num a => a -> a -> a
* a
6 forall a. Ord a => a -> a -> Bool
< a
1 = a
m1 forall a. Num a => a -> a -> a
+ (a
m2 forall a. Num a => a -> a -> a
- a
m1) forall a. Num a => a -> a -> a
* a
h forall a. Num a => a -> a -> a
* a
6
| a
h forall a. Num a => a -> a -> a
* a
2 forall a. Ord a => a -> a -> Bool
< a
1 = a
m2
| a
h forall a. Num a => a -> a -> a
* a
3 forall a. Ord a => a -> a -> Bool
< a
2 = a
m1 forall a. Num a => a -> a -> a
+ (a
m2 forall a. Num a => a -> a -> a
- a
m1) forall a. Num a => a -> a -> a
* (a
2 forall a. Fractional a => a -> a -> a
/ a
3 forall a. Num a => a -> a -> a
- a
h) forall a. Num a => a -> a -> a
* a
6
| Bool
otherwise = a
m1
toHSL :: Color -> Maybe (Double, Double, Double)
toHSL :: Color -> Maybe (Double, Double, Double)
toHSL c :: Color
c@(RGBA Double
_ Double
_ Double
_ Double
1) = forall a. a -> Maybe a
Just (Color -> Double
hue Color
c, Color -> Double
saturation Color
c, Color -> Double
luminosity Color
c)
toHSL Color
_ = forall a. Maybe a
Nothing
mixed :: [Color] -> Color
mixed :: [Color] -> Color
mixed [Color]
colors = Double -> Double -> Double -> Double -> Double -> [Color] -> Color
go Double
0 Double
0 Double
0 Double
0 Double
0 [Color]
colors
where
go :: Double -> Double -> Double -> Double -> Double -> [Color] -> Color
go Double
rr Double
gg Double
bb Double
aa Double
n ((Color -> Color
fenceColor -> RGBA Double
r Double
g Double
b Double
a) : [Color]
cs) =
Double -> Double -> Double -> Double -> Double -> [Color] -> Color
go (Double
rr forall a. Num a => a -> a -> a
+ Double
r forall a. Num a => a -> a -> a
* Double
r forall a. Num a => a -> a -> a
* Double
a) (Double
gg forall a. Num a => a -> a -> a
+ Double
g forall a. Num a => a -> a -> a
* Double
g forall a. Num a => a -> a -> a
* Double
a) (Double
bb forall a. Num a => a -> a -> a
+ Double
b forall a. Num a => a -> a -> a
* Double
b forall a. Num a => a -> a -> a
* Double
a) (Double
aa forall a. Num a => a -> a -> a
+ Double
a) (Double
n forall a. Num a => a -> a -> a
+ Double
1) [Color]
cs
go Double
rr Double
gg Double
bb Double
aa Double
n []
| Double
aa forall a. Eq a => a -> a -> Bool
== Double
0 = Double -> Double -> Double -> Double -> Color
RGBA Double
0 Double
0 Double
0 Double
0
| Bool
otherwise = Double -> Double -> Double -> Double -> Color
RGBA (forall a. Floating a => a -> a
sqrt (Double
rr forall a. Fractional a => a -> a -> a
/ Double
aa)) (forall a. Floating a => a -> a
sqrt (Double
gg forall a. Fractional a => a -> a -> a
/ Double
aa)) (forall a. Floating a => a -> a
sqrt (Double
bb forall a. Fractional a => a -> a -> a
/ Double
aa)) (Double
aa forall a. Fractional a => a -> a -> a
/ Double
n)
sameAlpha :: Color -> Color -> Color
sameAlpha :: Color -> Color -> Color
sameAlpha (Color -> Color
fenceColor -> RGBA Double
_ Double
_ Double
_ Double
a1) (Color -> Color
fenceColor -> RGBA Double
r2 Double
g2 Double
b2 Double
_) =
Double -> Double -> Double -> Double -> Color
RGBA Double
r2 Double
g2 Double
b2 Double
a1
lighter :: Double -> Color -> Color
lighter :: Double -> Color -> Color
lighter Double
d Color
c =
Color -> Color -> Color
sameAlpha Color
c forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> Color
HSL (Color -> Double
hue Color
c) (Color -> Double
saturation Color
c) (Double -> Double
fence (Color -> Double
luminosity Color
c forall a. Num a => a -> a -> a
+ Double
d))
light :: Color -> Color
light :: Color -> Color
light = Double -> Color -> Color
lighter Double
0.15
darker :: Double -> Color -> Color
darker :: Double -> Color -> Color
darker Double
d = Double -> Color -> Color
lighter (- Double
d)
dark :: Color -> Color
dark :: Color -> Color
dark = Double -> Color -> Color
darker Double
0.15
brighter :: Double -> Color -> Color
brighter :: Double -> Color -> Color
brighter Double
d Color
c =
Color -> Color -> Color
sameAlpha Color
c forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> Color
HSL (Color -> Double
hue Color
c) (Double -> Double
fence (Color -> Double
saturation Color
c forall a. Num a => a -> a -> a
+ Double
d)) (Color -> Double
luminosity Color
c)
bright :: Color -> Color
bright :: Color -> Color
bright = Double -> Color -> Color
brighter Double
0.25
duller :: Double -> Color -> Color
duller :: Double -> Color -> Color
duller Double
d = Double -> Color -> Color
brighter (- Double
d)
dull :: Color -> Color
dull :: Color -> Color
dull = Double -> Color -> Color
duller Double
0.25
translucent :: Color -> Color
translucent :: Color -> Color
translucent (Color -> Color
fenceColor -> RGBA Double
r Double
g Double
b Double
a) = Double -> Double -> Double -> Double -> Color
RGBA Double
r Double
g Double
b (Double
a forall a. Fractional a => a -> a -> a
/ Double
2)
assortedColors :: [Color]
assortedColors :: [Color]
assortedColors = [Double -> Double -> Double -> Color
HSL (Double -> Double
adjusted Double
h) Double
0.75 Double
0.5 | Double
h <- [Double
0, Double
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
phi ..]]
where
phi :: Double
phi = (Double
1 forall a. Num a => a -> a -> a
+ forall a. Floating a => a -> a
sqrt Double
5) forall a. Fractional a => a -> a -> a
/ Double
2
adjusted :: Double -> Double
adjusted Double
x =
Double
x forall a. Num a => a -> a -> a
+ Double
a0
forall a. Num a => a -> a -> a
+ Double
a1 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin (Double
1 forall a. Num a => a -> a -> a
* Double
x)
forall a. Num a => a -> a -> a
+ Double
b1 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos (Double
1 forall a. Num a => a -> a -> a
* Double
x)
forall a. Num a => a -> a -> a
+ Double
a2 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin (Double
2 forall a. Num a => a -> a -> a
* Double
x)
forall a. Num a => a -> a -> a
+ Double
b2 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos (Double
2 forall a. Num a => a -> a -> a
* Double
x)
forall a. Num a => a -> a -> a
+ Double
a3 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin (Double
3 forall a. Num a => a -> a -> a
* Double
x)
forall a. Num a => a -> a -> a
+ Double
b3 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos (Double
3 forall a. Num a => a -> a -> a
* Double
x)
forall a. Num a => a -> a -> a
+ Double
a4 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin (Double
4 forall a. Num a => a -> a -> a
* Double
x)
forall a. Num a => a -> a -> a
+ Double
b4 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos (Double
4 forall a. Num a => a -> a -> a
* Double
x)
a0 :: Double
a0 = -Double
8.6870353473225553e-02
a1 :: Double
a1 = Double
8.6485747604766350e-02
b1 :: Double
b1 = -Double
9.6564816819163041e-02
a2 :: Double
a2 = -Double
3.0072759267059756e-03
b2 :: Double
b2 = Double
1.5048456422494966e-01
a3 :: Double
a3 = Double
9.3179137558373148e-02
b3 :: Double
b3 = Double
2.9002513227535595e-03
a4 :: Double
a4 = -Double
6.6275768228887290e-03
b4 :: Double
b4 = -Double
1.0451841243520298e-02
hue :: Color -> Double
hue :: Color -> Double
hue (Color -> Color
fenceColor -> RGBA Double
r Double
g Double
b Double
_)
| Double
hi forall a. Num a => a -> a -> a
- Double
lo forall a. Ord a => a -> a -> Bool
< Double
epsilon = Double
0
| Double
r forall a. Eq a => a -> a -> Bool
== Double
hi Bool -> Bool -> Bool
&& Double
g forall a. Ord a => a -> a -> Bool
>= Double
b = (Double
g forall a. Num a => a -> a -> a
- Double
b) forall a. Fractional a => a -> a -> a
/ (Double
hi forall a. Num a => a -> a -> a
- Double
lo) forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
3
| Double
r forall a. Eq a => a -> a -> Bool
== Double
hi = (Double
g forall a. Num a => a -> a -> a
- Double
b) forall a. Fractional a => a -> a -> a
/ (Double
hi forall a. Num a => a -> a -> a
- Double
lo) forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
3 forall a. Num a => a -> a -> a
+ Double
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi
| Double
g forall a. Eq a => a -> a -> Bool
== Double
hi = (Double
b forall a. Num a => a -> a -> a
- Double
r) forall a. Fractional a => a -> a -> a
/ (Double
hi forall a. Num a => a -> a -> a
- Double
lo) forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
3 forall a. Num a => a -> a -> a
+ Double
2 forall a. Fractional a => a -> a -> a
/ Double
3 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi
| Bool
otherwise = (Double
r forall a. Num a => a -> a -> a
- Double
g) forall a. Fractional a => a -> a -> a
/ (Double
hi forall a. Num a => a -> a -> a
- Double
lo) forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
3 forall a. Num a => a -> a -> a
+ Double
4 forall a. Fractional a => a -> a -> a
/ Double
3 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi
where
hi :: Double
hi = forall a. Ord a => a -> a -> a
max Double
r (forall a. Ord a => a -> a -> a
max Double
g Double
b)
lo :: Double
lo = forall a. Ord a => a -> a -> a
min Double
r (forall a. Ord a => a -> a -> a
min Double
g Double
b)
epsilon :: Double
epsilon = Double
0.000001
saturation :: Color -> Double
saturation :: Color -> Double
saturation (Color -> Color
fenceColor -> RGBA Double
r Double
g Double
b Double
_)
| Double
hi forall a. Num a => a -> a -> a
- Double
lo forall a. Ord a => a -> a -> Bool
< Double
epsilon = Double
0
| Bool
otherwise = (Double
hi forall a. Num a => a -> a -> a
- Double
lo) forall a. Fractional a => a -> a -> a
/ (Double
1 forall a. Num a => a -> a -> a
- forall a. Num a => a -> a
abs (Double
hi forall a. Num a => a -> a -> a
+ Double
lo forall a. Num a => a -> a -> a
- Double
1))
where
hi :: Double
hi = forall a. Ord a => a -> a -> a
max Double
r (forall a. Ord a => a -> a -> a
max Double
g Double
b)
lo :: Double
lo = forall a. Ord a => a -> a -> a
min Double
r (forall a. Ord a => a -> a -> a
min Double
g Double
b)
epsilon :: Double
epsilon = Double
0.000001
luminosity :: Color -> Double
luminosity :: Color -> Double
luminosity (Color -> Color
fenceColor -> RGBA Double
r Double
g Double
b Double
_) = (Double
lo forall a. Num a => a -> a -> a
+ Double
hi) forall a. Fractional a => a -> a -> a
/ Double
2
where
hi :: Double
hi = forall a. Ord a => a -> a -> a
max Double
r (forall a. Ord a => a -> a -> a
max Double
g Double
b)
lo :: Double
lo = forall a. Ord a => a -> a -> a
min Double
r (forall a. Ord a => a -> a -> a
min Double
g Double
b)
alpha :: Color -> Double
alpha :: Color -> Double
alpha (RGBA Double
_ Double
_ Double
_ Double
a) = Double -> Double
fence Double
a
white :: Color
white :: Color
white = Double -> Double -> Double -> Color
HSL Double
0.00 Double
0.00 Double
1.00
black :: Color
black :: Color
black = Double -> Double -> Double -> Color
HSL Double
0.00 Double
0.00 Double
0.00
gray :: Color
gray :: Color
gray = Double -> Double -> Double -> Color
HSL Double
0.00 Double
0.00 Double
0.50
grey :: Color
grey :: Color
grey = Double -> Double -> Double -> Color
HSL Double
0.00 Double
0.00 Double
0.50
red :: Color
red :: Color
red = Double -> Double -> Double -> Color
HSL Double
0.00 Double
0.75 Double
0.50
orange :: Color
orange :: Color
orange = Double -> Double -> Double -> Color
HSL Double
0.61 Double
0.75 Double
0.50
yellow :: Color
yellow :: Color
yellow = Double -> Double -> Double -> Color
HSL Double
0.98 Double
0.75 Double
0.50
green :: Color
green :: Color
green = Double -> Double -> Double -> Color
HSL Double
2.09 Double
0.75 Double
0.50
blue :: Color
blue :: Color
blue = Double -> Double -> Double -> Color
HSL Double
3.84 Double
0.75 Double
0.50
purple :: Color
purple :: Color
purple = Double -> Double -> Double -> Color
HSL Double
4.80 Double
0.75 Double
0.50
pink :: Color
pink :: Color
pink = Double -> Double -> Double -> Color
HSL Double
5.76 Double
0.75 Double
0.75
brown :: Color
brown :: Color
brown = Double -> Double -> Double -> Color
HSL Double
0.52 Double
0.60 Double
0.40