-- |
-- Module      : Test.Speculate.Utils.Tuple
-- Copyright   : (c) 2016-2019 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- This module is part of Speculate
--
-- Simple colour module.
module Test.Speculate.Utils.Colour
  ( Colour (RGB)
  , Color
  , showRGB
  , (.+.), (.-.), (.*.)
  , black, white, grey
  , red, green, blue
  , cyan, magenta, yellow
  , violet, orange, lime, aquamarine, azure, indigo
  , makeGrey
  , grey1, grey2, grey3, grey4, grey5, grey6, grey7, grey8, grey9
  , rgb, cmy
  , chroma
  , hue0
  , hue
  , intensity, value, lightness
  , saturation, saturationHSV, saturationHSL, saturationHSI
  , fromRGB, fromCMY, fromHSV, fromHSL, fromHCL, fromHCM
  , mix, mixHSV

  -- * colour properties
  , primary, secondary, tertiary
  , primary'
  , isGrey
  , notGrey
  , isOppositeTo

  -- * Misc Utils
  , frac
  , coerceRatio
  , modulo
  )
where

import Data.Char
import Data.List
import Data.Maybe
import Data.Ratio
import Data.Tuple
import Data.Functor ((<$>)) -- for GHC < 7.10
import Control.Applicative ((<*>)) -- for GHC < 7.10

data Colour = RGB Rational Rational Rational
  deriving (Colour -> Colour -> Bool
(Colour -> Colour -> Bool)
-> (Colour -> Colour -> Bool) -> Eq Colour
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Colour -> Colour -> Bool
== :: Colour -> Colour -> Bool
$c/= :: Colour -> Colour -> Bool
/= :: Colour -> Colour -> Bool
Eq, Eq Colour
Eq Colour =>
(Colour -> Colour -> Ordering)
-> (Colour -> Colour -> Bool)
-> (Colour -> Colour -> Bool)
-> (Colour -> Colour -> Bool)
-> (Colour -> Colour -> Bool)
-> (Colour -> Colour -> Colour)
-> (Colour -> Colour -> Colour)
-> Ord Colour
Colour -> Colour -> Bool
Colour -> Colour -> Ordering
Colour -> Colour -> Colour
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 :: Colour -> Colour -> Ordering
compare :: Colour -> Colour -> Ordering
$c< :: Colour -> Colour -> Bool
< :: Colour -> Colour -> Bool
$c<= :: Colour -> Colour -> Bool
<= :: Colour -> Colour -> Bool
$c> :: Colour -> Colour -> Bool
> :: Colour -> Colour -> Bool
$c>= :: Colour -> Colour -> Bool
>= :: Colour -> Colour -> Bool
$cmax :: Colour -> Colour -> Colour
max :: Colour -> Colour -> Colour
$cmin :: Colour -> Colour -> Colour
min :: Colour -> Colour -> Colour
Ord)

type Color = Colour

instance Show Colour where
  show :: Colour -> String
show c :: Colour
c@(RGB Rational
r Rational
g Rational
b) = String
"RGB (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rational -> String
forall a. Show a => a -> String
show Rational
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rational -> String
forall a. Show a => a -> String
show Rational
g String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rational -> String
forall a. Show a => a -> String
show Rational
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {- " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Colour -> String
showRGB Colour
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -}"

showRGB :: Colour -> String
showRGB :: Colour -> String
showRGB (RGB Rational
r Rational
g Rational
b) = String
"#" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rational -> String
forall a. Integral a => Ratio a -> String
hexRatio Rational
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rational -> String
forall a. Integral a => Ratio a -> String
hexRatio Rational
g String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rational -> String
forall a. Integral a => Ratio a -> String
hexRatio Rational
b

hexRatio :: Integral a => Ratio a -> String
hexRatio :: forall a. Integral a => Ratio a -> String
hexRatio Ratio a
r = a -> String
forall a. Integral a => a -> String
hex (a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
$ Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
r a -> a -> a
forall a. Num a => a -> a -> a
* a
0xFF a -> a -> a
forall a. Integral a => a -> a -> a
`div` Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
r

hex :: Integral a => a -> String
hex :: forall a. Integral a => a -> String
hex = (\String
s -> case String
s of
               []  -> String
"00"
               [Char
c] -> Char
'0'Char -> ShowS
forall a. a -> [a] -> [a]
:[Char
c]
               String
cs  -> String
cs)
    ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Char) -> [a] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
