{-# language DeriveAnyClass #-}
{-# language DeriveDataTypeable #-}
{-# language DeriveGeneric #-}
{-# language ViewPatterns #-}

module CodeWorld.Tasks.Color (
  Color(..),
  Colour,
  red,
  green,
  yellow,
  black,
  white,
  blue,
  orange,
  brown,
  pink,
  purple,
  grey,
  gray,
  mixed,
  lighter,
  light,
  darker,
  dark,
  brighter,
  bright,
  duller,
  dull,
  translucent,
  assortedColors,
  hue,
  saturation,
  luminosity,
  alpha,
  ) where


import Control.DeepSeq                  (NFData)
import Data.Data                        (Data)
import GHC.Generics                     (Generic)



{-|
Color type mirroring CodeWorld's equivalent type.
The exposed constructors allow for setting colors directly via numerical values.
-}
data Color
  = Yellow
  | Green
  | Red
  | Blue
  | Orange
  | Brown
  | Pink
  | Purple
  | Grey
  | White
  | Black
  | Bright Color
  | Brighter Double Color
  | Dull Color
  | Duller Double Color
  | Light Color
  | Lighter Double Color
  | Dark Color
  | Darker Double Color
  | Translucent Color
  | Mixed [Color]
  | RGB Double Double Double
  -- ^ Values for red, green, blue __given as a percentage from 0 to 1__
  | HSL Double Double Double
  -- ^ Values for hue, saturation and luminosity
  | RGBA Double Double Double Double
  -- ^ RGB with an additional transparency percentage
  | AnyColor
  deriving (Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
/= :: Color -> Color -> Bool
Eq,Eq Color
Eq Color =>
(Color -> Color -> Ordering)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Color)
-> (Color -> Color -> Color)
-> Ord Color
Color -> Color -> Bool
Color -> Color -> Ordering
Color -> Color -> Color
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Color -> Color -> Ordering
compare :: Color -> Color -> Ordering
$c< :: Color -> Color -> Bool
< :: Color -> Color -> Bool
$c<= :: Color -> Color -> Bool
<= :: Color -> Color -> Bool
$c> :: Color -> Color -> Bool
> :: Color -> Color -> Bool
$c>= :: Color -> Color -> Bool
>= :: Color -> Color -> Bool
$cmax :: Color -> Color -> Color
max :: Color -> Color -> Color
$cmin :: Color -> Color -> Color
min :: Color -> Color -> Color
Ord,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
$cshowsPrec :: Int -> Color -> ShowS
showsPrec :: Int -> Color -> ShowS
$cshow :: Color -> String
show :: Color -> String
$cshowList :: [Color] -> ShowS
showList :: [Color] -> ShowS
Show,(forall x. Color -> Rep Color x)
-> (forall x. Rep Color x -> Color) -> Generic Color
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
$cfrom :: forall x. Color -> Rep Color x
from :: forall x. Color -> Rep Color x
$cto :: forall x. Rep Color x -> Color
to :: forall x. Rep Color x -> Color
Generic,Color -> ()
(Color -> ()) -> NFData Color
forall a. (a -> ()) -> NFData a
$crnf :: Color -> ()
rnf :: Color -> ()
NFData,Typeable Color
Typeable Color =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Color -> c Color)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Color)
-> (Color -> Constr)
-> (Color -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Color))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Color))
-> ((forall b. Data b => b -> b) -> Color -> Color)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Color -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Color -> r)
-> (forall u. (forall d. Data d => d -> u) -> Color -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Color -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Color -> m Color)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Color -> m Color)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Color -> m Color)
-> Data Color
Color -> Constr
Color -> DataType
(forall b. Data b => b -> b) -> Color -> Color
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Color -> u
forall u. (forall d. Data d => d -> u) -> Color -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Color -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Color -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Color -> m Color
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Color -> m Color
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Color
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Color -> c Color
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Color)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Color)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Color -> c Color
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Color -> c Color
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Color
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Color
$ctoConstr :: Color -> Constr
toConstr :: Color -> Constr
$cdataTypeOf :: Color -> DataType
dataTypeOf :: Color -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Color)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Color)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Color)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Color)
$cgmapT :: (forall b. Data b => b -> b) -> Color -> Color
gmapT :: (forall b. Data b => b -> b) -> Color -> Color
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Color -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Color -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Color -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Color -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Color -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Color -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Color -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Color -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Color -> m Color
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Color -> m Color
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Color -> m Color
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Color -> m Color
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Color -> m Color
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Color -> m Color
Data)


