{-# LANGUAGE ScopedTypeVariables, PatternGuards #-}-- | Reading and writing uncompressed BMP files.---- Reading works for both uncompressed 24bit RGB and 32bit RGBA-- WindowsV3, WindowsV4 and WindowsV5 formats.-- -- Writing is limited to the uncompressed 24bit RGB WindowsV3 format.---- We don't support the plain OS/2 BitmapCoreHeader-- and BitmapCoreHeader2 image headers, but I haven't yet seen one of these in the wild.-- -- To write a file do something like:---- > do let rgba = Data.ByteString.pack [some list of Word8s]-- > let bmp = packRGBA32ToBMP width height rgba-- > writeBMP fileName bmp---- To read a file do something like:---- > do Right bmp <- readBMP fileName-- > let rgba = unpackBMPToRGBA32 bmp-- > let (width, height) = bmpDimensions bmp-- > ... -- -- Release Notes:---- > * bmp 1.2.0-- > Accept files with zero padding on the end of the file.-- > Accept RGBA files with V3 headers.---- > * bmp 1.1.2 -- > Accept files with the image size field set to zero.--moduleCodec.BMP(BMP(..),FileHeader(..),BitmapInfo(..),BitmapInfoV3(..),BitmapInfoV4(..),BitmapInfoV5(..),Compression(..),CIEXYZ(..),Error(..),readBMP,writeBMP,hGetBMP,hPutBMP,packRGBA32ToBMP,unpackBMPToRGBA32,bmpDimensions)whereimportCodec.BMP.BaseimportCodec.BMP.ErrorimportCodec.BMP.UnpackimportCodec.BMP.PackimportCodec.BMP.FileHeaderimportCodec.BMP.BitmapInfoimportCodec.BMP.BitmapInfoV3importCodec.BMP.BitmapInfoV4importCodec.BMP.BitmapInfoV5importSystem.IOimportData.ByteStringasBSimportData.ByteString.LazyasBSLimportData.BinaryimportData.Binary.Get-- Reading ------------------------------------------------------------------------------------------ | Wrapper for `hGetBMP`readBMP::FilePath->IO(EitherErrorBMP)readBMPfileName=doh<-openBinaryFilefileNameReadModehGetBMPh-- | Get a BMP image from a file handle.-- The file is checked for problems and unsupported features when read.-- If there is anything wrong this gives an `Error` instead.hGetBMP::Handle->IO(EitherErrorBMP)hGetBMPh=do-- lazily load the whole filebuf<-BSL.hGetContentsh-- split off the file headerlet(bufFileHeader,bufRest)=BSL.splitAt(fromIntegralsizeOfFileHeader)bufif(fromIntegral$BSL.lengthbufFileHeader)/=sizeOfFileHeaderthenreturn$LeftErrorFileHeaderTruncatedelsehGetBMP2bufRest(decodebufFileHeader)hGetBMP2buffileHeader-- Check the magic before doing anything else.|fileHeaderTypefileHeader/=bmpMagic=return$Left$ErrorBadMagic(fileHeaderTypefileHeader)|otherwise=do-- Next comes the image header. -- The first word tells us how long it is.letsizeHeader=runGetgetWord32lebuf-- split off the image headerlet(bufImageHeader,bufRest)=BSL.splitAt(fromIntegralsizeHeader)buf-- How much non-header data is present in the file.-- For uncompressed data without a colour table, the remaining data should-- be the image, but there may also be padding bytes on the end.letphysicalBufferSize=(fromIntegral$BSL.lengthbufRest)::Word32if(fromIntegral$BSL.lengthbufImageHeader)/=sizeHeaderthenreturn$LeftErrorImageHeaderTruncatedelsehGetBMP3fileHeaderbufImageHeaderbufRestphysicalBufferSizehGetBMP3fileHeaderbufImageHeaderbufRestphysicalBufferSize|BSL.lengthbufImageHeader==40=doletinfo=decodebufImageHeadercasecheckBitmapInfoV3infophysicalBufferSizeofJusterr->return$LefterrNothing|JustimageSize<-imageSizeFromBitmapInfoV3info->hGetBMP4fileHeader(InfoV3info)bufRestimageSize|otherwise->return$Left$ErrorInternalErrorPleaseReport|BSL.lengthbufImageHeader==108=doletinfo=decodebufImageHeadercasecheckBitmapInfoV4infophysicalBufferSizeofJusterr->return$LefterrNothing|JustimageSize<-imageSizeFromBitmapInfoV4info->hGetBMP4fileHeader(InfoV4info)bufRestimageSize|otherwise->return$Left$ErrorInternalErrorPleaseReport|BSL.lengthbufImageHeader==124=doletinfo=decodebufImageHeadercasecheckBitmapInfoV5infophysicalBufferSizeofJusterr->return$LefterrNothing|JustimageSize<-imageSizeFromBitmapInfoV5info->hGetBMP4fileHeader(InfoV5info)bufRestimageSize|otherwise->return$Left$ErrorInternalErrorPleaseReport|otherwise=return$Left$ErrorUnhandledBitmapHeaderSize$fromIntegral$BSL.lengthbufImageHeaderhGetBMP4fileHeaderimageHeaderbufImage(sizeImage::Int)=letbufLen=fromIntegral$BSL.lengthbufImageinifbufLen<sizeImagethenreturn$Left$ErrorImageDataTruncatedsizeImagebufLenelsereturn$Right$BMP{bmpFileHeader=fileHeader,bmpBitmapInfo=imageHeader,bmpRawImageData=BS.pack$BSL.unpackbufImage}-- Writing ------------------------------------------------------------------------------------------ | Wrapper for `hPutBMP`writeBMP::FilePath->BMP->IO()writeBMPfileNamebmp=doh<-openBinaryFilefileNameWriteModehPutBMPhbmphFlushhhCloseh-- | Put a BMP image to a file handle.hPutBMP::Handle->BMP->IO()hPutBMPhbmp=doBSL.hPuth(encode$bmpFileHeaderbmp)BSL.hPuth(encode$bmpBitmapInfobmp)BS.hPuth$bmpRawImageDatabmp-- | Get the width and height of an image.-- It's better to use this function than to access the headers directly.bmpDimensions::BMP->(Int,Int)bmpDimensionsbmp=letinfo=getBitmapInfoV3$bmpBitmapInfobmpin(fromIntegral$dib3Widthinfo,fromIntegral$dib3Heightinfo)