intToDigit (Int -> Char) -> (a -> Int) -> a -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a b. (Integral a, Num b) => a -> b
coerceNum)
    ([a] -> String) -> (a -> [a]) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse
    ([a] -> [a]) -> (a -> [a]) -> a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe (a, a)) -> a -> [a]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (\a
n -> [(a, a)] -> Maybe (a, a)
forall a. [a] -> Maybe a
listToMaybe [(a, a) -> (a, a)
forall a b. (a, b) -> (b, a)
swap ((a, a) -> (a, a)) -> (a, a) -> (a, a)
forall a b. (a -> b) -> a -> b
$ a
n a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`divMod` a
16 | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0])

coerceNum :: (Integral a, Num b) => a -> b
coerceNum :: forall a b. (Integral a, Num b) => a -> b
coerceNum = Integer -> b
forall a. Num a => Integer -> a
fromInteger (Integer -> b) -> (a -> Integer) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a. Integral a => a -> Integer
toInteger

coerceRatio :: (Integral a, Integral b) => Ratio a -> Ratio b
coerceRatio :: forall a b. (Integral a, Integral b) => Ratio a -> Ratio b
coerceRatio Ratio a
r = a -> b
forall a b. (Integral a, Num b) => a -> b
coerceNum (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
r) b -> b -> Ratio b
forall a. Integral a => a -> a -> Ratio a
% a -> b
forall a b. (Integral a, Num b) => a -> b
coerceNum (Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
r)

mod1 :: Integral a => Ratio a -> Ratio a
mod1 :: forall a. Integral a => Ratio a -> Ratio a
mod1 Ratio a
r = (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
r a -> a -> a
forall a. Integral a => a -> a -> a
`mod` Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
r) a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
% Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
r

modulo :: Integral a => Ratio a -> Ratio a -> Ratio a
Ratio a
n modulo :: forall a. Integral a => Ratio a -> Ratio a -> Ratio a
`modulo` Ratio a
d = Ratio a -> Ratio a
forall a. Integral a => Ratio a -> Ratio a
mod1 (Ratio a
n Ratio a -> Ratio a -> Ratio a
forall a. Fractional a => a -> a -> a
/ Ratio a
d) Ratio a -> Ratio a -> Ratio a
forall a. Num a => a -> a -> a
* Ratio a
d

frac :: Integral a => Ratio a -> Ratio a
frac :: forall a. Integral a => Ratio a -> Ratio a
frac Ratio a
r | Ratio a
r Ratio a -> Ratio a -> Bool
forall a. Ord a => a -> a -> Bool
< Ratio a
0 = Ratio a
0
       | Ratio a
r Ratio a -> Ratio a -> Bool
forall a. Ord a => a -> a -> Bool
> Ratio a
1 = Ratio a
1
       | Bool
otherwise = Ratio a
r

instance Num Colour where
  RGB Rational