{-|
Alias for `Color`.
-}
type Colour = Color

{-|
Constant basic colour.
-}
green, red, yellow, black, white, blue, orange, brown, pink, purple, grey :: Color
yellow :: Color
yellow = Color
Yellow
green :: Color
green  = Color
Green
red :: Color
red    = Color
Red
black :: Color
black = Color
Black
white :: Color
white = Color
White
blue :: Color
blue = Color
Blue
orange :: Color
orange = Color
Orange
brown :: Color
brown = Color
Brown
pink :: Color
pink = Color
Pink
purple :: Color
purple = Color
Purple
grey :: Color
grey = Color
Grey

{-|
Alias for `grey`.
-}
gray :: Color
gray :: Color
gray = Color
grey

{-|
Blend a new color from the arguments.
-}
mixed :: [Color] -> Color
mixed :: [Color] -> Color
mixed = [Color] -> Color
Mixed

{-|
Increase argument's luminosity by a user defined amount.
-}
lighter :: Double -> Color -> Color
lighter :: Double -> Color -> Color
lighter = Double -> Color -> Color
Lighter

{-|
Slightly increase argument's luminosity.
-}
light :: Color -> Color
light :: Color -> Color
light = Color -> Color
Light

{-|
Decrease argument's luminosity by a user defined amount.
-}
darker :: Double -> Color -> Color
darker :: Double -> Color -> Color
darker = Double -> Color -> Color
Darker

{-|
Slightly decrease argument's luminosity.
-}
dark :: Color -> Color
dark :: Color -> Color
dark = Color -> Color
Dark

{-|
Increase argument's saturation by a user defined amount.
-}
brighter :: Double -> Color -> Color
brighter :: Double -> Color -> Color
brighter = Double -> Color -> Color
Brighter

{-|
Slightly increase argument's saturation.
-}
bright :: Color -> Color
bright :: Color -> Color
bright = Color -> Color
Bright

{-|
Decrease argument's saturation by a user defined amount.
-}
duller :: Double -> Color -> Color
duller :: Double -> Color -> Color
duller = Double -> Color -> Color
Duller

{-|
Slightly decrease argument's saturation.
-}
dull :: Color -> Color
dull :: Color -> Color
dull = Color -> Color
Dull

{-|
Slightly increase argument's transparency.
-}
translucent :: Color -> Color
translucent :: Color -> Color
translucent = Color -> Color
Translucent


{-|
An infinite list of different colours.
-}
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
phi ..]]
  where
    phi :: Double
phi = (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
forall a. Floating a => a -> a
sqrt Double
5) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
    adjusted :: Double -> Double
adjusted Double
x =
      Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
a0
        Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
a1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sin (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)
        Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
b1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
cos (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)
        Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
a2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sin (Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)
        Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
b2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
cos (Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)
        Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
a3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sin (Double
3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)
        Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
b3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
cos (Double
3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)
        Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
a4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sin (Double
4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)
        Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
b4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
cos (Double
4 Double -> Double -> Double
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


innerColor :: Color -> Color
innerColor :: Color -> Color
innerColor Color
col = case Color
col of
  Bright Color
c      -> Color
c
  Brighter Double
_ Color
c  -> Color
c
  Dull Color
c        -> Color
c
  Duller Double
_ Color
c    -> Color
c
  Light Color
c       -> Color
c
  Lighter Double
_ Color
c   -> Color
c
  Dark Color
c        -> Color
c
  Darker Double
_ Color
c    -> Color
c
  Translucent Color
c -> Color
c
  Color
_             -> Color
col


clamp :: Double -> Double
clamp :: Double -> Double
clamp = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double -> Double) -> (Double -> Double) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
1


