module Codec.BMP
( BMP (..)
, FileHeader (..)
, BitmapInfo (..)
, BitmapInfoV3 (..)
, BitmapInfoV4 (..)
, BitmapInfoV5 (..)
, Compression (..)
, CIEXYZ (..)
, 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 Codec.BMP.BitmapInfoV3
import Codec.BMP.BitmapInfoV4
import Codec.BMP.BitmapInfoV5
import System.IO
import Data.ByteString as BS
import Data.ByteString.Lazy as BSL
import Data.Binary
import Data.Binary.Get
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
bufSize <- BSL.hGet h 4
let sizeHeader = runGet getWord32le bufSize
let sizeRest = fromIntegral sizeHeader 4
bufRest <- BSL.hGet h sizeRest
if (fromIntegral $ BSL.length bufRest) /= sizeRest
then return $ Left ErrorReadOfImageHeaderFailed
else do
let bufHeader = BSL.append bufSize bufRest
hGetBMP3 h fileHeader sizeHeader bufHeader
hGetBMP3 h fileHeader sizeHeader bufHeader
| sizeHeader == 40
= do let info = decode bufHeader
case checkBitmapInfoV3 info of
Just err -> return $ Left err
Nothing -> hGetBMP4 h fileHeader (InfoV3 info)
(fromIntegral $ dib3ImageSize info)
| sizeHeader == 108
= do let info = decode bufHeader
case checkBitmapInfoV4 info of
Just err -> return $ Left err
Nothing -> hGetBMP4 h fileHeader (InfoV4 info)
(fromIntegral
$ dib3ImageSize
$ dib4InfoV3 info)
| sizeHeader == 124
= do let info = decode bufHeader
case checkBitmapInfoV5 info of
Just err -> return $ Left err
Nothing -> hGetBMP4 h fileHeader (InfoV5 info)
(fromIntegral
$ dib3ImageSize
$ dib4InfoV3
$ dib5InfoV4 info)
| otherwise
= return $ Left $ ErrorUnhandledBitmapHeaderSize (fromIntegral sizeHeader)
hGetBMP4 h fileHeader imageHeader sizeImage
= do
imageData <- BS.hGet h sizeImage
if (fromIntegral $ BS.length imageData) /= sizeImage
then return $ Left ErrorReadOfImageDataFailed
else return
$ Right $ BMP
{ bmpFileHeader = fileHeader
, bmpBitmapInfo = 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
= let info = getBitmapInfoV3 $ bmpBitmapInfo bmp
in ( fromIntegral $ dib3Width info
, fromIntegral $ dib3Height info)