r1 Rational
g1 Rational
b1 + :: Colour -> Colour -> Colour
+ RGB Rational
r2 Rational
g2 Rational
b2 = Rational -> Rational -> Rational -> Colour
RGB (Rational -> Rational
forall a. Integral a => Ratio a -> Ratio a
frac (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Rational
r1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
r2) (Rational -> Rational
forall a. Integral a => Ratio a -> Ratio a
frac (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Rational
g1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
g2) (Rational -> Rational
forall a. Integral a => Ratio a -> Ratio a
frac (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Rational
b1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
b2)
  RGB Rational
r1 Rational
g1 Rational
b1 - :: Colour -> Colour -> Colour
- RGB Rational
r2 Rational
g2 Rational
b2 = Rational -> Rational -> Rational -> Colour
RGB (Rational -> Rational
forall a. Integral a => Ratio a -> Ratio a
frac (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Rational
r1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
r2) (Rational -> Rational
forall a. Integral a => Ratio a -> Ratio a
frac (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Rational
g1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
g2) (Rational -> Rational
forall a. Integral a => Ratio a -> Ratio a
frac (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Rational
b1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
b2)
  RGB Rational
r1 Rational
g1 Rational
b1 * :: Colour -> Colour -> Colour
* RGB Rational
r2 Rational
g2 Rational
b2 = Rational -> Rational -> Rational -> Colour
RGB        (Rational
r1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
r2)        (Rational
g1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
g2)        (Rational
b1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
b2)
  negate :: Colour -> Colour
negate (RGB Rational
r Rational
g Rational
b) = Rational -> Rational -> Rational -> Colour
RGB (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
r) (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
g) (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
b)
  abs :: Colour -> Colour
abs Colour
c = Colour
c
  signum :: Colour -> Colour
signum Colour
c = Colour
1
  fromInteger :: Integer -> Colour
fromInteger Integer
i = let j :: Integer
j = Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
0x100
                      k :: Integer
k = Integer
j Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
0x100
                  in Rational -> Rational -> Rational -> Colour
RGB (Integer
k Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
0x100 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
255) (Integer
j Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
0x100 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
255) (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
0x100 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
255)

(.+.) :: Colour -> Colour -> Colour
Colour
c1 .+. :: Colour -> Colour -> Colour
.+. Colour
c2 = Colour -> Colour
forall a. Num a => a -> a
negate (Colour -> Colour) -> Colour -> Colour
forall a b. (a -> b) -> a -> b
$ Colour -> Colour
forall a. Num a => a -> a
negate Colour
c1 Colour -> Colour -> Colour
forall a. Num a => a -> a -> a
+ Colour -> Colour
forall a. Num a => a -> a
negate Colour
c2

(.-.) :: Colour -> Colour -> Colour
Colour
c1 .-. :: Colour -> Colour -> Colour
.-. Colour
c2 = Colour -> Colour
forall a. Num a => a -> a
negate (Colour -> Colour) -> Colour -> Colour
forall a b. (a -> b) -> a -> b
$ Colour -> Colour
forall a. Num a => a -> a
negate Colour
c1 Colour -> Colour -> Colour
forall a. Num a => a -> a -> a
- Colour -> Colour
forall a. Num a => a -> a
negate Colour
c2

(.*.) :: Colour -> Colour -> Colour
Colour
c1 .*. :: Colour -> Colour -> Colour
.*. Colour
c2 = Colour -> Colour
forall a. Num a => a -> a
negate (Colour -> Colour) -> Colour -> Colour
forall a b. (a -> b) -> a -> b
$ Colour -> Colour
forall a. Num a => a -> a
negate Colour
c1 Colour -> Colour -> Colour
forall a. Num a => a -> a -> a
* Colour -> Colour
forall a. Num a => a -> a
negate Colour
c2

black :: Colour
black :: Colour
black = Rational -> Rational -> Rational -> Colour
RGB Rational
0 Rational
0 Rational
0

white :: Colour
white :: Colour
white = Rational -> Rational -> Rational -> Colour
RGB Rational
1 Rational
1 Rational
1

red :: Colour
red :: Colour
red = Rational -> Rational -> Rational -> Colour
RGB Rational
1 Rational
0 Rational
0

green :: Colour
green :: Colour
green = Rational -> Rational -> Rational -> Colour
RGB Rational
0 Rational
1 Rational
0

blue :: Colour
blue :: Colour
blue = Rational -> Rational -> Rational -> Colour
RGB Rational
0 Rational
0 Rational
1

cyan :: Colour
cyan :: Colour
cyan = Rational -> Rational -> Rational -> Colour
RGB Rational
0 Rational
1 Rational
1

magenta :: Colour
magenta :: Colour
magenta = Rational -> Rational -> Rational -> Colour
RGB Rational
1 Rational
0 Rational
1

yellow :: Colour
yellow :: Colour
yellow = Rational -> Rational -> Rational -> Colour
RGB Rational
1 Rational
1 Rational
0

violet :: Colour
violet :: Colour
violet = Colour
red Colour -> Colour -> Colour
`mix` Colour
magenta

orange :: Colour
orange :: Colour
orange = Colour
red Colour -> Colour -> Colour
`mix` Colour
yellow

lime :: Colour
lime :: Colour
lime = Colour
green Colour -> Colour -> Colour
`mix` Colour
yellow

aquamarine :: Colour
aquamarine :: Colour
aquamarine = Colour
green Colour -> Colour -> Colour
`mix` Colour
cyan

azure :: Colour
azure :: Colour
azure = Colour
blue Colour -> Colour -> Colour
`mix` Colour
cyan

indigo :: Colour
indigo :: Colour
indigo = Colour
blue Colour -> Colour -> Colour
`mix` Colour
magenta

grey :: Colour
grey :: Colour
grey = Colour
grey5

grey1, grey2, grey3, grey4, grey5, grey6, grey7, grey8, grey9 :: Colour
grey1 :: Colour
grey1 = Rational -> Colour
makeGrey (Rational -> Colour) -> Rational -> Colour
forall a b. (a -> b) -> a -> b
$ Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
10
grey2 :: Colour
grey2 = Rational -> Colour
makeGrey (Rational -> Colour) -> Rational -> Colour
forall a b. (a -> b) -> a -> b
$ Integer
2Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
10
grey3 :: Colour
grey3 = Rational -> Colour
makeGrey (Rational -> Colour) -> Rational -> Colour
forall a b. (a -> b) -> a -> b
$ Integer
3Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
10
grey4 :: Colour
grey4 = Rational -> Colour
makeGrey (Rational -> Colour) -> Rational -> Colour
forall a b. (a -> b) -> a -> b
$ Integer
4Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
10
grey5 :: Colour
grey5 = Rational -> Colour
makeGrey (Rational -> Colour) -> Rational -> Colour
forall a b. (a -> b) -> a -> b
$ Integer
5Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
10
grey6 :: Colour
grey6 = Rational -> Colour
makeGrey (Rational -> Colour) -> Rational -> Colour
forall a b. (a -> b) -> a -> b
$ Integer
6Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
10
grey7 :: Colour
grey7 = Rational -> Colour
makeGrey (Rational -> Colour) -> Rational -> Colour
forall a b. (a -> b) -> a -> b
$ Integer
7Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
10
grey8 :: Colour
grey8 = Rational -> Colour
makeGrey (Rational -> Colour) -> Rational -> Colour
forall a b. (a -> b) -> a -> b
$ Integer
8Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
10
grey9 :: Colour
grey9 = Rational -> Colour
makeGrey (Rational -> Colour) -> Rational -> Colour
forall a b. (a -> b) -> a -> b
$ Integer
9Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
10

makeGrey :: Rational -> Colour
makeGrey :: Rational -> Colour
makeGrey Rational
r = Rational -> Rational -> Rational -> Colour
RGB Rational
r Rational
r Rational
r

rgb :: Colour -> (Rational, Rational, Rational)
rgb :: Colour -> (Rational, Rational, Rational)
rgb (RGB Rational
r Rational
g Rational
b) = (Rational
r,Rational
g,Rational
b)

cmy :: Colour -> (Rational, Rational, Rational)
cmy :: Colour -> (Rational, Rational, Rational)
cmy (RGB Rational
r Rational
g Rational
b) = (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
r, Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
g, Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
b)

maxi :: Colour -> Rational
maxi :: Colour -> Rational
maxi (RGB Rational
r Rational
g Rational
b) = [Rational] -> Rational
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Rational
r,Rational
g,Rational
b]

mini :: Colour -> Rational
mini :: Colour -> Rational
mini (RGB Rational
r Rational
g Rational
b) = [Rational] -> Rational
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Rational
r,Rational
g,Rational
b]

chroma :: Colour -> Rational
chroma :: Colour -> Rational
chroma Colour
c = Colour -> Rational
maxi Colour
c Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Colour -> Rational
mini Colour
c

hue0 :: Colour -> Rational
hue0 :: Colour -> Rational
hue0 = Rational -> Maybe Rational -> Rational
forall a. a -> Maybe a -> a
fromMaybe Rational
0 (Maybe Rational -> Rational)
-> (Colour -> Maybe Rational) -> Colour -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Colour -> Maybe Rational
hue

hue :: Colour -> Maybe Rational
hue :: Colour -> Maybe Rational
hue colour :: Colour
colour@(RGB Rational
r Rational
g Rational
b) = (\Rational
h' -> Rational -> Rational
forall a. Integral a => Ratio a -> Ratio a
mod1 (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Rational
h' Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
6) (Rational -> Rational) -> Maybe Rational -> Maybe Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Rational
h' -- h' * 60 / 360
  where
  c :: Rational
c = Colour -> Rational
chroma Colour
colour
  m :: Rational
m = Colour -> Rational
maxi Colour
colour
  h' :: Maybe Rational
h' | Rational
c Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
0 = Maybe Rational
forall a. Maybe a
Nothing
     | Rational
m Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
r = Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Rational -> Maybe Rational) -> Rational -> Maybe Rational
forall a b. (a -> b) -> a -> b
$ (Rational
g Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
b) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
c
     | Rational
m Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
g = Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Rational -> Maybe Rational) -> Rational -> Maybe Rational
forall a b. (a -> b) -> a -> b
$ (Rational
b Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
r) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
c Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
2
     | Rational
m Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
b = Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Rational -> Maybe Rational) -> Rational -> Maybe Rational
forall a b. (a -> b) -> a -> b
$ (Rational
r Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
g) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
c Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
4
     | Bool
otherwise = String -> Maybe Rational
forall a. HasCallStack => String -> a
error String
"hue: the impossible happened! (report bug)"

intensity :: Colour -> Rational
intensity :: Colour -> Rational
intensity (RGB Rational
r Rational
g Rational
b) = (Rational
r Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
g Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
b) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
3

value :: Colour -> Rational
value :: Colour -> Rational
value = Colour -> Rational
maxi

lightness :: Colour -> Rational
lightness :: Colour -> Rational
lightness Colour
c = (Colour -> Rational
maxi Colour
c Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Colour -> Rational
mini Colour
c) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
2

saturation :: Colour -> Rational
saturation :: Colour -> Rational
saturation = Colour -> Rational
saturationHSV

saturationHSV :: Colour -> Rational
saturationHSV :: Colour -> Rational
saturationHSV Colour
c =
  if Colour -> Rational
value Colour
c Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
0
    then Rational
0
    else Colour -> Rational
chroma Colour
c Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Colour -> Rational
value Colour
c

saturationHSL :: Colour -> Rational
saturationHSL :: Colour -> Rational
saturationHSL Colour
c =
  if Colour -> Rational
lightness Colour
c Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
1
    then Rational
0
    else Colour -> Rational
chroma Colour
c Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational -> Rational
forall a. Num a => a -> a
abs (Rational
2 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Colour -> Rational
lightness Colour
c Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
1))

saturationHSI :: Colour -> Rational
saturationHSI :: Colour -> Rational
saturationHSI Colour
c =
  case Colour -> Rational
intensity Colour
c of
    Rational
0 -> Rational
0
    Rational
i -> Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Colour -> Rational
mini Colour
cRational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
i

fromRGB :: Rational -> Rational -> Rational -> Colour
fromRGB :: Rational -> Rational -> Rational -> Colour
fromRGB = Rational -> Rational -> Rational -> Colour
RGB

-- TODO: double check this, I don't think this is quite right
fromCMY :: Rational -> Rational -> Rational -> Colour
fromCMY :: Rational -> Rational -> Rational -> Colour
fromCMY Rational
c Rational
m Rational
y = Rational -> Rational -> Rational -> Colour
RGB (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
c) (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
m) (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
y)

fromHSV :: Rational -> Rational -> Rational -> Colour
fromHSV :: Rational -> Rational -> Rational -> Colour
fromHSV Rational
h Rational
s Rational
v = Rational -> Rational -> Rational -> Colour
fromHCM Rational
h Rational
c Rational
m
  where
  c :: Rational
c = Rational
v Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
s
  m :: Rational
m = Rational
v Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
c

fromHSL :: Rational -> Rational -> Rational -> Colour
fromHSL :: Rational -> Rational -> Rational -> Colour
fromHSL Rational
h Rational
s Rational
l = Rational -> Rational -> Rational -> Colour
fromHCM Rational
h Rational
c Rational
m
  where
  c :: Rational
c = (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational -> Rational
forall a. Num a => a -> a
abs (Rational
2Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
l Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
1)) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
s
  m :: Rational
m = Rational
l Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
c Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
2

fromHCL :: Rational -> Rational -> Rational -> Colour
fromHCL :: Rational -> Rational -> Rational -> Colour
fromHCL Rational
h Rational
c Rational
l = Rational -> Rational -> Rational -> Colour
fromHCM Rational
h Rational
c Rational
m  where m :: Rational
m = (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
c) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
l

-- | From hue, chroma and min
fromHCM :: Rational -> Rational -> Rational -> Colour
fromHCM :: Rational -> Rational -> Rational -> Colour
fromHCM Rational
h' Rational
c Rational
m = Rational -> Rational -> Rational -> Colour
RGB (Rational
r' Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
m) (Rational
g' Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
m) (Rational
b' Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
m)
  where
  h :: Rational
h = Rational
h' Rational -> Rational -> Rational
forall a. Integral a => Ratio a -> Ratio a -> Ratio a
`modulo` Rational
1
  x :: Rational
x = Rational
c Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational -> Rational
forall a. Num a => a -> a
abs ((Rational
hRational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
6) Rational -> Rational -> Rational
forall a. Integral a => Ratio a -> Ratio a -> Ratio a
`modulo` Rational
2 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
1))
  (Rational
r',Rational
g',Rational
b')
    | Integer
0Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
6 Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<= Rational
h Bool -> Bool -> Bool
&& Rational
h Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
6 = (Rational
c,Rational
x,Rational
0)
    | Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
6 Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<= Rational
h Bool -> Bool -> Bool
&& Rational
h Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
2Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
6 = (Rational
x,Rational
c,Rational
0)
    | Integer
2Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
6 Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<= Rational
h Bool -> Bool -> Bool
&& Rational
h Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
3Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
6 = (Rational
0,Rational
c,Rational
x)
    | Integer
3Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
6 Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<= Rational
h Bool -> Bool -> Bool
&& Rational
h Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
4Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
6 = (Rational
0,Rational
x,Rational
c)
    | Integer
4Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
6 Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<= Rational
h Bool -> Bool -> Bool
&& Rational
h Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
5Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
6 = (Rational
x,Rational
0,Rational
c)
    | Integer
5Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
6 Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<= Rational
h Bool -> Bool -> Bool
&& Rational
h Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
6Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
6 = (Rational
c,Rational
0,Rational
x)
    | Bool
otherwise = String -> (Rational, Rational, Rational)
forall a. HasCallStack => String -> a
error String
"fromHCM: the impossible happened! (report bug)"

mix :: Colour -> Colour -> Colour
mix :: Colour -> Colour -> Colour
mix (RGB Rational
r1 Rational
g1 Rational
b1) (RGB Rational
r2 Rational
g2 Rational
b2) = Rational -> Rational -> Rational -> Colour
RGB ((Rational
r1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
r2) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
2) ((Rational
g1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
g2) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
2) ((Rational
b1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
b2) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
2)

mixHSV :: Colour -> Colour -> Colour
mixHSV :: Colour -> Colour -> Colour
mixHSV Colour
c1 Colour
c2 = Rational -> Rational -> Rational -> Colour
fromHSV Rational
h
                       ((Colour -> Rational
saturationHSV Colour
c1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Colour -> Rational
saturationHSV Colour
c2) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
2)
                       ((Colour -> Rational
value Colour
c1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Colour -> Rational
value Colour
c2) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
2)
  where
  h :: Rational
h = Rational -> Maybe Rational -> Rational
forall a. a -> Maybe a -> a
fromMaybe Rational
0 (Maybe Rational -> Rational) -> Maybe Rational -> Rational
forall a b. (a -> b) -> a -> b
$ do
    Rational
hc1 <- Colour -> Maybe Rational
hue Colour
c1
    Rational
hc2 <- Colour -> Maybe Rational
hue Colour
c2
    Rational -> Maybe Rational
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Rational -> Maybe Rational) -> Rational -> Maybe Rational
forall a b. (a -> b) -> a -> b
$ (Rational
hc1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
hc2) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
2

