{-# LANGUAGE UndecidableInstances #-}

module Blucontrol.Value.RGB.Temperature (
  Temperature
) where

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

import Blucontrol.Value
import Blucontrol.Value.RGB

-- | Arbitrary precision temperature in Kelvin
newtype Temperature = Temperature Rational
  deriving (Int -> Temperature
Temperature -> Int
Temperature -> [Temperature]
Temperature -> Temperature
Temperature -> Temperature -> [Temperature]
Temperature -> Temperature -> Temperature -> [Temperature]
(Temperature -> Temperature)
-> (Temperature -> Temperature)
-> (Int -> Temperature)
-> (Temperature -> Int)
-> (Temperature -> [Temperature])
-> (Temperature -> Temperature -> [Temperature])
-> (Temperature -> Temperature -> [Temperature])
-> (Temperature -> Temperature -> Temperature -> [Temperature])
-> Enum Temperature
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Temperature -> Temperature
succ :: Temperature -> Temperature
$cpred :: Temperature -> Temperature
pred :: Temperature -> Temperature
$ctoEnum :: Int -> Temperature
toEnum :: Int -> Temperature
$cfromEnum :: Temperature -> Int
fromEnum :: Temperature -> Int
$cenumFrom :: Temperature -> [Temperature]
enumFrom :: Temperature -> [Temperature]
$cenumFromThen :: Temperature -> Temperature -> [Temperature]
enumFromThen :: Temperature -> Temperature -> [Temperature]
$cenumFromTo :: Temperature -> Temperature -> [Temperature]
enumFromTo :: Temperature -> Temperature -> [Temperature]
$cenumFromThenTo :: Temperature -> Temperature -> Temperature -> [Temperature]
enumFromThenTo :: Temperature -> Temperature -> Temperature -> [Temperature]
Enum, Temperature -> Temperature -> Bool
(Temperature -> Temperature -> Bool)
-> (Temperature -> Temperature -> Bool) -> Eq Temperature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Temperature -> Temperature -> Bool
== :: Temperature -> Temperature -> Bool
$c/= :: Temperature -> Temperature -> Bool
/= :: Temperature -> Temperature -> Bool
Eq, Num Temperature
Num Temperature
-> (Temperature -> Temperature -> Temperature)
-> (Temperature -> Temperature)
-> (Rational -> Temperature)
-> Fractional Temperature
Rational -> Temperature
Temperature -> Temperature
Temperature -> Temperature -> Temperature
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: Temperature -> Temperature -> Temperature
/ :: Temperature -> Temperature -> Temperature
$crecip :: Temperature -> Temperature
recip :: Temperature -> Temperature
$cfromRational :: Rational -> Temperature
fromRational :: Rational -> Temperature
Fractional, (forall x. Temperature -> Rep Temperature x)
-> (forall x. Rep Temperature x -> Temperature)
-> Generic Temperature
forall x. Rep Temperature x -> Temperature
forall x. Temperature -> Rep Temperature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Temperature -> Rep Temperature x
from :: forall x. Temperature -> Rep Temperature x
$cto :: forall x. Rep Temperature x -> Temperature
to :: forall x. Rep Temperature x -> Temperature
Generic, Integer -> Temperature
Temperature -> Temperature
Temperature -> Temperature -> Temperature
(Temperature -> Temperature -> Temperature)
-> (Temperature -> Temperature -> Temperature)
-> (Temperature -> Temperature -> Temperature)
-> (Temperature -> Temperature)
-> (Temperature -> Temperature)
-> (Temperature -> Temperature)
-> (Integer -> Temperature)
-> Num Temperature
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Temperature -> Temperature -> Temperature
+ :: Temperature -> Temperature -> Temperature
$c- :: Temperature -> Temperature -> Temperature
- :: Temperature -> Temperature -> Temperature
$c* :: Temperature -> Temperature -> Temperature
* :: Temperature -> Temperature -> Temperature
$cnegate :: Temperature -> Temperature
negate :: Temperature -> Temperature
$cabs :: Temperature -> Temperature
abs :: Temperature -> Temperature
$csignum :: Temperature -> Temperature
signum :: Temperature -> Temperature
$cfromInteger :: Integer -> Temperature
fromInteger :: Integer -> Temperature
Num, Eq Temperature
Eq Temperature
-> (Temperature -> Temperature -> Ordering)
-> (Temperature -> Temperature -> Bool)
-> (Temperature -> Temperature -> Bool)
-> (Temperature -> Temperature -> Bool)
-> (Temperature -> Temperature -> Bool)
-> (Temperature -> Temperature -> Temperature)
-> (Temperature -> Temperature -> Temperature)
-> Ord Temperature
Temperature -> Temperature -> Bool
Temperature -> Temperature -> Ordering
Temperature -> Temperature -> Temperature
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 :: Temperature -> Temperature -> Ordering
compare :: Temperature -> Temperature -> Ordering
$c< :: Temperature -> Temperature -> Bool
< :: Temperature -> Temperature -> Bool
$c<= :: Temperature -> Temperature -> Bool
<= :: Temperature -> Temperature -> Bool
$c> :: Temperature -> Temperature -> Bool
> :: Temperature -> Temperature -> Bool
$c>= :: Temperature -> Temperature -> Bool
>= :: Temperature -> Temperature -> Bool
$cmax :: Temperature -> Temperature -> Temperature
max :: Temperature -> Temperature -> Temperature
$cmin :: Temperature -> Temperature -> Temperature
min :: Temperature -> Temperature -> Temperature
Ord, ReadPrec [Temperature]
ReadPrec Temperature
Int -> ReadS Temperature
ReadS [Temperature]
(Int -> ReadS Temperature)
-> ReadS [Temperature]
-> ReadPrec Temperature
-> ReadPrec [Temperature]
-> Read Temperature
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Temperature
readsPrec :: Int -> ReadS Temperature
$creadList :: ReadS [Temperature]
readList :: ReadS [Temperature]
$creadPrec :: ReadPrec Temperature
readPrec :: ReadPrec Temperature
$creadListPrec :: ReadPrec [Temperature]
readListPrec :: ReadPrec [Temperature]
Read, Num Temperature
Ord Temperature
Num Temperature
-> Ord Temperature -> (Temperature -> Rational) -> Real Temperature
Temperature -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
$ctoRational :: Temperature -> Rational
toRational :: Temperature -> Rational
Real, Fractional Temperature
Real Temperature
Real Temperature
-> Fractional Temperature
-> (forall b. Integral b => Temperature -> (b, Temperature))
-> (forall b. Integral b => Temperature -> b)
-> (forall b. Integral b => Temperature -> b)
-> (forall b. Integral b => Temperature -> b)
-> (forall b. Integral b => Temperature -> b)
-> RealFrac Temperature
forall b. Integral b => Temperature -> b
forall b. Integral b => Temperature -> (b, Temperature)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
$cproperFraction :: forall b. Integral b => Temperature -> (b, Temperature)
properFraction :: forall b. Integral b => Temperature -> (b, Temperature)
$ctruncate :: forall b. Integral b => Temperature -> b
truncate :: forall b. Integral b => Temperature -> b
$cround :: forall b. Integral b => Temperature -> b
round :: forall b. Integral b => Temperature -> b
$cceiling :: forall b. Integral b => Temperature -> b
ceiling :: forall b. Integral b => Temperature -> b
$cfloor :: forall b. Integral b => Temperature -> b
floor :: forall b. Integral b => Temperature -> b
RealFrac, Int -> Temperature -> ShowS
[Temperature] -> ShowS
Temperature -> String
(Int -> Temperature -> ShowS)
-> (Temperature -> String)
-> ([Temperature] -> ShowS)
-> Show Temperature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Temperature -> ShowS
showsPrec :: Int -> Temperature -> ShowS
$cshow :: Temperature -> String
show :: Temperature -> String
$cshowList :: [Temperature] -> ShowS
showList :: [Temperature] -> ShowS
Show)

instance NFData Temperature

instance Bounded Temperature where
  minBound :: Temperature
minBound = Temperature
0
  maxBound :: Temperature
maxBound = Temperature
20000

instance Default Temperature where
  def :: Temperature
def = Temperature
6600

instance CompatibleValues (RGB Word8) a => CompatibleValues Temperature a where
  -- TODO: Test and implement more accurately. Currently based on blugon.
  convertValue :: Temperature -> a
convertValue = RGB Word8 -> a
forall a b. CompatibleValues a b => a -> b
convertValue (RGB Word8 -> a) -> (Temperature -> RGB Word8) -> Temperature -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Temperature -> RGB Word8
toRGBWord8
    where toRGBWord8 :: Temperature -> RGB Word8
          toRGBWord8 :: Temperature -> RGB Word8
toRGBWord8 (Temperature Rational
temp) = RGB { Word8
red :: Word8
red :: Word8
red, Word8
green :: Word8
green :: Word8
green, Word8
blue :: Word8
blue :: Word8
blue }
            where red :: Word8
red = Double -> Word8
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Word8) -> (Double -> Double) -> Double -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall {a}. (Ord a, Num a) => a -> a
inBounds (Double -> Word8) -> Double -> Word8
forall a b. (a -> b) -> a -> b
$
                    if Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
