    {-# 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  infoV3  <- Get BitmapInfoV3
    forall t. Binary t => Get t
    get
            rmask   <- getWord32le
            gmask   <- getWord32le
            bmask   <- getWord32le
            amask   <- getWord32le
            cstype  <- getWord32le
            ends    <- get
            rgamma  <- getWord32le
            ggamma  <- getWord32le
            bgamma  <- getWord32le

            return  $ BitmapInfoV4
                    { dib4InfoV3            = infoV3
                    , dib4RedMask           = rmask
                    , dib4GreenMask         = gmask
                    , dib4BlueMask          = bmask
                    , dib4AlphaMask         = amask
                    , dib4ColorSpaceType    = cstype
                    , dib4Endpoints         = ends
                    , dib4GammaRed          = rgamma
                    , dib4GammaGreen        = ggamma
                    , dib4GammaBlue         = 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