primary' :: Colour -> Bool
primary' :: Colour -> Bool
primary' Colour
c = Colour
c Colour -> Colour -> Bool
forall a. Eq a => a -> a -> Bool
== Colour
red
          Bool -> Bool -> Bool
|| Colour
c Colour -> Colour -> Bool
forall a. Eq a => a -> a -> Bool
== Colour
green
          Bool -> Bool -> Bool
|| Colour
c Colour -> Colour -> Bool
forall a. Eq a => a -> a -> Bool
== Colour
blue

primary :: Colour -> Bool
primary :: Colour -> Bool
primary Colour
c = Colour -> Maybe Rational
hue Colour
c Maybe Rational -> Maybe Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Colour -> Maybe Rational
hue Colour
red
         Bool -> Bool -> Bool
|| Colour -> Maybe Rational
hue Colour
c Maybe Rational -> Maybe Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Colour -> Maybe Rational
hue Colour
green
         Bool -> Bool -> Bool
|| Colour -> Maybe Rational
hue Colour
c Maybe Rational -> Maybe Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Colour -> Maybe Rational
hue Colour
blue

secondary :: Colour -> Bool
secondary :: Colour -> Bool
secondary Colour
c = Colour -> Maybe Rational
hue Colour
c Maybe Rational -> Maybe Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Colour -> Maybe Rational
hue Colour
cyan
           Bool -> Bool -> Bool