66
                       then Double
255
                       else Double
329.698727446 Double -> Double -> Double
forall a. Num a => a -> a -> a
* ((Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
60) Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (-Double
0.1332047592))
                  green :: Word8
green = Double -> Word8
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Word8) -> (Double -> Double) -> Double -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall {a}. (Ord a, Num a) => a -> a
inBounds (Double -> Word8) -> Double -> Word8
forall a b. (a -> b) -> a -> b
$
                    if Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
66
                       then Double
99.4708025861 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
log Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
161.1195681661
                       else Double
288.1221695283 Double -> Double -> Double
forall a. Num a => a -> a -> a
* ((Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
60) Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (-Double
0.0755148492))
                  blue :: Word8
blue = Double -> Word8
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Word8) -> (Double -> Double) -> Double -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall {a}. (Ord a, Num a) => a -> a
inBounds (Double -> Word8) -> Double -> Word8
forall a b. (a -> b) -> a -> b
$
                    if Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0
                       then Double
0
                       else if Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
66
                               then Double
255
                               else Double
138.5177312231 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
log (Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
10) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
305.0447927307
                  t :: Double
t = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Rational
temp Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
100 :: Double
                  inBounds :: a -> a
inBounds a
x
                    | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = a
0
                    | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
255 = a
255
                    | Bool
otherwise = a
x