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.hGetContents h
let (bufFileHeader, bufRest)
= BSL.splitAt (fromIntegral sizeOfFileHeader) buf
if (fromIntegral $ BSL.length bufFileHeader) /= sizeOfFileHeader
then return $ Left ErrorReadOfFileHeaderFailed
else hGetBMP2 bufRest (decode bufFileHeader)
hGetBMP2 buf fileHeader
| fileHeaderType fileHeader /= bmpMagic
= return $ Left $ ErrorBadMagic (fileHeaderType fileHeader)
| otherwise
= do
let sizeHeader = runGet getWord32le buf
let (bufImageHeader, bufRest)
= BSL.splitAt (fromIntegral sizeHeader) buf
if (fromIntegral $ BSL.length bufImageHeader) /= sizeHeader
then return $ Left ErrorReadOfImageHeaderFailed
else hGetBMP3 fileHeader bufImageHeader bufRest
hGetBMP3 fileHeader bufImageHeader bufRest
| BSL.length bufImageHeader == 40
= do let info = decode bufImageHeader
case checkBitmapInfoV3 info of
Just err -> return $ Left err
Nothing -> hGetBMP4 fileHeader (InfoV3 info) bufRest
(fromIntegral $ dib3ImageSize info)
| BSL.length bufImageHeader == 108
= do let info = decode bufImageHeader
case checkBitmapInfoV4 info of
Just err -> return $ Left err
Nothing -> hGetBMP4 fileHeader (InfoV4 info) bufRest
(fromIntegral
$ dib3ImageSize
$ dib4InfoV3 info)
| BSL.length bufImageHeader == 124
= do let info = decode bufImageHeader
case checkBitmapInfoV5 info of
Just err -> return $ Left err
Nothing -> hGetBMP4 fileHeader (InfoV5 info) bufRest
(fromIntegral
$ dib3ImageSize
$ dib4InfoV3
$ dib5InfoV4 info)
| otherwise
= return
$ Left
$ ErrorUnhandledBitmapHeaderSize (fromIntegral $ BSL.length bufImageHeader)
hGetBMP4 fileHeader imageHeader bufImage (sizeImage :: Int)
= if (fromIntegral $ BSL.length bufImage) /= sizeImage
then return $ Left ErrorReadOfImageDataFailed
else return
$ Right $ BMP
{ bmpFileHeader = fileHeader
, bmpBitmapInfo = imageHeader
, bmpRawImageData = BS.pack $ BSL.unpack bufImage }
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)