module Lifx.Internal.Colour where
import Control.Applicative
import Data.Colour.SRGB
import Data.Ord
import Data.Word
import Data.Colour.RGBSpace.HSV (hsv)
import Lifx.Lan.Internal
hsbkToRgb :: HSBK -> RGB Float
hsbkToRgb :: HSBK -> RGB Float
hsbkToRgb HSBK{Word16
$sel:kelvin:HSBK :: HSBK -> Word16
$sel:brightness:HSBK :: HSBK -> Word16
$sel:saturation:HSBK :: HSBK -> Word16
$sel:hue:HSBK :: HSBK -> Word16
kelvin :: Word16
brightness :: Word16
saturation :: Word16
hue :: Word16
..} =
forall a. Num a => a -> RGB a -> RGB a -> RGB a
interpolateColour
(forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
saturation forall a. Fractional a => a -> a -> a
/ Float
maxWord16)
RGB Float
c
RGB Float
c'
where
c :: RGB Float
c =
forall a. (RealFrac a, Ord a) => a -> a -> a -> RGB a
hsv
(Float
360 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
hue forall a. Fractional a => a -> a -> a
/ Float
maxWord16)
(forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
saturation forall a. Fractional a => a -> a -> a
/ Float
maxWord16)
(forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
brightness forall a. Fractional a => a -> a -> a
/ Float
maxWord16)
c' :: RGB Float
c' =
let t :: Float
t =
(forall a. Floating a => a -> a
log (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
kelvin) forall a. Num a => a -> a -> a
- forall a. Floating a => a -> a
log forall a. Num a => a
minKelvin)
forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a -> a
log (forall a. Num a => a
maxKelvin forall a. Fractional a => a -> a -> a
/ forall a. Num a => a
minKelvin)
in forall a. Ord a => (a, a) -> a -> a
clamp (Float
0, Float
1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RGB
{ channelRed :: Float
channelRed = Float
1
, channelGreen :: Float
channelGreen = Float
t forall a. Fractional a => a -> a -> a
/ Float
2 forall a. Num a => a -> a -> a
+ Float
0.5
, channelBlue :: Float
channelBlue = Float
t
}
interpolateColour :: Num a => a -> RGB a -> RGB a -> RGB a
interpolateColour :: forall a. Num a => a -> RGB a -> RGB a -> RGB a
interpolateColour a
r = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\a
a a
b -> a
a forall a. Num a => a -> a -> a
* (a
r forall a. Num a => a -> a -> a
+ a
b forall a. Num a => a -> a -> a
* (a
1 forall a. Num a => a -> a -> a
- a
r)))
maxWord16 :: Float
maxWord16 :: Float
maxWord16 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Bounded a => a
maxBound @Word16
minKelvin :: Num a => a
minKelvin :: forall a. Num a => a
minKelvin = a
1500
maxKelvin :: Num a => a
maxKelvin :: forall a. Num a => a
maxKelvin = a
9000