module Codec.BMP.CIEXYZ
        (CIEXYZ(..))
where
import Data.Word
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put 


-- | Contains the XYZ coordinates of a specific color in a specified color
--   space.
data CIEXYZ 
        = CIEXYZ Word32 Word32 Word32
        deriving Int -> CIEXYZ -> ShowS
[CIEXYZ] -> ShowS
CIEXYZ -> String
(Int -> CIEXYZ -> ShowS)
-> (CIEXYZ -> String) -> ([CIEXYZ] -> ShowS) -> Show CIEXYZ
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CIEXYZ -> ShowS
showsPrec :: Int -> CIEXYZ -> ShowS
$cshow :: CIEXYZ -> String
show :: CIEXYZ -> String
$cshowList :: [CIEXYZ] -> ShowS
showList :: [CIEXYZ] -> ShowS
Show


instance Binary CIEXYZ where
 get :: Get CIEXYZ
get 
  = do  Word32
r       <- Get Word32
getWord32le
        Word32
g       <- Get Word32
getWord32le
        Word32
b       <- Get Word32
getWord32le
        CIEXYZ -> Get CIEXYZ
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return  (CIEXYZ -> Get CIEXYZ) -> CIEXYZ -> Get CIEXYZ
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> Word32 -> CIEXYZ
CIEXYZ Word32
r Word32
g Word32
b
        
 put :: CIEXYZ -> Put
put (CIEXYZ Word32
r Word32
g Word32
b)
  = do  Word32 -> Put
putWord32le Word32
r
        Word32 -> Put
putWord32le Word32
g
        Word32 -> Put
putWord32le Word32
b