clampColor :: Color -> Color
clampColor :: Color -> Color
clampColor (RGBA Double
r Double
g Double
b Double
a) = Double -> Double -> Double -> Double -> Color
RGBA (Double -> Double
clamp Double
r) (Double -> Double
clamp Double
g) (Double -> Double
clamp Double
b) (Double -> Double
clamp Double
a)
clampColor (RGB Double
r Double
g Double
b) = Double -> Double -> Double -> Color
RGB (Double -> Double
clamp Double
r) (Double -> Double
clamp Double
g) (Double -> Double
clamp Double
b)
clampColor (HSL Double
h Double
s Double
l) = Double -> Double -> Double -> Color
HSL (Double -> Double
moduloTwoPi Double
h) (Double -> Double
clamp Double
s) (Double -> Double
clamp Double
l)
clampColor Color
c = Color
c


moduloTwoPi :: Double -> Double
moduloTwoPi :: Double -> Double
moduloTwoPi Double
x = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Integer -> Double
forall a. Num a => Integer -> a
fromInteger (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
forall a. Floating a => a
pi))) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
forall a. Floating a => a
pi


{-|
Returns the hue of the argument according to the HSL model.
-}
hue :: Color -> Double
hue :: Color -> Double
hue (HSL (Double -> Double
moduloTwoPi -> Double
h) Double
_ Double
_) = Double
h
hue (RGBA Double
r Double
g Double
b Double
_) = Color -> Double
hue (Double -> Double -> Double -> Color
RGB Double
r Double
g Double
b)
hue (Color -> Color
clampColor -> RGB Double
r Double
g Double
b)
  | Double
hi Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lo Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
epsilon = Double
0
  | Double
r Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
hi Bool -> Bool -> Bool
&& Double
g Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
b = (Double
g Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
b) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
hi Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lo) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3
  | Double
r Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
hi = (Double
g Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
b) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
hi Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lo) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi
  | Double
g Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
hi = (Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
r) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
hi Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lo) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi
  | Bool
otherwise = (Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
g) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
hi Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lo) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
4 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi
  where
    hi :: Double
hi = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
r (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
g Double
b)
    lo :: Double
lo = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
r (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
g Double
b)
    epsilon :: Double
epsilon = Double
0.000001
hue (Mixed [Color]
cs) = Color -> Double
hue (Color -> Double) -> Color -> Double
forall a b. (a -> b) -> a -> b
$ [Color] -> Color
mix [Color]
cs
hue Color
Orange = Double
0.61
hue Color
Yellow = Double
0.98
hue Color
Green = Double
2.09
hue Color
Blue = Double
3.84
hue Color
Purple = Double
4.8
hue Color
Pink = Double
5.76
hue Color
Brown = Double
0.52
hue Color
c
  | Color
c Color -> [Color] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Color
White, Color
Black, Color
Grey, Color
Red] = Double
0
  | Bool
otherwise = Color -> Double
hue (Color -> Double) -> Color -> Double
forall a b. (a -> b) -> a -> b
$ Color -> Color
innerColor Color
c


{-|
Returns the saturation of the argument according to the HSL model.
-}
saturation :: Color -> Double
saturation :: Color -> Double
saturation (HSL Double
_ (Double -> Double
clamp -> Double
s) Double
_) = Double
s
saturation (RGBA Double
r Double
g Double
b Double
_) = Color -> Double
saturation (Double -> Double -> Double -> Color
RGB Double
r Double
g Double
b)
saturation (Color -> Color
clampColor -> RGB Double
r Double
g Double
b)
  | Double
hi Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lo Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
epsilon = Double
0
  | Bool
otherwise = (Double
hi Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lo) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
forall a. Num a => a -> a
abs (Double
hi Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
lo Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1))
  where
    hi :: Double
hi = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
r (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
g Double
b)
    lo :: Double
lo = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
r (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
g Double
b)
    epsilon :: Double
