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 Data.Colour.RGBSpace.HSV qualified as 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
}
rgbToHsbk :: RGB Float -> HSBK
rgbToHsbk :: RGB Float -> HSBK
rgbToHsbk RGB Float
c =
HSBK
{ $sel:hue:HSBK :: Word16
hue = forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ forall a. (Fractional a, Ord a) => RGB a -> a
HSV.hue RGB Float
c forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound @Word16 forall a. Integral a => a -> a -> a
`div` Word16
360)
, $sel:saturation:HSBK :: Word16
saturation = forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ forall a. (Fractional a, Ord a) => RGB a -> a
HSV.saturation RGB Float
c forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound @Word16)
, $sel:brightness:HSBK :: Word16
brightness = forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ forall a. (Fractional a, Ord a) => RGB a -> a
HSV.value RGB Float
c forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound @Word16)
, $sel:kelvin:HSBK :: Word16
kelvin = Word16
0
}
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