{-# OPTIONS_HADDOCK hide #-}
module Codec.BMP.BitmapInfoV3
        ( BitmapInfoV3  (..)
        , Compression (..)
        , sizeOfBitmapInfoV3
        , checkBitmapInfoV3
        , imageSizeFromBitmapInfoV3)
where
import Codec.BMP.Error
import Codec.BMP.Compression
import Data.Binary
import Data.Binary.Get  
import Data.Binary.Put
import Data.Int
import Debug.Trace


-- | Device Independent Bitmap (DIB) header for Windows V3.
data BitmapInfoV3
        = BitmapInfoV3                  
        { -- | (+0) Size of the image header, in bytes.
          BitmapInfoV3 -> Word32
dib3Size              :: Word32

          -- | (+4) Width of the image, in pixels.
        , BitmapInfoV3 -> Word32
dib3Width             :: Word32
        
          -- | (+8) Height of the image, in pixels.
        , BitmapInfoV3 -> Word32
dib3Height            :: Word32
        
          -- | If the height field in the file is negative then this is interpreted
          --   as an image with the rows flipped.
        , BitmapInfoV3 -> Bool
dib3HeightFlipped     :: Bool

          -- | (+12) Number of color planes.
        , BitmapInfoV3 -> Word16
dib3Planes            :: Word16

          -- | (+14) Number of bits per pixel.
        , BitmapInfoV3 -> Word16
dib3BitCount          :: Word16

          -- | (+16) Image compression mode.
        , BitmapInfoV3 -> Compression
dib3Compression       :: Compression

          -- | (+20) Size of raw image data.
          --   Some encoders set this to zero, so we need to calculate it based
          --   on the overall file size.
          -- 
          --   If it is non-zero then we check it matches the file size - header
          --   size.
        , BitmapInfoV3 -> Word32
dib3ImageSize         :: Word32

          -- | (+24) Prefered resolution in pixels per meter, along the X axis.
        , BitmapInfoV3 -> Word32
dib3PelsPerMeterX     :: Word32

          -- | (+28) Prefered resolution in pixels per meter, along the Y axis.
        , BitmapInfoV3 -> Word32
dib3PelsPerMeterY     :: Word32

          -- | (+32) Number of color entries that are used.
        , BitmapInfoV3 -> Word32
dib3ColorsUsed        :: Word32

          -- | (+36) Number of significant colors.
        , BitmapInfoV3 -> Word32
dib3ColorsImportant   :: Word32
        }
        deriving (Int -> BitmapInfoV3 -> ShowS
[BitmapInfoV3] -> ShowS
BitmapInfoV3 -> String
(Int -> BitmapInfoV3 -> ShowS)
-> (BitmapInfoV3 -> String)
-> ([BitmapInfoV3] -> ShowS)
-> Show BitmapInfoV3
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BitmapInfoV3 -> ShowS
showsPrec :: Int -> BitmapInfoV3 -> ShowS
$cshow :: BitmapInfoV3 -> String
show :: BitmapInfoV3 -> String
$cshowList :: [BitmapInfoV3] -> ShowS
showList :: [BitmapInfoV3] -> ShowS
Show)


-- | Size of `BitmapInfoV3` header (in bytes)
sizeOfBitmapInfoV3 :: Int
sizeOfBitmapInfoV3 :: Int
sizeOfBitmapInfoV3 = Int
40


instance Binary BitmapInfoV3 where
 get :: Get BitmapInfoV3
get
  = do  Word32
size      <- Get Word32
getWord32le
        Word32
width     <- Get Word32
getWord32le

        -- We're supposed to treat the height field as a signed integer.
        -- If it's negative it means the image is flipped along the X axis.
        -- (which is crazy, but we just have to eat it)
        Word32
heightW32 <- Get Word32
getWord32le
        let heightI32 :: Int32
heightI32 = (Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
heightW32 :: Int32)
        let (Word32
height, Bool
flipped)
                = if Int32
heightI32 Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< Int32
0
                        then (Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int32
forall a. Num a => a -> a
abs Int32
heightI32), Bool
True)
                        else (Word32
heightW32,                    Bool
False)

        Word16
planes  <- Get Word16
getWord16le
        Word16
bitc    <- Get Word16
getWord16le
        Compression
comp    <- Get Compression
forall t. Binary t => Get t
get
        Word32
imgsize <- Get Word32
getWord32le
        Word32
pelsX   <- Get Word32
getWord32le
        Word32
pelsY   <- Get Word32
getWord32le
        Word32
cused   <- Get Word32
getWord32le
        Word32
cimp    <- Get Word32
getWord32le
        
        BitmapInfoV3 -> Get BitmapInfoV3
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return  (BitmapInfoV3 -> Get BitmapInfoV3)
-> BitmapInfoV3 -> Get BitmapInfoV3
forall a b. (a -> b) -> a -> b
$ BitmapInfoV3
                { dib3Size :: Word32
dib3Size              = Word32
size
                , dib3Width :: Word32
dib3Width             = Word32
width
                , dib3Height :: Word32
dib3Height            = Word32
height
                , dib3HeightFlipped :: Bool
dib3HeightFlipped     = Bool
flipped
                , dib3Planes :: Word16
dib3Planes            = Word16
planes
                , dib3BitCount :: Word16
dib3BitCount          = Word16
bitc
                , dib3Compression :: Compression
dib3Compression       = Compression
comp
                , dib3ImageSize :: Word32
dib3ImageSize         = Word32
imgsize
                , dib3PelsPerMeterX :: Word32
dib3PelsPerMeterX     = Word32
pelsX
                , dib3PelsPerMeterY :: Word32
dib3PelsPerMeterY     = Word32
pelsY
                , dib3ColorsUsed :: Word32
dib3ColorsUsed        = Word32
cused
                , dib3ColorsImportant :: Word32
dib3ColorsImportant   = Word32
cimp }

 put :: BitmapInfoV3 -> Put