epsilon = Double
0.000001
saturation (Mixed [Color]
cs) = Color -> Double
saturation (Color -> Double) -> Color -> Double
forall a b. (a -> b) -> a -> b
$ [Color] -> Color
mix [Color]
cs
saturation (Bright Color
c) = Double -> Double
clamp (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Color -> Double
saturation Color
c Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.25
saturation (Brighter Double
d Color
c) = Double -> Double
clamp (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Color -> Double
saturation Color
c Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
d
saturation (Dull Color
c) = Double -> Double
clamp (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Color -> Double
saturation Color
c Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
0.25
saturation (Duller Double
d Color
c) = Double -> Double
clamp (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Color -> Double
saturation Color
c Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
d
saturation Color
Brown = Double
0.6
saturation Color
c
  | Color
c Color -> [Color] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Color
White, Color
Black, Color
Grey] = Double
0
  | Color
c Color -> [Color] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Color
Red, Color
Orange, Color
Yellow, Color
Green, Color
Blue, Color
Purple, Color
Pink] = Double
0.75
  | Bool
otherwise = Color -> Double
saturation (Color -> Double) -> Color -> Double
forall a b. (a -> b) -> a -> b
$ Color -> Color
innerColor Color
c


{-|
Returns the luminosity of the argument according to the HSL model.
-}
luminosity :: Color -> Double
luminosity :: Color -> Double
luminosity (HSL Double
_ Double
_ (Double -> Double
clamp -> Double
l)) = Double
l
luminosity (RGBA Double
r Double
g Double
b Double
_) = Color -> Double
luminosity (Double -> Double -> Double -> Color
RGB Double
r Double
g Double
b)
luminosity (Color -> Color
clampColor -> RGB Double
r Double
g Double
b) = (Double
lo Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
hi) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
  where
    hi :: Double
hi = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
r (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
g Double
b)
    lo :: Double
lo = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
r (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
g Double
b)
luminosity (Mixed [Color]
cs) = Color -> Double
luminosity (Color -> Double) -> Color -> Double
forall a b. (a -> b) -> a -> b
$ [Color] -> Color
mix [Color]
cs
luminosity (Light Color
c) = Double -> Double
clamp (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Color -> Double
luminosity Color
c Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.15
luminosity (Lighter Double
d Color
c) = Double -> Double
clamp (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Color -> Double
luminosity Color
c Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
d
luminosity (Dark Color
c) = Double -> Double
clamp (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Color -> Double
luminosity Color
c Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
0.15
luminosity (Darker Double
d Color
c) = Double -> Double
clamp (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Color -> Double
luminosity Color
c Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
d
luminosity Color
White = Double
1
luminosity Color
Black = Double
0
luminosity Color
Pink = Double
0.75
luminosity Color
Brown = Double
0.4
luminosity Color
c
  | Color
c Color -> [Color] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Color
Grey, Color
Red, Color
Orange, Color
Yellow, Color
Green, Color
Blue, Color
Purple] = Double
0.5
  | Bool
otherwise = Color -> Double
luminosity (Color -> Double) -> Color -> Double
forall a b. (a -> b) -> a -> b
$ Color -> Color
innerColor Color
c


{-|
Returns the transparency of the argument.
-}
alpha :: Color -> Double
alpha :: Color -> Double
alpha (RGBA Double
_ Double
_ Double
_ (Double -> Double
clamp -> Double
a))  = Double
a
alpha (Translucent Color
c) = Color -> Double
alpha Color
c Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
alpha (HSL {}) = Double
1
alpha (RGB {}) = Double
1
alpha (Mixed [Color]
cs) = Color -> Double
alpha (Color -> Double) -> Color -> Double
forall a b. (a -> b) -> a -> b
$ [Color] -> Color
mix [Color]
cs
alpha Color
c
  | Color
c Color -> [Color] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Color]
predefinedColors = Double
1
  | Bool
otherwise = Color -> Double
alpha (Color -> Double) -> Color -> Double
forall a b. (a -> b) -> a -> b
$ Color -> Color
innerColor Color
c
  where
    predefinedColors :: [Color]
predefinedColors =
      [ Color
Yellow
      , Color
Green
      , Color
Red
      , Color
Black
      , Color
White
      , Color
Blue
      , Color
Orange
      , Color
Brown
      , Color
Pink
      , Color
Purple
      , Color
Grey
      ]


-- taken and slightly adapted from codeworld-api
mix :: [Color] -> Color
mix :: [Color] -> Color
mix = Double -> Double -> Double -> Double -> Double -> [Color] -> Color
go Double
0 Double
0 Double
0 Double
0 Double
0
  where
    go :: Double -> Double -> Double -> Double -> Double -> [Color] -> Color
go Double
rr Double
gg Double
bb Double
aa Double
n (Color
c:[Color]
cs) = let (Double
r, Double
g, Double
b, Double
a) = Color -> (Double, Double, Double, Double)
toRGBA Color
c in
      Double -> Double -> Double -> Double -> Double -> [Color] -> Color
go (Double
rr Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a) (Double
gg Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
g Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
g Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a) (Double
bb Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a) (Double
aa Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
a) (Double
n Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1) [Color]
cs
    go Double
rr Double
gg Double
bb Double
aa Double
n []
      | Double
aa Double -> Double -> Bool
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 (Double -> Double
forall a. Floating a => a -> a
sqrt (Double
rr Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
aa)) (Double -> Double
forall a. Floating a => a -> a
sqrt (Double
gg Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
aa)) (Double -> Double
forall a. Floating a => a -> a
sqrt (Double
bb Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
aa)) (Double
aa Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
n)


-- taken and slightly adapted from codeworld-api
toRGBA :: Color -> (Double,Double,Double,Double)
toRGBA :: Color -> (Double, Double, Double, Double)
toRGBA (Color -> Color
clampColor -> RGB Double
r Double
g Double
b) = (Double
r, Double
b, Double
g, Double
1)
toRGBA (Color -> Color
clampColor -> RGBA Double
r Double
b Double
g Double
a) = (Double
r, Double
b, Double
g, Double
a)
toRGBA (Color -> Color
clampColor -> HSL Double
h Double
s Double
l) = (Double
r, Double
g, Double
b, Double
1)
  where
    m1 :: Double
m1 = Double
l Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
m2
    m2 :: Double
m2
      | Double
l Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.5 = Double
l Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1)
      | Bool
otherwise = Double
l Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
l Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s
    r :: Double
r = Double -> Double -> Double -> Double
forall {a}. (Ord a, Fractional a) => a -> a -> a -> a
convert Double
m1 Double
m2 (Double
h Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3)
    g :: Double
g = Double -> Double -> Double -> Double
forall {a}. (Ord a, Fractional a) => a -> a -> a -> a
convert Double
m1 Double
m2 (Double
h Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
forall a. Floating a => a
pi)
    b :: Double
b = Double -> Double -> Double -> Double
forall {a}. (Ord a, Fractional a) => a -> a -> a -> a
convert Double
m1 Double
m2 (Double
h Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3)
    convert :: a -> a -> a -> a
convert a
m1' a
m2' a
h'
      | a
h' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = a -> a -> a -> a
convert a
m1' a
m2' (a
h' a -> a -> a
forall a. Num a => a -> a -> a
+ a
1)
      | a
h' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
1 = a -> a -> a -> a
convert a
m1' a
m2' (a
h' a -> a -> a
forall a. Num a => a -> a -> a
- a
1)
      | a
h' a -> a -> a
forall a. Num a => a -> a -> a
* a
6 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
1 = a
m1' a -> a -> a
forall a. Num a => a -> a -> a
+ (a
m2' a -> a -> a
forall a. Num a => a -> a -> a
- a
m1') a -> a -> a
forall a. Num a => a -> a -> a
* a
h' a -> a -> a
forall a. Num a => a -> a -> a
* a
6
      | a
h' a -> a -> a
forall a. Num a => a -> a -> a
* a
2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
1 = a
m2'
      | a
h' a -> a -> a
forall a. Num a => a -> a -> a
* a
3 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
2 = a
m1' a -> a -> a
forall a. Num a => a -> a -> a
+ (a
m2' a -> a -> a
forall a. Num a => a -> a -> a
- a
m1') a -> a -> a
forall a. Num a => a -> a -> a
* (a
2 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
3 a -> a -> a
forall a. Num a => a -> a -> a
- a
h') a -> a -> a
forall a. Num a => a -> a -> a
* a
6
      | Bool
otherwise = a
m1'
toRGBA (Translucent Color
c) = let (Double
r, Double
g, Double
b, Double
a) = Color -> (Double, Double, Double, Double)
toRGBA Color
c in (Double
r, Double
g, Double
b, Double
aDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2)
toRGBA Color
c = Color -> (Double, Double, Double, Double)
toRGBA (Color -> (Double, Double, Double, Double))
-> Color -> (Double, Double, Double, Double)
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> Color
HSL (Color -> Double
hue Color
c) (Color -> Double
saturation Color
c) (Color -> Double
luminosity Color
c)