{-# OPTIONS_HADDOCK hide #-}
module Codec.BMP.BitmapInfoV5
        ( BitmapInfoV5  (..)
        , sizeOfBitmapInfoV5
        , checkBitmapInfoV5
        , imageSizeFromBitmapInfoV5)
where
import Codec.BMP.Error
import Codec.BMP.BitmapInfoV4
import Data.Binary
import Data.Binary.Get  
import Data.Binary.Put


-- | Device Independent Bitmap (DIB) header for Windows V5 (98/2000 and newer)
data BitmapInfoV5
        = BitmapInfoV5
        { BitmapInfoV5 -> BitmapInfoV4
dib5InfoV4            :: BitmapInfoV4
        
        -- | Rendering intent for the bitmap.
        , BitmapInfoV5 -> Word32
dib5Intent            :: Word32

        -- | Offset (in bytes) from the beginning of the header to the start
        --   of the profile data.
        , BitmapInfoV5 -> Word32
dib5ProfileData       :: Word32

        -- | Size (in bytes) of embedded profile data.
        , BitmapInfoV5 -> Word32
dib5ProfileSize       :: Word32
        
        -- | Reserved, should be zero.
        , BitmapInfoV5 -> Word32
dib5Reserved          :: Word32
        }
        deriving (Int -> BitmapInfoV5 -> ShowS
[BitmapInfoV5] -> ShowS
BitmapInfoV5 -> String
(Int -> BitmapInfoV5 -> ShowS)
-> (BitmapInfoV5 -> String)
-> ([BitmapInfoV5] -> ShowS)
-> Show BitmapInfoV5
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BitmapInfoV5 -> ShowS
showsPrec :: Int -> BitmapInfoV5 -> ShowS
$cshow :: BitmapInfoV5 -> String
show :: BitmapInfoV5 -> String
$cshowList :: [BitmapInfoV5] -> ShowS
showList :: [BitmapInfoV5] -> ShowS
Show)

-- | Size of `BitmapInfoV5` header (in bytes)
sizeOfBitmapInfoV5 :: Int
sizeOfBitmapInfoV5 :: Int
sizeOfBitmapInfoV5 = Int
124


instance Binary BitmapInfoV5 where
 get :: Get BitmapInfoV5
get
  = do  BitmapInfoV4
infoV4  <- Get BitmapInfoV4
forall t. Binary t => Get t
get
        Word32
intent  <- Get Word32
getWord32le
        Word32
pdata   <- Get Word32
getWord32le
        Word32
psize   <- Get Word32
getWord32le
        Word32
res     <- Get Word32
getWord32le
        
        BitmapInfoV5 -> Get BitmapInfoV5
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return  (BitmapInfoV5 -> Get BitmapInfoV5)
-> BitmapInfoV5 -> Get BitmapInfoV5
forall a b. (a -> b) -> a -> b
$ BitmapInfoV5
                { dib5InfoV4 :: BitmapInfoV4
dib5InfoV4            = BitmapInfoV4
infoV4
                , dib5Intent :: Word32
dib5Intent            = Word32
intent
                , dib5ProfileData :: Word32
dib5ProfileData       = Word32
pdata
                , dib5ProfileSize :: Word32
dib5ProfileSize       = Word32
psize
                , dib5Reserved :: Word32
dib5Reserved          = Word32
res }
                

 put :: BitmapInfoV5 -> Put
put BitmapInfoV5
header
  = do  BitmapInfoV4 -> Put
forall t. Binary t => t -> Put
put             (BitmapInfoV4 -> Put) -> BitmapInfoV4 -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV5 -> BitmapInfoV4
dib5InfoV4            BitmapInfoV5
header
        Word32 -> Put
putWord32le     (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV5 -> Word32
dib5Intent            BitmapInfoV5
header
        Word32 -> Put
putWord32le     (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV5 -> Word32
dib5ProfileData       BitmapInfoV5
header
        Word32 -> Put
putWord32le     (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV5 -> Word32
dib5ProfileSize       BitmapInfoV5
header
        Word32 -> Put
putWord32le     (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV5 -> Word32
dib5Reserved          BitmapInfoV5
header

        
-- | Check headers for problems and unsupported features.        
--      The V5 header doesn't give us any more useful info than the V4 one.
checkBitmapInfoV5 :: BitmapInfoV5 -> Word32 -> Maybe Error
checkBitmapInfoV5 :: BitmapInfoV5 -> Word32 -> Maybe Error
checkBitmapInfoV5 BitmapInfoV5
header Word32
expectedImageSize
        = BitmapInfoV4 -> Word32 -> Maybe Error
checkBitmapInfoV4 (BitmapInfoV5 -> BitmapInfoV4
dib5InfoV4 BitmapInfoV5
header) Word32
expectedImageSize


-- | Compute the size of the image data from the header.
imageSizeFromBitmapInfoV5 :: BitmapInfoV5 -> Maybe Int
imageSizeFromBitmapInfoV5 :: BitmapInfoV5 -> Maybe Int
imageSizeFromBitmapInfoV5 
        = BitmapInfoV4 -> Maybe Int
imageSizeFromBitmapInfoV4 (BitmapInfoV4 -> Maybe Int)
-> (BitmapInfoV5 -> BitmapInfoV4) -> BitmapInfoV5 -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitmapInfoV5 -> BitmapInfoV4
dib5InfoV4