|| Colour -> Maybe Rational
hue Colour
c Maybe Rational -> Maybe Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Colour -> Maybe Rational
hue Colour
magenta
           Bool -> Bool -> Bool
|| Colour -> Maybe Rational
hue Colour
c Maybe Rational -> Maybe Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Colour -> Maybe Rational
hue Colour
yellow

tertiary :: Colour -> Bool
tertiary :: Colour -> Bool
tertiary Colour
c = Colour -> Maybe Rational
hue Colour
c Maybe Rational -> Maybe Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Colour -> Maybe Rational
hue Colour
violet
          Bool -> Bool -> Bool
|| Colour -> Maybe Rational
hue Colour
c Maybe Rational -> Maybe Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Colour -> Maybe Rational
hue Colour
orange
          Bool -> Bool -> Bool
|| Colour -> Maybe Rational
hue Colour
c Maybe Rational -> Maybe Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Colour -> Maybe Rational
hue Colour
lime
          Bool -> Bool -> Bool
|| Colour -> Maybe Rational
hue Colour
c Maybe Rational -> Maybe Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Colour -> Maybe Rational
hue Colour
aquamarine
          Bool -> Bool -> Bool
|| Colour -> Maybe Rational
hue Colour
c Maybe Rational -> Maybe Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Colour -> Maybe Rational
hue Colour
azure
          Bool -> Bool -> Bool
