module Blucontrol.RGB (
  RGB (..)
, Chromaticity
, Trichromaticity (..)
) where

import Control.DeepSeq
import Data.Default
import Data.Word
import GHC.Generics

-- | convertible to 8-bit RGB values
class RGB c where
  toRGB :: c -> Trichromaticity

-- | 8-bit value for color channel intensity
newtype Chromaticity = Chromaticity Word8
  deriving (Chromaticity
Chromaticity -> Chromaticity -> Bounded Chromaticity
forall a. a -> a -> Bounded a
maxBound :: Chromaticity
$cmaxBound :: Chromaticity
minBound :: Chromaticity
$cminBound :: Chromaticity
Bounded, Int -> Chromaticity
Chromaticity -> Int
Chromaticity -> [Chromaticity]
Chromaticity -> Chromaticity
Chromaticity -> Chromaticity -> [Chromaticity]
Chromaticity -> Chromaticity -> Chromaticity -> [Chromaticity]
(Chromaticity -> Chromaticity)
-> (Chromaticity -> Chromaticity)
-> (Int -> Chromaticity)
-> (Chromaticity -> Int)
-> (Chromaticity -> [Chromaticity])
-> (Chromaticity -> Chromaticity -> [Chromaticity])
-> (Chromaticity -> Chromaticity -> [Chromaticity])
-> (Chromaticity -> Chromaticity -> Chromaticity -> [Chromaticity])
-> Enum Chromaticity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Chromaticity -> Chromaticity -> Chromaticity -> [Chromaticity]
$cenumFromThenTo :: Chromaticity -> Chromaticity -> Chromaticity -> [Chromaticity]
enumFromTo :: Chromaticity -> Chromaticity -> [Chromaticity]
$cenumFromTo :: Chromaticity -> Chromaticity -> [Chromaticity]
enumFromThen :: Chromaticity -> Chromaticity -> [Chromaticity]
$cenumFromThen :: Chromaticity -> Chromaticity -> [Chromaticity]
enumFrom :: Chromaticity -> [Chromaticity]
$cenumFrom :: Chromaticity -> [Chromaticity]
fromEnum :: Chromaticity -> Int
$cfromEnum :: Chromaticity -> Int
toEnum :: Int -> Chromaticity
$ctoEnum :: Int -> Chromaticity
pred :: Chromaticity -> Chromaticity
$cpred :: Chromaticity -> Chromaticity
succ :: Chromaticity -> Chromaticity
$csucc :: Chromaticity -> Chromaticity
Enum, Chromaticity -> Chromaticity -> Bool
(Chromaticity -> Chromaticity -> Bool)
-> (Chromaticity -> Chromaticity -> Bool) -> Eq Chromaticity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Chromaticity -> Chromaticity -> Bool
$c/= :: Chromaticity -> Chromaticity -> Bool
== :: Chromaticity -> Chromaticity -> Bool
$c== :: Chromaticity -> Chromaticity -> Bool
Eq, (forall x. Chromaticity -> Rep Chromaticity x)
-> (forall x. Rep Chromaticity x -> Chromaticity)
-> Generic Chromaticity
forall x. Rep Chromaticity x -> Chromaticity
forall x. Chromaticity -> Rep Chromaticity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Chromaticity x -> Chromaticity
$cfrom :: forall x. Chromaticity -> Rep Chromaticity x
Generic, Enum Chromaticity
Real Chromaticity
Real Chromaticity
-> Enum Chromaticity
-> (Chromaticity -> Chromaticity -> Chromaticity)
-> (Chromaticity -> Chromaticity -> Chromaticity)
-> (Chromaticity -> Chromaticity -> Chromaticity)
-> (Chromaticity -> Chromaticity -> Chromaticity)
-> (Chromaticity -> Chromaticity -> (Chromaticity, Chromaticity))
-> (Chromaticity -> Chromaticity -> (Chromaticity, Chromaticity))
-> (Chromaticity -> Integer)
-> Integral Chromaticity
Chromaticity -> Integer
Chromaticity -> Chromaticity -> (Chromaticity, Chromaticity)
Chromaticity -> Chromaticity -> Chromaticity
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Chromaticity -> Integer
$ctoInteger :: Chromaticity -> Integer
divMod :: Chromaticity -> Chromaticity -> (Chromaticity, Chromaticity)
$cdivMod :: Chromaticity -> Chromaticity -> (Chromaticity, Chromaticity)
quotRem :: Chromaticity -> Chromaticity -> (Chromaticity, Chromaticity)
$cquotRem :: Chromaticity -> Chromaticity -> (Chromaticity, Chromaticity)
mod :: Chromaticity -> Chromaticity -> Chromaticity
$cmod :: Chromaticity -> Chromaticity -> Chromaticity
div :: Chromaticity -> Chromaticity -> Chromaticity
$cdiv :: Chromaticity -> Chromaticity -> Chromaticity
rem :: Chromaticity -> Chromaticity -> Chromaticity
$crem :: Chromaticity -> Chromaticity -> Chromaticity
quot :: Chromaticity -> Chromaticity -> Chromaticity
$cquot :: Chromaticity -> Chromaticity -> Chromaticity
$cp2Integral :: Enum Chromaticity
$cp1Integral :: Real Chromaticity
Integral, Integer -> Chromaticity
Chromaticity -> Chromaticity
Chromaticity -> Chromaticity -> Chromaticity
(Chromaticity -> Chromaticity -> Chromaticity)
-> (Chromaticity -> Chromaticity -> Chromaticity)
-> (Chromaticity -> Chromaticity -> Chromaticity)
-> (Chromaticity -> Chromaticity)
-> (Chromaticity -> Chromaticity)
-> (Chromaticity -> Chromaticity)
-> (Integer -> Chromaticity)
-> Num Chromaticity
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Chromaticity
$cfromInteger :: Integer -> Chromaticity
signum :: Chromaticity -> Chromaticity
$csignum :: Chromaticity -> Chromaticity
abs :: Chromaticity -> Chromaticity
$cabs :: Chromaticity -> Chromaticity
negate :: Chromaticity -> Chromaticity
$cnegate :: Chromaticity -> Chromaticity
* :: Chromaticity -> Chromaticity -> Chromaticity
$c* :: Chromaticity -> Chromaticity -> Chromaticity
- :: Chromaticity -> Chromaticity -> Chromaticity
$c- :: Chromaticity -> Chromaticity -> Chromaticity
+ :: Chromaticity -> Chromaticity -> Chromaticity
$c+ :: Chromaticity -> Chromaticity -> Chromaticity
Num, Eq Chromaticity
Eq Chromaticity
-> (Chromaticity -> Chromaticity -> Ordering)
-> (Chromaticity -> Chromaticity -> Bool)
-> (Chromaticity -> Chromaticity -> Bool)
-> (Chromaticity -> Chromaticity -> Bool)
-> (Chromaticity -> Chromaticity -> Bool)
-> (Chromaticity -> Chromaticity -> Chromaticity)
-> (Chromaticity -> Chromaticity -> Chromaticity)
-> Ord Chromaticity
Chromaticity -> Chromaticity -> Bool
Chromaticity -> Chromaticity -> Ordering
Chromaticity -> Chromaticity -> Chromaticity
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
min :: Chromaticity -> Chromaticity -> Chromaticity
$cmin :: Chromaticity -> Chromaticity -> Chromaticity
max :: Chromaticity -> Chromaticity -> Chromaticity
$cmax :: Chromaticity -> Chromaticity -> Chromaticity
>= :: Chromaticity -> Chromaticity -> Bool
$c>= :: Chromaticity -> Chromaticity -> Bool
> :: Chromaticity -> Chromaticity -> Bool
$c> :: Chromaticity -> Chromaticity -> Bool
<= :: Chromaticity -> Chromaticity -> Bool
$c<= :: Chromaticity -> Chromaticity -> Bool
< :: Chromaticity -> Chromaticity -> Bool
$c< :: Chromaticity -> Chromaticity -> Bool
compare :: Chromaticity -> Chromaticity -> Ordering
$ccompare :: Chromaticity -> Chromaticity -> Ordering
$cp1Ord :: Eq Chromaticity
Ord, ReadPrec [Chromaticity]
ReadPrec Chromaticity
Int -> ReadS Chromaticity
ReadS [Chromaticity]
(Int -> ReadS Chromaticity)
-> ReadS [Chromaticity]
-> ReadPrec Chromaticity
-> ReadPrec [Chromaticity]
-> Read Chromaticity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Chromaticity]
$creadListPrec :: ReadPrec [Chromaticity]
readPrec :: ReadPrec Chromaticity
$creadPrec :: ReadPrec Chromaticity
readList :: ReadS [Chromaticity]
$creadList :: ReadS [Chromaticity]
readsPrec :: Int -> ReadS Chromaticity
$creadsPrec :: Int -> ReadS Chromaticity
Read, Num Chromaticity
Ord Chromaticity
Num Chromaticity
-> Ord Chromaticity
-> (Chromaticity -> Rational)
-> Real Chromaticity
Chromaticity -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Chromaticity -> Rational
$ctoRational :: Chromaticity -> Rational
$cp2Real :: Ord Chromaticity
$cp1Real :: Num Chromaticity
Real, Int -> Chromaticity -> ShowS
[Chromaticity] -> ShowS
Chromaticity -> String
(Int -> Chromaticity -> ShowS)
-> (Chromaticity -> String)
-> ([Chromaticity] -> ShowS)
-> Show Chromaticity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Chromaticity] -> ShowS
$cshowList :: [Chromaticity] -> ShowS
show :: Chromaticity -> String
$cshow :: Chromaticity -> String
showsPrec :: Int -> Chromaticity -> ShowS
$cshowsPrec :: Int -> Chromaticity -> ShowS
Show)

