{-# OPTIONS_HADDOCK hide #-}
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


-- | BMP file header.
data FileHeader
        = FileHeader                    
        { -- | (+0) Magic numbers 0x42 0x4d
          FileHeader -> Word16
fileHeaderType        :: Word16
        
          -- | (+2) Size of the file, in bytes.
        , FileHeader -> Word32
fileHeaderFileSize    :: Word32

          -- | (+6) Reserved, must be zero.
        , FileHeader -> Word16
fileHeaderReserved1   :: Word16

          -- | (+8) Reserved, must be zero.
        , FileHeader -> Word16
fileHeaderReserved2   :: Word16

          -- | (+10) Offset in bytes to the start of the pixel data.
        , FileHeader -> Word32
fileHeaderOffset      :: Word32
        }
        deriving (Int -> FileHeader -> ShowS
[FileHeader] -> ShowS
FileHeader -> String
(Int -> FileHeader -> ShowS)
-> (FileHeader -> String)
-> ([FileHeader] -> ShowS)
-> Show FileHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileHeader -> ShowS
showsPrec :: Int -> FileHeader -> ShowS
$cshow :: FileHeader -> String
show :: FileHeader -> String
$cshowList :: [FileHeader] -> ShowS
showList :: [FileHeader] -> ShowS
Show)


-- | Size of a file header (in bytes).
sizeOfFileHeader :: Int
sizeOfFileHeader :: Int
sizeOfFileHeader = Int
14


-- | Magic number that should come at the start of a BMP file.
bmpMagic :: Word16
bmpMagic :: Word16
bmpMagic = Word16
0x4d42


instance Binary FileHeader where
 get :: Get FileHeader
get 
  = do  Word16
t       <- Get Word16
getWord16le
        Word32
size    <- Get Word32
getWord32le
        Word16
res1    <- Get Word16
getWord16le
        Word16
res2    <- Get Word16
getWord16le
        Word32
offset  <- Get Word32
getWord32le
        
        FileHeader -> Get FileHeader
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return  (FileHeader -> Get FileHeader) -> FileHeader -> Get FileHeader
forall a b. (a -> b) -> a -> b
$ FileHeader
                { fileHeaderType :: Word16
fileHeaderType        = Word16
t
                , fileHeaderFileSize :: Word32
fileHeaderFileSize    = Word32
size
                , fileHeaderReserved1 :: Word16
fileHeaderReserved1   = Word16
res1
                , fileHeaderReserved2 :: Word16
fileHeaderReserved2   = Word16
res2
                , fileHeaderOffset :: Word32
fileHeaderOffset      = Word32
offset }

 put :: FileHeader -> Put
put FileHeader
header
  = do  Word16 -> Put
putWord16le     (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ FileHeader -> Word16
fileHeaderType FileHeader
header
        Word32 -> Put
putWord32le     (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ FileHeader -> Word32
fileHeaderFileSize FileHeader
header
        Word16 -> Put
putWord16le     (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ FileHeader -> Word16
fileHeaderReserved1 FileHeader
header
        Word16 -> Put
putWord16le     (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ FileHeader -> Word16
fileHeaderReserved2 FileHeader
header
        Word32 -> Put
putWord32le     (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ FileHeader -> Word32
fileHeaderOffset FileHeader
header
        

-- | Check a file header for problems and unsupported features.
checkFileHeader :: FileHeader -> Maybe Error    
checkFileHeader :: FileHeader -> Maybe Error
checkFileHeader FileHeader
header
        | FileHeader -> Word16
fileHeaderType FileHeader
header Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
bmpMagic
        = Error -> Maybe Error
forall a. a -> Maybe a
Just  (Error -> Maybe Error) -> Error -> Maybe Error
forall a b. (a -> b) -> a -> b
$ Word16 -> Error
ErrorBadMagic (FileHeader -> Word16
fileHeaderType FileHeader
header)

        | FileHeader -> Word32
fileHeaderFileSize FileHeader
header 
                Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sizeOfFileHeader
        = Error -> Maybe Error
forall a. a -> Maybe a
Just  (Error -> Maybe Error) -> Error -> Maybe Error
forall a b. (a -> b) -> a -> b
$ Error
ErrorFileHeaderTruncated

        | FileHeader -> Word32
fileHeaderFileSize FileHeader
header 
                Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
sizeOfFileHeader Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sizeOfBitmapInfoV3)
        = Error -> Maybe Error
forall a. a -> Maybe a
Just  (Error -> Maybe Error) -> Error -> Maybe Error
forall a b. (a -> b) -> a -> b
$ Error
ErrorImageHeaderTruncated

        | FileHeader -> Word16
fileHeaderReserved1 FileHeader
header Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
0
        = Error -> Maybe Error
forall a. a -> Maybe a
Just  (Error -> Maybe Error) -> Error -> Maybe Error
forall a b. (a -> b) -> a -> b
$ Error
ErrorReservedFieldNotZero

        | FileHeader -> Word16
fileHeaderReserved2 FileHeader
header Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
0
        = Error -> Maybe Error
forall a. a -> Maybe a
Just  (Error -> Maybe Error) -> Error -> Maybe Error
forall a b. (a -> b) -> a -> b
$ Error
ErrorReservedFieldNotZero

        | Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FileHeader -> Word32
fileHeaderOffset FileHeader
header) 
                Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
sizeOfFileHeader Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sizeOfBitmapInfoV3
        = Error -> Maybe Error
forall a. a -> Maybe a
Just  (Error -> Maybe Error) -> Error -> Maybe Error
forall a b. (a -> b) -> a -> b
$ Word32 -> Error
ErrorDodgyFileHeaderFieldOffset
                (Word32 -> Error) -> Word32 -> Error
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word32) -> Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ FileHeader -> Word32
fileHeaderOffset FileHeader
header

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