|| Colour -> Maybe Rational
hue Colour
c Maybe Rational -> Maybe Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Colour -> Maybe Rational
hue Colour
indigo

isGrey :: Colour -> Bool
isGrey :: Colour -> Bool
isGrey = Maybe Rational -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Rational -> Bool)
-> (Colour -> Maybe Rational) -> Colour -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Colour -> Maybe Rational
hue

notGrey :: Colour -> Bool
notGrey :: Colour -> Bool
notGrey = Maybe Rational -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Rational -> Bool)
-> (Colour -> Maybe Rational) -> Colour -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Colour -> Maybe Rational
hue

isOppositeTo :: Colour -> Colour -> Bool
Colour
c1 isOppositeTo :: Colour -> Colour -> Bool
`isOppositeTo` Colour
c2 = Colour -> Bool
notGrey Colour
c1 Bool -> Bool -> Bool
&& Colour -> Bool
notGrey Colour
c2
                    Bool -> Bool -> Bool
&& Colour -> Rational
saturation Colour
c1 Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Colour -> Rational
saturation Colour
c2
                    Bool -> Bool -> Bool
&& Colour -> Rational
lightness Colour
c1 Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Colour -> Rational
lightness Colour
c2
                    Bool -> Bool -> Bool
&& (Colour -> Rational
hue0 Colour
c1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2) Rational -> Rational -> Rational
forall a. Integral a => Ratio a -> Ratio a -> Ratio a
`modulo` Rational
1 Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Colour -> Rational
hue0 Colour
c2