module Codec.BMP
( BMP (..)
, FileHeader (..)
, BitmapInfo (..)
, BitmapInfoV3 (..)
, Error (..)
, readBMP
, writeBMP
, hGetBMP
, hPutBMP
, packRGBA32ToBMP
, unpackBMPToRGBA32
, bmpDimensions)
where
import Codec.BMP.Base
import Codec.BMP.Error
import Codec.BMP.Unpack
import Codec.BMP.Pack
import Codec.BMP.FileHeader
import Codec.BMP.BitmapInfo
import Data.Binary
import Data.Maybe
import System.IO
import Data.ByteString as BS
import Data.ByteString.Lazy as BSL
readBMP :: FilePath -> IO (Either Error BMP)
readBMP fileName
= do h <- openBinaryFile fileName ReadMode
hGetBMP h
hGetBMP :: Handle -> IO (Either Error BMP)
hGetBMP h
= do
buf <- BSL.hGet h sizeOfFileHeader
if (fromIntegral $ BSL.length buf) /= sizeOfFileHeader
then return $ Left ErrorReadOfFileHeaderFailed
else hGetBMP2 h (decode buf)
hGetBMP2 h fileHeader
| fileHeaderType fileHeader /= bmpMagic
= return $ Left $ ErrorBadMagic (fileHeaderType fileHeader)
| otherwise
= do
buf <- BSL.hGet h sizeOfBitmapInfoV3
if (fromIntegral $ BSL.length buf) /= sizeOfBitmapInfoV3
then return $ Left ErrorReadOfImageHeaderFailed
else hGetBMP3 h fileHeader (decode buf)
hGetBMP3 h fileHeader imageHeader
| (err : _) <- catMaybes
[ checkFileHeader fileHeader
, checkBitmapInfoV3 imageHeader]
= return $ Left err
| otherwise
= do
let len = fromIntegral $ dib3ImageSize imageHeader
imageData <- BS.hGet h len
if (fromIntegral $ BS.length imageData) /= len
then return $ Left ErrorReadOfImageDataFailed
else return
$ Right $ BMP
{ bmpFileHeader = fileHeader
, bmpBitmapInfo = InfoV3 imageHeader
, bmpRawImageData = imageData }
writeBMP :: FilePath -> BMP -> IO ()
writeBMP fileName bmp
= do h <- openBinaryFile fileName WriteMode
hPutBMP h bmp
hFlush h
hPutBMP :: Handle -> BMP -> IO ()
hPutBMP h bmp
= do BSL.hPut h (encode $ bmpFileHeader bmp)
BSL.hPut h (encode $ bmpBitmapInfo bmp)
BS.hPut h $ bmpRawImageData bmp
bmpDimensions :: BMP -> (Int, Int)
bmpDimensions bmp
= case bmpBitmapInfo bmp of
InfoV3 info
-> ( fromIntegral $ dib3Width info
, fromIntegral $ dib3Height info)