{-# LANGUAGE RecordWildCards #-}

module Blucontrol.RGB.Temperature (
  Temperature
) where

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

import Blucontrol.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
enumFromThenTo :: Temperature -> Temperature -> Temperature -> [Temperature]
$cenumFromThenTo :: Temperature -> Temperature -> Temperature -> [Temperature]
enumFromTo :: Temperature -> Temperature -> [Temperature]
$cenumFromTo :: Temperature -> Temperature -> [Temperature]
enumFromThen :: Temperature -> Temperature -> [Temperature]
$cenumFromThen :: Temperature -> Temperature -> [Temperature]
enumFrom :: Temperature -> [Temperature]
$cenumFrom :: Temperature -> [Temperature]
fromEnum :: Temperature -> Int
$cfromEnum :: Temperature -> Int
toEnum :: Int -> Temperature
$ctoEnum :: Int -> Temperature
pred :: Temperature -> Temperature
$cpred :: Temperature -> Temperature
succ :: Temperature -> Temperature
$csucc :: Temperature -> Temperature
Enum, Temperature -> Temperature -> Bool
(Temperature -> Temperature -> Bool)
-> (Temperature -> Temperature -> Bool) -> Eq Temperature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Temperature -> Temperature -> Bool
$c/= :: Temperature -> Temperature -> Bool
== :: Temperature -> Temperature -> Bool
$c== :: 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
fromRational :: Rational -> Temperature
$cfromRational :: Rational -> Temperature
recip :: Temperature -> Temperature
$crecip :: Temperature -> Temperature
/ :: Temperature -> Temperature -> Temperature
$c/ :: Temperature -> Temperature -> Temperature
$cp1Fractional :: Num 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
$cto :: forall x. Rep Temperature x -> Temperature
$cfrom :: forall x. Temperature -> Rep Temperature x
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
fromInteger :: Integer -> Temperature
$cfromInteger :: Integer -> Temperature
signum :: Temperature -> Temperature
$csignum :: Temperature -> Temperature
abs :: Temperature -> Temperature
$cabs :: Temperature -> Temperature
negate :: Temperature -> Temperature
$cnegate :: Temperature -> Temperature
* :: Temperature -> Temperature -> Temperature
$c* :: Temperature -> Temperature -> Temperature
- :: Temperature -> Temperature -> Temperature
$c- :: Temperature -> Temperature -> Temperature
+ :: Temperature -> Temperature -> Temperature
$c+ :: Temperature -> Temperature -> 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
min :: Temperature -> Temperature -> Temperature
$cmin :: Temperature -> Temperature -> Temperature
max :: Temperature -> Temperature -> Temperature
$cmax :: Temperature -> Temperature -> Temperature
>= :: Temperature -> Temperature -> Bool
$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
compare :: Temperature -> Temperature -> Ordering
$ccompare :: Temperature -> Temperature -> Ordering
$cp1Ord :: Eq 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
readListPrec :: ReadPrec [Temperature]
$creadListPrec :: ReadPrec [Temperature]
readPrec :: ReadPrec Temperature
$creadPrec :: ReadPrec Temperature
readList :: ReadS [Temperature]
$creadList :: ReadS [Temperature]
readsPrec :: Int -> ReadS Temperature
$creadsPrec :: Int -> ReadS 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
toRational :: Temperature -> Rational
$ctoRational :: Temperature -> Rational
$cp2Real :: Ord Temperature
$cp1Real :: Num Temperature
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
Temperature -> b
Temperature -> b
Temperature -> b
Temperature -> b
Temperature -> (b, 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
floor :: Temperature -> b
$cfloor :: forall b. Integral b => Temperature -> b
ceiling :: Temperature -> b
$cceiling :: forall b. Integral b => Temperature -> b
round :: Temperature -> b
$cround :: forall b. Integral b => Temperature -> b
truncate :: Temperature -> b
$ctruncate :: forall b. Integral b => Temperature -> b
properFraction :: Temperature -> (b, Temperature)
$cproperFraction :: forall b. Integral b => Temperature -> (b, Temperature)
$cp2RealFrac :: Fractional Temperature
$cp1RealFrac :: Real Temperature
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
showList :: [Temperature] -> ShowS
$cshowList :: [Temperature] -> ShowS
show :: Temperature -> String
$cshow :: Temperature -> String
showsPrec :: Int -> Temperature -> ShowS
$cshowsPrec :: Int -> 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 RGB Temperature where
  -- TODO: test and implement more accurate, currently based on blugon
  toRGB :: Temperature -> Trichromaticity
toRGB (Temperature Rational
temp) = Trichromaticity :: Chromaticity -> Chromaticity -> Chromaticity -> Trichromaticity
Trichromaticity {Chromaticity
blue :: Chromaticity
green :: Chromaticity
red :: Chromaticity
blue :: Chromaticity
green :: Chromaticity
red :: Chromaticity
..}
    where red :: Chromaticity
red = Double -> Chromaticity
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Chromaticity)
-> (Double -> Double) -> Double -> Chromaticity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall p. (Ord p, Num p) => p -> p
inBounds (Double -> Chromaticity) -> Double -> Chromaticity
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 :: Chromaticity
green = Double -> Chromaticity
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Chromaticity)
-> (Double -> Double) -> Double -> Chromaticity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall p. (Ord p, Num p) => p -> p
inBounds (Double -> Chromaticity) -> Double -> Chromaticity
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 :: Chromaticity
blue = Double -> Chromaticity
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Chromaticity)
-> (Double -> Double) -> Double -> Chromaticity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall p. (Ord p, Num p) => p -> p
inBounds (Double -> Chromaticity) -> Double -> Chromaticity
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 :: p -> p
inBounds p
x
            | p
x p -> p -> Bool
forall a. Ord a => a -> a -> Bool
< p
0 = p
0
            | p
x p -> p -> Bool
forall a. Ord a => a -> a -> Bool
> p
255 = p
255
            | Bool
otherwise = p
x