instance NFData Chromaticity

instance Default Chromaticity where
  def :: Chromaticity
def = Chromaticity
forall a. Bounded a => a
maxBound

-- | combination of 'Chromaticity's for the colors 'red', 'green' and 'blue'
data Trichromaticity = Trichromaticity { Trichromaticity -> Chromaticity
red :: Chromaticity
                                       , Trichromaticity -> Chromaticity
green :: Chromaticity
                                       , Trichromaticity -> Chromaticity
blue :: Chromaticity
                                       }
  deriving (Trichromaticity
Trichromaticity -> Trichromaticity -> Bounded Trichromaticity
forall a. a -> a -> Bounded a
maxBound :: Trichromaticity
$cmaxBound :: Trichromaticity
minBound :: Trichromaticity
$cminBound :: Trichromaticity
Bounded, Trichromaticity -> Trichromaticity -> Bool
(Trichromaticity -> Trichromaticity -> Bool)
-> (Trichromaticity -> Trichromaticity -> Bool)
-> Eq Trichromaticity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Trichromaticity -> Trichromaticity -> Bool
$c/= :: Trichromaticity -> Trichromaticity -> Bool
== :: Trichromaticity -> Trichromaticity -> Bool
$c== :: Trichromaticity -> Trichromaticity -> Bool
Eq, (forall x. Trichromaticity -> Rep Trichromaticity x)
-> (forall x. Rep Trichromaticity x -> Trichromaticity)
-> Generic Trichromaticity
forall x. Rep Trichromaticity x -> Trichromaticity
forall x. Trichromaticity -> Rep Trichromaticity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Trichromaticity x -> Trichromaticity
$cfrom :: forall x. Trichromaticity -> Rep Trichromaticity x
Generic, Eq Trichromaticity
Eq Trichromaticity
-> (Trichromaticity -> Trichromaticity -> Ordering)
-> (Trichromaticity -> Trichromaticity -> Bool)
-> (Trichromaticity -> Trichromaticity -> Bool)
-> (Trichromaticity -> Trichromaticity -> Bool)
-> (Trichromaticity -> Trichromaticity -> Bool)
-> (Trichromaticity -> Trichromaticity -> Trichromaticity)
-> (Trichromaticity -> Trichromaticity -> Trichromaticity)
-> Ord Trichromaticity
Trichromaticity -> Trichromaticity -> Bool
Trichromaticity -> Trichromaticity -> Ordering
Trichromaticity -> Trichromaticity -> Trichromaticity
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
min :: Trichromaticity -> Trichromaticity -> Trichromaticity
$cmin :: Trichromaticity -> Trichromaticity -> Trichromaticity
max :: Trichromaticity -> Trichromaticity -> Trichromaticity
$cmax :: Trichromaticity -> Trichromaticity -> Trichromaticity
>= :: Trichromaticity -> Trichromaticity -> Bool
$c>= :: Trichromaticity -> Trichromaticity -> Bool
> :: Trichromaticity -> Trichromaticity -> Bool
$c> :: Trichromaticity -> Trichromaticity -> Bool
<= :: Trichromaticity -> Trichromaticity -> Bool
$c<= :: Trichromaticity -> Trichromaticity -> Bool
< :: Trichromaticity -> Trichromaticity -> Bool
$c< :: Trichromaticity -> Trichromaticity -> Bool
compare :: Trichromaticity -> Trichromaticity -> Ordering
$ccompare :: Trichromaticity -> Trichromaticity -> Ordering
$cp1Ord :: Eq Trichromaticity
Ord, ReadPrec [Trichromaticity]
ReadPrec Trichromaticity
Int -> ReadS Trichromaticity
ReadS [Trichromaticity]
(Int -> ReadS Trichromaticity)
-> ReadS [Trichromaticity]
-> ReadPrec Trichromaticity
-> ReadPrec [Trichromaticity]
-> Read Trichromaticity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Trichromaticity]
$creadListPrec :: ReadPrec [Trichromaticity]
readPrec :: ReadPrec Trichromaticity
$creadPrec :: ReadPrec Trichromaticity
readList :: ReadS [Trichromaticity]
$creadList :: ReadS [Trichromaticity]
readsPrec :: Int -> ReadS Trichromaticity
$creadsPrec :: Int -> ReadS Trichromaticity
Read, Int -> Trichromaticity -> ShowS
[Trichromaticity] -> ShowS
Trichromaticity -> String
(Int -> Trichromaticity -> ShowS)
-> (Trichromaticity -> String)
-> ([Trichromaticity] -> ShowS)
-> Show Trichromaticity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Trichromaticity] -> ShowS
$cshowList :: [Trichromaticity] -> ShowS
show :: Trichromaticity -> String
$cshow :: Trichromaticity -> String
showsPrec :: Int -> Trichromaticity -> ShowS
$cshowsPrec :: Int -> Trichromaticity -> ShowS
Show)

