{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | An orphan instnace to parse @'Data.Colour' 'Double'@ as a word64
module Calamity.Internal.IntColour
    ( colourToWord64
    , colourFromWord64 ) where

import           Data.Aeson
import           Data.Bits
import           Data.Colour
import           Data.Colour.SRGB ( RGB(RGB), sRGB24, toSRGB24 )
import           Data.Word        ( Word64 )

colourToWord64 :: Colour Double -> Word64
colourToWord64 :: Colour Double -> Word64
colourToWord64 c :: Colour Double
c = let RGB r :: Word8
r g :: Word8
g b :: Word8
b = Colour Double -> RGB Word8
forall b. (RealFrac b, Floating b) => Colour b -> RGB Word8
toSRGB24 Colour Double
c
                       i :: Word64
i         = (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
r Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` 16) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
g Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` 8) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b
                   in Word64
i

colourFromWord64 :: Word64 -> Colour Double
colourFromWord64 :: Word64 -> Colour Double
colourFromWord64 i :: Word64
i = let r :: Word64
r = (Word64
i Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` 16) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 0xff
                         g :: Word64
g = (Word64
i Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` 8) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 0xff
                         b :: Word64
b = Word64
i Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 0xff
                     in Word8 -> Word8 -> Word8 -> Colour Double
forall b.
(Ord b, Floating b) =>
Word8 -> Word8 -> Word8 -> Colour b
sRGB24 (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
r) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
g) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
b)

instance ToJSON (Colour Double) where
  toJSON :: Colour Double -> Value
toJSON = Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (Word64 -> Value)
-> (Colour Double -> Word64) -> Colour Double -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Colour Double -> Word64
colourToWord64

instance FromJSON (Colour Double) where
  parseJSON :: Value -> Parser (Colour Double)
parseJSON v :: Value
v = Word64 -> Colour Double
colourFromWord64 (Word64 -> Colour Double)
-> Parser Word64 -> Parser (Colour Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Word64
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v