module Codec.BMP.BitmapInfoV3
( BitmapInfoV3 (..)
, Compression (..)
, sizeOfBitmapInfoV3
, checkBitmapInfoV3)
where
import Codec.BMP.Error
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
data BitmapInfoV3
= BitmapInfoV3
{
dib3Size :: Word32
, dib3Width :: Word32
, dib3Height :: Word32
, dib3Planes :: Word16
, dib3BitCount :: Word16
, dib3Compression :: Compression
, dib3ImageSize :: Word32
, dib3PelsPerMeterX :: Word32
, dib3PelsPerMeterY :: Word32
, dib3ColorsUsed :: Word32
, dib3ColorsImportant :: Word32
}
deriving (Show)
data Compression
= CompressionRGB
| CompressionRLE8
| CompressionRLE4
| CompressionBitFields
| CompressionJPEG
| CompressionPNG
| CompressionUnknown Word32
deriving (Show, Eq)
sizeOfBitmapInfoV3 :: Int
sizeOfBitmapInfoV3 = 40
instance Binary BitmapInfoV3 where
get
= do size <- getWord32le
width <- getWord32le
height <- getWord32le
planes <- getWord16le
bitc <- getWord16le
comp <- get
imgsize <- getWord32le
pelsX <- getWord32le
pelsY <- getWord32le
cused <- getWord32le
cimp <- getWord32le
return $ BitmapInfoV3
{ dib3Size = size
, dib3Width = width
, dib3Height = height
, dib3Planes = planes
, dib3BitCount = bitc
, dib3Compression = comp
, dib3ImageSize = imgsize
, dib3PelsPerMeterX = pelsX
, dib3PelsPerMeterY = pelsY
, dib3ColorsUsed = cused
, dib3ColorsImportant = cimp }
put header
= do putWord32le $ dib3Size header
putWord32le $ dib3Width header
putWord32le $ dib3Height header
putWord16le $ dib3Planes header
putWord16le $ dib3BitCount header
put $ dib3Compression header
putWord32le $ dib3ImageSize header
putWord32le $ dib3PelsPerMeterX header
putWord32le $ dib3PelsPerMeterY header
putWord32le $ dib3ColorsUsed header
putWord32le $ dib3ColorsImportant header
instance Binary Compression where
get
= do c <- getWord32le
case c of
0 -> return $ CompressionRGB
1 -> return $ CompressionRLE8
2 -> return $ CompressionRLE4
3 -> return $ CompressionBitFields
4 -> return $ CompressionJPEG
5 -> return $ CompressionPNG
_ -> return $ CompressionUnknown c
put c
= case c of
CompressionRGB -> putWord32le 0
CompressionRLE8 -> putWord32le 1
CompressionRLE4 -> putWord32le 2
CompressionBitFields -> putWord32le 3
CompressionJPEG -> putWord32le 4
CompressionPNG -> putWord32le 5
CompressionUnknown x -> putWord32le x
checkBitmapInfoV3 :: BitmapInfoV3 -> Word32 -> Maybe Error
checkBitmapInfoV3 header expectedImageSize
| dib3Planes header /= 1
= Just $ ErrorUnhandledPlanesCount
$ fromIntegral $ dib3Planes header
| dib3ImageSize header /= 0
, dib3ImageSize header /= expectedImageSize
= Just $ ErrorUnexpectedImageSize
| expectedImageSize `mod` dib3Height header /= 0
= Just $ ErrorLacksWholeNumberOfLines
| dib3BitCount header /= 24
= Just $ ErrorUnhandledColorDepth
$ fromIntegral $ dib3BitCount header
| dib3Compression header /= CompressionRGB
= Just $ ErrorUnhandledCompressionMode
| otherwise
= Nothing