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
hue :: Word16
saturation :: Word16
brightness :: Word16
kelvin :: Word16
$sel:hue:HSBK :: HSBK -> Word16
$sel:saturation:HSBK :: HSBK -> Word16
$sel:brightness:HSBK :: HSBK -> Word16
$sel:kelvin:HSBK :: HSBK -> Word16
..} =
    Float -> RGB Float -> RGB Float -> RGB Float
forall a. Num a => a -> RGB a -> RGB a -> RGB a
interpolateColour
        (Word16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
saturation Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
maxWord16)
        RGB Float
c
        RGB Float
c'
  where
    c :: RGB Float
c =
        Float -> Float -> Float -> RGB Float
forall a. (RealFrac a, Ord a) => a -> a -> a -> RGB a
hsv
            (Float
360 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Word16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
hue Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
maxWord16)
            (Word16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
saturation Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
maxWord16)
            (Word16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
brightness Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
maxWord16)
    c' :: RGB Float
c' =
        let t :: Float
t =
                (Float -> Float
forall a. Floating a => a -> a
log (Word16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
kelvin) Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float -> Float
forall a. Floating a => a -> a
log Float
forall a. Num a => a
minKelvin)
                    Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float -> Float
forall a. Floating a => a -> a
log (Float
forall a. Num a => a
maxKelvin Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
forall a. Num a => a
minKelvin)
         in (Float, Float) -> Float -> Float
forall a. Ord a => (a, a) -> a -> a
clamp (Float
0, Float
1)
                (Float -> Float) -> RGB Float -> RGB Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RGB
                    { channelRed :: Float
channelRed = Float
1
                    , channelGreen :: Float
channelGreen = Float
t Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2 Float -> Float -> Float
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 = Float -> Word16
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Float -> Word16) -> Float -> Word16
forall a b. (a -> b) -> a -> b
$ RGB Float -> Float
forall a. (Fractional a, Ord a) => RGB a -> a
HSV.hue RGB Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* Word16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound @Word16 Word16 -> Word16 -> Word16
forall a. Integral a => a -> a -> a
`div` Word16
360)
        , $sel:saturation:HSBK :: Word16
saturation = Float -> Word16
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Float -> Word16) -> Float -> Word16
forall a b. (a -> b) -> a -> b
$ RGB Float -> Float
forall a. (Fractional a, Ord a) => RGB a -> a
HSV.saturation RGB Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* Word16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound @Word16)
        , $sel:brightness:HSBK :: Word16
brightness = Float -> Word16
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Float -> Word16) -> Float -> Word16
forall a b. (a -> b) -> a -> b
$ RGB Float -> Float
forall a. (Fractional a, Ord a) => RGB a -> a
HSV.value RGB Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* Word16 -> Float
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 = (a -> a -> a) -> RGB a -> RGB a -> RGB a
forall a b c. (a -> b -> c) -> RGB a -> RGB b -> RGB c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\a
a a
b -> a
a a -> a -> a
forall a. Num a => a -> a -> a
* (a
r a -> a -> a
forall a. Num a => a -> a -> a
+ a
b a -> a -> a
forall a. Num a => a -> a -> a
* (a
1 a -> a -> a
forall a. Num a => a -> a -> a
- a
r)))

maxWord16 :: Float
maxWord16 :: Float
maxWord16 = Word16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Float) -> Word16 -> Float
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