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

{- |
Note that when 'kelvin' has an effect (i.e. when saturation is any less than maximum), output is somewhat arbitrary.

LIFX's team have never shared an exact formula, and this implementation is inspired by various conflicting sources.
-}
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
                    }

-- | Kelvin in output is always 0.
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