instance NFData Trichromaticity

instance Enum Trichromaticity where
  fromEnum :: Trichromaticity -> Int
fromEnum Trichromaticity
tc = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ Chromaticity -> Int
forall a. Enum a => a -> Int
fromEnum (Trichromaticity -> Chromaticity
red Trichromaticity
tc)
                    , Chromaticity -> Int
forall a. Enum a => a -> Int
fromEnum (Trichromaticity -> Chromaticity
green Trichromaticity
tc) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
range
                    , Chromaticity -> Int
forall a. Enum a => a -> Int
fromEnum (Trichromaticity -> Chromaticity
blue Trichromaticity
tc) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
range Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
range
                    ]
    where range :: Int
range = Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> (Chromaticity -> Int) -> Chromaticity -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chromaticity -> Int
forall a. Enum a => a -> Int
fromEnum (Chromaticity -> Int) -> Chromaticity -> Int
forall a b. (a -> b) -> a -> b
$ Bounded Chromaticity => Chromaticity
forall a. Bounded a => a
maxBound @Chromaticity
  toEnum :: Int -> Trichromaticity
toEnum Int
i = let (Int
b , Int
i') = Int
i Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` (Int
range Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
range)
                 (Int
g , Int
r) = Int
i' Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
range
              in Trichromaticity :: Chromaticity -> Chromaticity -> Chromaticity -> Trichromaticity
Trichromaticity { red :: Chromaticity
red = Int -> Chromaticity
forall a. Enum a => Int -> a
toEnum Int
r
                                 , green :: Chromaticity
green = Int -> Chromaticity
forall a. Enum a => Int -> a
toEnum Int
g
                                 , blue :: Chromaticity
blue = Int -> Chromaticity
forall a. Enum a => Int -> a
toEnum Int
b
                                 }
    where range :: Int
range = Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> (Chromaticity -> Int) -> Chromaticity -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chromaticity -> Int
forall a. Enum a => a -> Int
fromEnum (Chromaticity -> Int) -> Chromaticity -> Int
forall a b. (a -> b) -> a -> b
$ Bounded Chromaticity => Chromaticity
forall a. Bounded a => a
maxBound @Chromaticity

instance Default Trichromaticity where
  def :: Trichromaticity
def = Trichromaticity :: Chromaticity -> Chromaticity -> Chromaticity -> Trichromaticity
Trichromaticity { red :: Chromaticity
red = Chromaticity
forall a. Default a => a
def
                        , green :: Chromaticity
green = Chromaticity
forall a. Default a => a
def
                        , blue :: Chromaticity
blue = Chromaticity
forall a. Default a => a
def
                        }

instance RGB Trichromaticity where
  toRGB :: Trichromaticity -> Trichromaticity
toRGB = Trichromaticity -> Trichromaticity
forall a. a -> a
id