{-# OPTIONS_HADDOCK hide #-}
module Codec.BMP.BitmapInfoV4
        ( BitmapInfoV4  (..)
        , CIEXYZ        (..)
        , sizeOfBitmapInfoV4
        , checkBitmapInfoV4
        , imageSizeFromBitmapInfoV4)
where
import Codec.BMP.Error
import Codec.BMP.CIEXYZ
import Codec.BMP.BitmapInfoV3
import Data.Binary
import Data.Binary.Get  
import Data.Binary.Put


-- | Device Independent Bitmap (DIB) header for Windows V4 (95 and newer)
data BitmapInfoV4
        = BitmapInfoV4
        { -- | Size of the image header, in bytes.
          BitmapInfoV4 -> BitmapInfoV3
dib4InfoV3            :: BitmapInfoV3

          -- | Color masks specify components of each pixel.
          --   Only used with the bitfields compression mode.
        , BitmapInfoV4 -> Word32
dib4RedMask           :: Word32
        , BitmapInfoV4 -> Word32
dib4GreenMask         :: Word32
        , BitmapInfoV4 -> Word32
dib4BlueMask          :: Word32
        , BitmapInfoV4 -> Word32
dib4AlphaMask         :: Word32

        -- | The color space used by the image.
        , BitmapInfoV4 -> Word32
dib4ColorSpaceType    :: Word32

        -- | Specifies the XYZ coords of the three colors that correspond to
        --   the RGB endpoints for the logical color space associated with the
        --   bitmap. Only used when ColorSpaceType specifies a calibrated image.
        , BitmapInfoV4 -> (CIEXYZ, CIEXYZ, CIEXYZ)
dib4Endpoints         :: (CIEXYZ, CIEXYZ, CIEXYZ)

        -- | Toned response curves for each component. 
        --   Only used when the ColorSpaceType specifies a calibrated image.
        , BitmapInfoV4 -> Word32
dib4GammaRed          :: Word32
        , BitmapInfoV4 -> Word32
dib4GammaGreen        :: Word32
        , BitmapInfoV4 -> Word32
dib4GammaBlue         :: Word32
        }
        deriving (Int -> BitmapInfoV4 -> ShowS
[BitmapInfoV4] -> ShowS
BitmapInfoV4 -> String
(Int -> BitmapInfoV4 -> ShowS)
-> (BitmapInfoV4 -> String)
-> ([BitmapInfoV4] -> ShowS)
-> Show BitmapInfoV4
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BitmapInfoV4 -> ShowS
showsPrec :: Int -> BitmapInfoV4 -> ShowS
$cshow :: BitmapInfoV4 -> String
show :: BitmapInfoV4 -> String
$cshowList :: [BitmapInfoV4] -> ShowS
showList :: [BitmapInfoV4] -> ShowS
Show)


-- | Size of `BitmapInfoV4` header (in bytes)
sizeOfBitmapInfoV4 :: Int
sizeOfBitmapInfoV4 :: Int
sizeOfBitmapInfoV4 = Int
108


instance Binary BitmapInfoV4 where
 get :: Get BitmapInfoV4
get
  = do  BitmapInfoV3
infoV3  <- Get BitmapInfoV3
forall t. Binary t => Get t
get
        Word32
rmask   <- Get Word32
getWord32le
        Word32
gmask   <- Get Word32
getWord32le
        Word32
bmask   <- Get Word32
getWord32le
        Word32
amask   <- Get Word32
getWord32le
        Word32
cstype  <- Get Word32
getWord32le
        (CIEXYZ, CIEXYZ, CIEXYZ)
ends    <- Get (CIEXYZ, CIEXYZ, CIEXYZ)
forall t. Binary t => Get t
get
        Word32
rgamma  <- Get Word32
getWord32le
        Word32
ggamma  <- Get Word32
getWord32le
        Word32
bgamma  <- Get Word32
getWord32le
        
        BitmapInfoV4 -> Get BitmapInfoV4
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return  (BitmapInfoV4 -> Get BitmapInfoV4)
-> BitmapInfoV4 -> Get BitmapInfoV4
forall a b. (a -> b) -> a -> b
$ BitmapInfoV4
                { dib4InfoV3 :: BitmapInfoV3
dib4InfoV3            = BitmapInfoV3
infoV3
                , dib4RedMask :: Word32
dib4RedMask           = Word32
rmask
                , dib4GreenMask :: Word32
dib4GreenMask         = Word32
gmask
                , dib4BlueMask :: Word32
dib4BlueMask          = Word32
bmask
                , dib4AlphaMask :: Word32
dib4AlphaMask         = Word32
amask
                , dib4ColorSpaceType :: Word32
dib4ColorSpaceType    = Word32
cstype
                , dib4Endpoints :: (CIEXYZ, CIEXYZ, CIEXYZ)
dib4Endpoints         = (CIEXYZ, CIEXYZ, CIEXYZ)
ends
                , dib4GammaRed :: Word32
dib4GammaRed          = Word32
rgamma
                , dib4GammaGreen :: Word32
dib4GammaGreen        = Word32
ggamma
                , dib4GammaBlue :: Word32
dib4GammaBlue         = Word32
bgamma }
                

 put :: BitmapInfoV4 -> Put
put BitmapInfoV4
header
  = do  BitmapInfoV3 -> Put
forall t. Binary t => t -> Put
put             (BitmapInfoV3 -> Put) -> BitmapInfoV3 -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV4 -> BitmapInfoV3
dib4InfoV3            BitmapInfoV4
header
        Word32 -> Put
putWord32le     (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV4 -> Word32
dib4RedMask           BitmapInfoV4
header
        Word32 -> Put
putWord32le     (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV4 -> Word32
dib4GreenMask         BitmapInfoV4
header
        Word32 -> Put
putWord32le     (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV4 -> Word32
dib4BlueMask          BitmapInfoV4
header
        Word32 -> Put
putWord32le     (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV4 -> Word32
dib4AlphaMask         BitmapInfoV4
header
        Word32 -> Put
putWord32le     (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV4 -> Word32
dib4ColorSpaceType    BitmapInfoV4
header
        (CIEXYZ, CIEXYZ, CIEXYZ) -> Put
forall t. Binary t => t -> Put
put             ((CIEXYZ, CIEXYZ, CIEXYZ) -> Put)
-> (CIEXYZ, CIEXYZ, CIEXYZ) -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV4 -> (CIEXYZ, CIEXYZ, CIEXYZ)
dib4Endpoints         BitmapInfoV4
header
        Word32 -> Put
putWord32le     (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV4 -> Word32
dib4GammaRed          BitmapInfoV4
header
        Word32 -> Put
putWord32le     (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV4 -> Word32
dib4GammaGreen        BitmapInfoV4
header
        Word32 -> Put
putWord32le     (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV4 -> Word32
dib4GammaBlue         BitmapInfoV4
header

        
-- | Check headers for problems and unsupported features.        
--      With a V4 header we support both the uncompressed 24bit RGB format,
--      and the uncompressed 32bit RGBA format.
--
checkBitmapInfoV4 :: BitmapInfoV4 -> Word32 -> Maybe Error
checkBitmapInfoV4 :: BitmapInfoV4 -> Word32 -> Maybe Error
checkBitmapInfoV4 BitmapInfoV4
headerV4 Word32
physicalBufferSize
                
        -- We only handle a single color plane.
        | BitmapInfoV3 -> Word16
dib3Planes BitmapInfoV3
headerV3 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
1
        = Error -> Maybe Error
forall a. a -> Maybe a
Just  (Error -> Maybe Error) -> Error -> Maybe Error
forall a b. (a -> b) -> a -> b
$ Word16 -> Error
ErrorUnhandledPlanesCount (Word16 -> Error) -> Word16 -> Error
forall a b. (a -> b) -> a -> b
$ BitmapInfoV3 -> Word16
dib3Planes BitmapInfoV3
headerV3

        -- We only handle 24 and 32 bit images.
        | BitmapInfoV3 -> Word16
dib3BitCount BitmapInfoV3
headerV3 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
24
        , BitmapInfoV3 -> Word16
dib3BitCount BitmapInfoV3
headerV3 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
32
        = Error -> Maybe Error
forall a. a -> Maybe a
Just  (Error -> Maybe Error) -> Error -> Maybe Error
forall a b. (a -> b) -> a -> b
$ Word16 -> Error
ErrorUnhandledColorDepth (Word16 -> Error) -> Word16 -> Error
forall a b. (a -> b) -> a -> b
$ BitmapInfoV3 -> Word16
dib3BitCount BitmapInfoV3
headerV3

        -- If the image size field in the header is non-zero, 
        -- then it must be less than the physical size of the image buffer.
        --  The buffer may be larger than the size of the image stated
        --  in the header, because some encoders add padding to the end.
        | Word32
headerImageSize               <- BitmapInfoV3 -> Word32
dib3ImageSize BitmapInfoV3
headerV3
        , Word32
headerImageSize Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0
        , Word32
physicalBufferSize             Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
headerImageSize
        = Error -> Maybe Error
forall a. a -> Maybe a
Just  (Error -> Maybe Error) -> Error -> Maybe Error
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> Error
ErrorImagePhysicalSizeMismatch
                        Word32
headerImageSize Word32
physicalBufferSize

        -- Check that the physical buffer contains enough image data.
        -- It may contain more, as some encoders put padding bytes
        -- on the end.
        | Just Int
calculatedImageSize      <- BitmapInfoV4 -> Maybe Int
imageSizeFromBitmapInfoV4 BitmapInfoV4
headerV4
        , Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
physicalBufferSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
calculatedImageSize
        = Error -> Maybe Error
forall a. a -> Maybe a
Just  (Error -> Maybe Error) -> Error -> Maybe Error
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Error
ErrorImageDataTruncated 
                        Int
calculatedImageSize
                        (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
physicalBufferSize)


        -- Check for valid compression modes ----
        -- uncompressed 32bit RGBA stated as CompressionRGB.
        | BitmapInfoV3 -> Word16
dib3BitCount    BitmapInfoV3
headerV3 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
32
        , BitmapInfoV3 -> Compression
dib3Compression BitmapInfoV3
headerV3 Compression -> Compression -> Bool
forall a. Eq a => a -> a -> Bool
== Compression
CompressionRGB
        = Maybe Error
forall a. Maybe a
Nothing
        
        -- uncompressed 32bit RGBA stated as CompressionBitFields.
        | BitmapInfoV3 -> Word16
dib3BitCount    BitmapInfoV3
headerV3 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
32
        , BitmapInfoV3 -> Compression
dib3Compression BitmapInfoV3
headerV3 Compression -> Compression -> Bool
forall a. Eq a => a -> a -> Bool
== Compression
CompressionBitFields
        , BitmapInfoV4 -> Word32
dib4AlphaMask   BitmapInfoV4
headerV4 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0xff000000
        , BitmapInfoV4 -> Word32
dib4RedMask     BitmapInfoV4
headerV4 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x00ff0000
        , BitmapInfoV4 -> Word32
dib4GreenMask   BitmapInfoV4
headerV4 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x0000ff00
        , BitmapInfoV4 -> Word32
dib4BlueMask    BitmapInfoV4
headerV4 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x000000ff
        = Maybe Error
forall a. Maybe a
Nothing

        -- uncompressed 24bit RGB
        | BitmapInfoV3 -> Word16
dib3BitCount    BitmapInfoV3
headerV3 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
24 
        , BitmapInfoV3 -> Compression
dib3Compression BitmapInfoV3
headerV3 Compression -> Compression -> Bool
forall a. Eq a => a -> a -> Bool
== Compression
CompressionRGB
        = Maybe Error
forall a. Maybe a
Nothing
        
        -- Some unsupported compression mode ----
        | Bool
otherwise
        = Error -> Maybe Error
forall a. a -> Maybe a
Just (Error -> Maybe Error) -> Error -> Maybe Error
forall a b. (a -> b) -> a -> b
$ Compression -> Error
ErrorUnhandledCompressionMode (BitmapInfoV3 -> Compression
dib3Compression BitmapInfoV3
headerV3)
        
        where   headerV3 :: BitmapInfoV3
headerV3 = BitmapInfoV4 -> BitmapInfoV3
dib4InfoV3 BitmapInfoV4
headerV4


-- | Compute the size of the image data from the header.
--
--   * We can't just use the 'dib3ImageSize' field because some encoders
--     set this to zero.
--
--   * We also can't use the physical size of  the data in the file because
--     some encoders add zero padding bytes on the end.  
-- 
imageSizeFromBitmapInfoV4 :: BitmapInfoV4 -> Maybe Int
imageSizeFromBitmapInfoV4 :: BitmapInfoV4 -> Maybe Int
imageSizeFromBitmapInfoV4 BitmapInfoV4
headerV4
        | BitmapInfoV3 -> Word16
dib3BitCount    BitmapInfoV3
headerV3 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
32
        , BitmapInfoV3 -> Word16
dib3Planes      BitmapInfoV3
headerV3 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
1
        , BitmapInfoV3 -> Compression
dib3Compression BitmapInfoV3
headerV3 Compression -> Compression -> Bool
forall a. Eq a => a -> a -> Bool
== Compression
CompressionRGB
        = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (BitmapInfoV3 -> Word32
dib3Width BitmapInfoV3
headerV3 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* BitmapInfoV3 -> Word32
dib3Height BitmapInfoV3
headerV3 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
4)

        | BitmapInfoV3 -> Word16
dib3BitCount    BitmapInfoV3
headerV3 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
32
        , BitmapInfoV3 -> Word16
dib3Planes      BitmapInfoV3
headerV3 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
1
        , BitmapInfoV3 -> Compression
dib3Compression BitmapInfoV3
headerV3 Compression -> Compression -> Bool
forall a. Eq a => a -> a -> Bool
== Compression
CompressionBitFields
        , BitmapInfoV4 -> Word32
dib4AlphaMask   BitmapInfoV4
headerV4 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0xff000000
        , BitmapInfoV4 -> Word32
dib4RedMask     BitmapInfoV4
headerV4 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x00ff0000
        , BitmapInfoV4 -> Word32
dib4GreenMask   BitmapInfoV4
headerV4 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x0000ff00
        , BitmapInfoV4 -> Word32
dib4BlueMask    BitmapInfoV4
headerV4 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x000000ff
        = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (BitmapInfoV3 -> Word32
dib3Width BitmapInfoV3
headerV3 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* BitmapInfoV3 -> Word32
dib3Height BitmapInfoV3
headerV3 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
4)        

        | BitmapInfoV3 -> Word16
dib3BitCount    BitmapInfoV3
headerV3 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
24
        , BitmapInfoV3 -> Word16
dib3Planes      BitmapInfoV3
headerV3 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
1
        , BitmapInfoV3 -> Compression
dib3Compression BitmapInfoV3
headerV3 Compression -> Compression -> Bool
forall a. Eq a => a -> a -> Bool
== Compression
CompressionRGB
        = let   imageBytesPerLine :: Word32
imageBytesPerLine = BitmapInfoV3 -> Word32
dib3Width BitmapInfoV3
headerV3 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
3
                tailBytesPerLine :: Word32
tailBytesPerLine  = Word32
imageBytesPerLine Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`mod` Word32
4
                padBytesPerLine :: Word32
padBytesPerLine   = if Word32
tailBytesPerLine Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0
                                        then Word32
4 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
tailBytesPerLine
                                        else Word32
0
          in    Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral 
                     (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ BitmapInfoV3 -> Word32
dib3Height BitmapInfoV3
headerV3 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
imageBytesPerLine Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
padBytesPerLine

        | Bool
otherwise
        = Maybe Int
forall a. Maybe a
Nothing

        where   headerV3 :: BitmapInfoV3
headerV3 = BitmapInfoV4 -> BitmapInfoV3
dib4InfoV3 BitmapInfoV4
headerV4