put BitmapInfoV3
header
  = do  Word32 -> Put
putWord32le     (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV3 -> Word32
dib3Size BitmapInfoV3
header
        Word32 -> Put
putWord32le     (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV3 -> Word32
dib3Width BitmapInfoV3
header
        Word32 -> Put
putWord32le     (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV3 -> Word32
dib3Height BitmapInfoV3
header
        Word16 -> Put
putWord16le     (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV3 -> Word16
dib3Planes BitmapInfoV3
header
        Word16 -> Put
putWord16le     (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV3 -> Word16
dib3BitCount BitmapInfoV3
header
        Compression -> Put
forall t. Binary t => t -> Put
put             (Compression -> Put) -> Compression -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV3 -> Compression
dib3Compression BitmapInfoV3
header
        Word32 -> Put
putWord32le     (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV3 -> Word32
dib3ImageSize BitmapInfoV3
header
        Word32 -> Put
putWord32le     (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV3 -> Word32
dib3PelsPerMeterX BitmapInfoV3
header
        Word32 -> Put
putWord32le     (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV3 -> Word32
dib3PelsPerMeterY BitmapInfoV3
header
        Word32 -> Put
putWord32le     (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV3 -> Word32
dib3ColorsUsed BitmapInfoV3
header
        Word32 -> Put
putWord32le     (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ BitmapInfoV3 -> Word32
dib3ColorsImportant BitmapInfoV3
header
        
                
-- | Check headers for problems and unsupported features.        
checkBitmapInfoV3 :: BitmapInfoV3 -> Word32 -> Maybe Error
checkBitmapInfoV3 :: BitmapInfoV3 -> Word32 -> Maybe Error
checkBitmapInfoV3 BitmapInfoV3
header Word32
physicalBufferSize

        -- We only handle a single color plane.
        | BitmapInfoV3 -> Word16
dib3Planes BitmapInfoV3
header 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
header
        
        -- We only handle 24 and 32 bit images.
        | BitmapInfoV3 -> Word16
dib3BitCount BitmapInfoV3
header Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
24
        , BitmapInfoV3 -> Word16
dib3BitCount BitmapInfoV3
header 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
header

        -- 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
header
        , 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.
        --  The buffer may be larger than the size of the image stated
        --  in the header, because some encoders add padding to the end.
        | Just Int
calculatedImageSize      <- BitmapInfoV3 -> Maybe Int
imageSizeFromBitmapInfoV3 BitmapInfoV3
header
        , 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
        = String -> Maybe Error -> Maybe Error
forall a. String -> a -> a
trace (BitmapInfoV3 -> String
forall a. Show a => a -> String
show BitmapInfoV3
header)
        (Maybe Error -> Maybe Error) -> Maybe Error -> Maybe Error
forall a b. (a -> b) -> a -> b
$ 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)

        -- We only handle uncompresssed images.
        |   BitmapInfoV3 -> Compression
dib3Compression BitmapInfoV3
header Compression -> Compression -> Bool
forall a. Eq a => a -> a -> Bool
/= Compression
CompressionRGB
         Bool -> Bool -> Bool
&& BitmapInfoV3 -> Compression
dib3Compression BitmapInfoV3
header Compression -> Compression -> Bool
forall a. Eq a => a -> a -> Bool
/= Compression
CompressionBitFields
        = 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
header)

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

-- | 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.   
--
imageSizeFromBitmapInfoV3 :: BitmapInfoV3 -> Maybe Int
imageSizeFromBitmapInfoV3 :: BitmapInfoV3 -> Maybe Int
imageSizeFromBitmapInfoV3 BitmapInfoV3
header
        | BitmapInfoV3 -> Word16
dib3BitCount    BitmapInfoV3
header Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
32
        , BitmapInfoV3 -> Word16
dib3Planes      BitmapInfoV3
header Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
1
        ,   BitmapInfoV3 -> Compression
dib3Compression BitmapInfoV3
header Compression -> Compression -> Bool
forall a. Eq a => a -> a -> Bool
== Compression
CompressionRGB
         Bool -> Bool -> Bool
|| BitmapInfoV3 -> Compression
dib3Compression BitmapInfoV3
header Compression -> Compression -> Bool
forall a. Eq a => a -> a -> Bool
== Compression
CompressionBitFields
        = 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
header Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* BitmapInfoV3 -> Word32
dib3Height BitmapInfoV3
header Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
4)

        | BitmapInfoV3 -> Word16
dib3BitCount    BitmapInfoV3
header Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
24
        , BitmapInfoV3 -> Word16
dib3Planes      BitmapInfoV3
header Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
1
        ,   BitmapInfoV3 -> Compression
dib3Compression BitmapInfoV3
header Compression -> Compression -> Bool
forall a. Eq a => a -> a -> Bool
== Compression
CompressionRGB
         Bool -> Bool -> Bool
|| BitmapInfoV3 -> Compression
dib3Compression BitmapInfoV3
header Compression -> Compression -> Bool
forall a. Eq a => a -> a -> Bool
== Compression
CompressionBitFields
        = let   imageBytesPerLine :: Word32
imageBytesPerLine = BitmapInfoV3 -> Word32
dib3Width BitmapInfoV3
header 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
header 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
        = String -> Maybe Int -> Maybe Int
forall a. String -> a -> a
trace (BitmapInfoV3 -> String
forall a. Show a => a -> String
show BitmapInfoV3
header) (Maybe Int -> Maybe Int) -> Maybe Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Maybe Int
forall a. Maybe a
Nothing