module Codec.BMP.FileHeader
( FileHeader (..)
, bmpMagic
, sizeOfFileHeader
, checkFileHeader)
where
import Codec.BMP.BitmapInfoV3
import Codec.BMP.Error
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
data FileHeader
= FileHeader
{
fileHeaderType :: Word16
, fileHeaderFileSize :: Word32
, fileHeaderReserved1 :: Word16
, fileHeaderReserved2 :: Word16
, fileHeaderOffset :: Word32
}
deriving (Show)
sizeOfFileHeader :: Int
sizeOfFileHeader = 14
bmpMagic :: Word16
bmpMagic = 0x4d42
instance Binary FileHeader where
get
= do t <- getWord16le
size <- getWord32le
res1 <- getWord16le
res2 <- getWord16le
offset <- getWord32le
return $ FileHeader
{ fileHeaderType = t
, fileHeaderFileSize = size
, fileHeaderReserved1 = res1
, fileHeaderReserved2 = res2
, fileHeaderOffset = offset }
put header
= do putWord16le $ fileHeaderType header
putWord32le $ fileHeaderFileSize header
putWord16le $ fileHeaderReserved1 header
putWord16le $ fileHeaderReserved2 header
putWord32le $ fileHeaderOffset header
checkFileHeader :: FileHeader -> Maybe Error
checkFileHeader header
| fileHeaderType header /= bmpMagic
= Just $ ErrorBadMagic (fileHeaderType header)
| fileHeaderFileSize header
< fromIntegral sizeOfFileHeader
= Just $ ErrorFileHeaderTruncated
| fileHeaderFileSize header
< fromIntegral (sizeOfFileHeader + sizeOfBitmapInfoV3)
= Just $ ErrorImageHeaderTruncated
| fileHeaderReserved1 header /= 0
= Just $ ErrorReservedFieldNotZero
| fileHeaderReserved2 header /= 0
= Just $ ErrorReservedFieldNotZero
| fromIntegral (fileHeaderOffset header)
/= sizeOfFileHeader + sizeOfBitmapInfoV3
= Just $ ErrorDodgyFileHeaderFieldOffset
$ fromIntegral $ fileHeaderOffset header
| otherwise
= Nothing