bmp 1.0.0.1 → 1.1.0.0

raw patch · 11 files changed

+565/−171 lines, 11 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Codec/BMP.hs +77/−32
• Codec/BMP/BitmapInfo.hs +36/−125
• Codec/BMP/BitmapInfoV3.hs +157/−0
• Codec/BMP/BitmapInfoV4.hs +130/−0
• Codec/BMP/BitmapInfoV5.hs +68/−0
• Codec/BMP/CIEXYZ.hs +27/−0
• Codec/BMP/Error.hs +1/−1
• Codec/BMP/FileHeader.hs +1/−1
• Codec/BMP/Pack.hs +3/−2
• Codec/BMP/Unpack.hs +58/−7
• bmp.cabal +7/−3

@@ -1,8 +1,14 @@ {-# LANGUAGE ScopedTypeVariables, PatternGuards #-} --- | Reading and writing uncompressed 24 bit BMP files.---	We only handle Windows V3 file headers, but this is the most common.+-- | Reading and writing uncompressed BMP files. --+--   Reading works for both uncompressed 24bit RGB WindowsV3 and 32bit RGBA WindowsV4 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]@@ -15,13 +21,19 @@ --  >    let rgba   =  unpackBMPToRGBA32 bmp --  >    let (width, height) = bmpDimensions bmp --  >    ... ---  +--      +--+-- module Codec.BMP-	( BMP		(..)-	, FileHeader	(..)-	, BitmapInfo    (..)-	, BitmapInfoV3	(..)-	, Error         (..)+	( BMP		  (..)+	, FileHeader  	  (..)+	, BitmapInfo      (..)+	, BitmapInfoV3	  (..)+	, BitmapInfoV4    (..)+	, BitmapInfoV5    (..)+	, Compression     (..)+	, CIEXYZ          (..)+	, Error           (..) 	, readBMP 	, writeBMP 	, hGetBMP@@ -36,11 +48,14 @@ import Codec.BMP.Pack import Codec.BMP.FileHeader import Codec.BMP.BitmapInfo-import Data.Binary-import Data.Maybe+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  -- Reading ---------------------------------------------------------------------------------------- -- | Wrapper for `hGetBMP`@@ -69,34 +84,66 @@  = return $ Left $ ErrorBadMagic (fileHeaderType fileHeader) 	  | otherwise- = do	-- load the image header.-	buf	<- BSL.hGet h sizeOfBitmapInfoV3-	if (fromIntegral $ BSL.length buf) /= sizeOfBitmapInfoV3+ = do	-- Next comes the image header. +	-- The first word tells us which header format it is.+	bufSize		<- BSL.hGet h 4+	let sizeHeader	= runGet getWord32le bufSize+	+	-- Load the rest of the image header+	let sizeRest	= fromIntegral sizeHeader - 4+	bufRest	<- BSL.hGet h sizeRest+	if (fromIntegral $ BSL.length bufRest) /= sizeRest 	 then 	return $ Left ErrorReadOfImageHeaderFailed-	 else 	hGetBMP3 h fileHeader (decode buf)+	 else do+		let bufHeader 	= BSL.append bufSize bufRest+		hGetBMP3 h fileHeader sizeHeader bufHeader+		 			-hGetBMP3 h fileHeader imageHeader- | (err : _)	<- catMaybes-			[ checkFileHeader   fileHeader-			, checkBitmapInfoV3 imageHeader]- = return $ Left err+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) - | otherwise+	| 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	-- load the image data.-	let len		= fromIntegral $ dib3ImageSize imageHeader-	imageData	<- BS.hGet h len+	imageData	<- BS.hGet h sizeImage 				-	if (fromIntegral $ BS.length imageData) /= len+	if (fromIntegral $ BS.length imageData) /= sizeImage 	 then return $ Left ErrorReadOfImageDataFailed 	 else return  		$ Right $ BMP  		{ bmpFileHeader 	= fileHeader-		, bmpBitmapInfo		= InfoV3 imageHeader+		, bmpBitmapInfo		= imageHeader 		, bmpRawImageData	= imageData }   -- Writing ----------------------------------------------------------------------------------------- -- | Wrapper for `hPutBMP` writeBMP :: FilePath -> BMP -> IO () writeBMP fileName bmp@@ -106,8 +153,6 @@   -- | Put a BMP image to a file handle.---	The size of the provided image data is checked against the given dimensions.---	If these don't match then `error`. hPutBMP :: Handle -> BMP -> IO () hPutBMP h bmp  = do	BSL.hPut h (encode $ bmpFileHeader bmp)@@ -118,9 +163,9 @@ -- | 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)-bmpDimensions bmp- = case bmpBitmapInfo bmp of-	InfoV3 info-	 -> ( fromIntegral $ dib3Width info-	    , fromIntegral $ dib3Height info)+bmpDimensions bmp	+ = let	info	= getBitmapInfoV3 $ bmpBitmapInfo bmp+   in	( fromIntegral $ dib3Width info+	, fromIntegral $ dib3Height info)+ 

@@ -1,145 +1,56 @@ {-# OPTIONS_HADDOCK hide #-} module Codec.BMP.BitmapInfo 	( BitmapInfo	(..)-	, BitmapInfoV3	(..)-	, sizeOfBitmapInfoV3-	, checkBitmapInfoV3)-+	, getBitmapInfoV3) where-import Codec.BMP.Error+import Codec.BMP.BitmapInfoV3+import Codec.BMP.BitmapInfoV4+import Codec.BMP.BitmapInfoV5 import Data.Binary-import Data.Binary.Get	-import Data.Binary.Put+import Data.Binary.Get  -- Image Headers ------------------------------------------------------------------------------------- | A wrapper for the bitmap info, ---	in case we want to support other header types in the future.+-- | A wrapper for the various image header types.+--    data BitmapInfo 	= InfoV3 BitmapInfoV3+	| InfoV4 BitmapInfoV4+	| InfoV5 BitmapInfoV5 	deriving (Show)  instance Binary BitmapInfo where  get-  = do	info	<- get-	return	$ InfoV3 info-- put (InfoV3 info)-  	= put info---- | Device Independent Bitmap (DIB) header for Windows V3.-data BitmapInfoV3-	= BitmapInfoV3			-	{ -- | Size of the image header, in bytes.-	  dib3Size		:: Word32--	  -- | Width of the image, in pixels.-	, dib3Width		:: Word32+  = do	size	<- lookAhead getWord32le +	case size of+	 40 -> do+		info 	<- get+		return	$ InfoV3 info+		+	 108 -> do+		info	<- get+		return	$ InfoV4 info+		+	 124 -> do+		info	<- get+		return	$ InfoV5 info+		+	 _   -> error "Codec.BMP.BitmapInfo.get: unhandled header size" 	-	  -- | Height of the image, in pixels.-	, dib3Height		:: Word32+ put xx+  = case xx of+	InfoV3 info	-> put info+	InfoV4 info	-> put info+	InfoV5 info	-> put info 	-	  -- | Number of color planes.-	, dib3Planes		:: Word16 -	  -- | Number of bits per pixel.-	, dib3BitCount		:: Word16--	  -- | Image compression mode. 0 = uncompressed.-	, dib3Compression	:: Word32--	  -- | Size of raw image data.-	, dib3ImageSize		:: Word32--	  -- | Prefered resolution in pixels per meter, along the X axis.-	, dib3PelsPerMeterX	:: Word32--	  -- | Prefered resolution in pixels per meter, along the Y axis.-	, dib3PelsPerMeterY	:: Word32--	  -- | Number of color entries that are used.-	, dib3ColorsUsed	:: Word32--	  -- | Number of significant colors.-	, dib3ColorsImportant	:: Word32-	}-	deriving (Show)----- | Size of `BitmapInfoV3` header (in bytes)-sizeOfBitmapInfoV3 :: Int-sizeOfBitmapInfoV3 = 40---instance Binary BitmapInfoV3 where- get-  = do	size	<- getWord32le-	width	<- getWord32le-	height	<- getWord32le-	planes	<- getWord16le-	bitc	<- getWord16le-	comp	<- getWord32le-	imgsize	<- getWord32le-	pelsX	<- getWord32le-	pelsY	<- getWord32le-	cused	<- getWord32le-	cimp	<- getWord32le-	-	return	$ BitmapInfoV3-		{ dib3Size		= size-		, dib3Width		= width-		, dib3Height		= height-		, dib3Planes		= planes-		, dib3BitCount		= bitc-		, dib3Compression	= comp-		, dib3ImageSize		= imgsize-		, dib3PelsPerMeterX	= pelsX-		, dib3PelsPerMeterY	= pelsY-		, dib3ColorsUsed	= cused-		, dib3ColorsImportant	= cimp }-- put header-  = do	putWord32le 	$ dib3Size header-	putWord32le	$ dib3Width header-	putWord32le	$ dib3Height header-	putWord16le	$ dib3Planes header-	putWord16le	$ dib3BitCount header-	putWord32le	$ dib3Compression header-	putWord32le	$ dib3ImageSize header-	putWord32le	$ dib3PelsPerMeterX header-	putWord32le	$ dib3PelsPerMeterY header-	putWord32le	$ dib3ColorsUsed header-	putWord32le	$ dib3ColorsImportant header-	-	--- | Check headers for problems and unsupported features.	 -checkBitmapInfoV3 :: BitmapInfoV3 ->  Maybe Error-checkBitmapInfoV3 header-	-	| dib3Size header /= (fromIntegral sizeOfBitmapInfoV3)-	= Just	$ ErrorUnhandledBitmapHeaderSize -		$ fromIntegral $ dib3Size header-	-	| dib3Planes header /= 1-	= Just	$ ErrorUnhandledPlanesCount -		$ fromIntegral $ dib3Planes header-	-	| dib3BitCount header /= 24-	= Just 	$ ErrorUnhandledColorDepth  -		$ fromIntegral $ dib3BitCount header-	-	| dib3Compression header /= 0-	= Just	$ ErrorUnhandledCompressionMode -		$ fromIntegral $ dib3Compression header--	| dib3ImageSize header == 0-	= Just $ ErrorZeroImageSize+-- | Get the common `BitmapInfoV3` structure from a `BitmapInfo`+getBitmapInfoV3 :: BitmapInfo -> BitmapInfoV3+getBitmapInfoV3 bi+ = case bi of+	InfoV3 info	-> info+	InfoV4 info	-> dib4InfoV3 info+	InfoV5 info	-> dib4InfoV3 $ dib5InfoV4 info 	-	| dib3ImageSize header `mod` dib3Height header /= 0-	= Just $ ErrorLacksWholeNumberOfLines--	| otherwise-	= Nothing-  	 	

@@ -0,0 +1,157 @@+{-# LANGUAGE PatternGuards #-}+{-# OPTIONS_HADDOCK hide #-}+module Codec.BMP.BitmapInfoV3+	( BitmapInfoV3	(..)+	, Compression (..)+	, sizeOfBitmapInfoV3+	, checkBitmapInfoV3)+where+import Codec.BMP.Error+import Data.Binary+import Data.Binary.Get	+import Data.Binary.Put++-- | Device Independent Bitmap (DIB) header for Windows V3.+data BitmapInfoV3+	= BitmapInfoV3			+	{ -- | Size of the image header, in bytes.+	  dib3Size		:: Word32++	  -- | Width of the image, in pixels.+	, dib3Width		:: Word32+	+	  -- | Height of the image, in pixels.+	, dib3Height		:: Word32+	+	  -- | Number of color planes.+	, dib3Planes		:: Word16++	  -- | Number of bits per pixel.+	, dib3BitCount		:: Word16++	  -- | Image compression mode.+	, dib3Compression	:: Compression++	  -- | Size of raw image data.+	, dib3ImageSize		:: Word32++	  -- | Prefered resolution in pixels per meter, along the X axis.+	, dib3PelsPerMeterX	:: Word32++	  -- | Prefered resolution in pixels per meter, along the Y axis.+	, dib3PelsPerMeterY	:: Word32++	  -- | Number of color entries that are used.+	, dib3ColorsUsed	:: Word32++	  -- | Number of significant colors.+	, dib3ColorsImportant	:: Word32+	}+	deriving (Show)++data Compression+	= CompressionRGB+	| CompressionRLE8+	| CompressionRLE4+	| CompressionBitFields+	| CompressionJPEG+	| CompressionPNG+	| CompressionUnknown Word32+	deriving (Show, Eq)+++-- | Size of `BitmapInfoV3` header (in bytes)+sizeOfBitmapInfoV3 :: Int+sizeOfBitmapInfoV3 = 40+++instance Binary BitmapInfoV3 where+ get+  = do	size	<- getWord32le+	width	<- getWord32le+	height	<- getWord32le+	planes	<- getWord16le+	bitc	<- getWord16le+	comp	<- get+	imgsize	<- getWord32le+	pelsX	<- getWord32le+	pelsY	<- getWord32le+	cused	<- getWord32le+	cimp	<- getWord32le+	+	return	$ BitmapInfoV3+		{ dib3Size		= size+		, dib3Width		= width+		, dib3Height		= height+		, dib3Planes		= planes+		, dib3BitCount		= bitc+		, dib3Compression	= comp+		, dib3ImageSize		= imgsize+		, dib3PelsPerMeterX	= pelsX+		, dib3PelsPerMeterY	= pelsY+		, dib3ColorsUsed	= cused+		, dib3ColorsImportant	= cimp }++ put header+  = do	putWord32le 	$ dib3Size header+	putWord32le	$ dib3Width header+	putWord32le	$ dib3Height header+	putWord16le	$ dib3Planes header+	putWord16le	$ dib3BitCount header+	put		$ dib3Compression header+	putWord32le	$ dib3ImageSize header+	putWord32le	$ dib3PelsPerMeterX header+	putWord32le	$ dib3PelsPerMeterY header+	putWord32le	$ dib3ColorsUsed header+	putWord32le	$ dib3ColorsImportant header+	+	+instance Binary Compression where+ get+  = do	c	<- getWord32le+	case c of+	 0	-> return $ CompressionRGB+	 1	-> return $ CompressionRLE8+	 2	-> return $ CompressionRLE4+	 3	-> return $ CompressionBitFields+	 4	-> return $ CompressionJPEG+	 5	-> return $ CompressionPNG+	 _	-> return $ CompressionUnknown c+	+ put c+  = case c of+	CompressionRGB		-> putWord32le 0+	CompressionRLE8		-> putWord32le 1+	CompressionRLE4		-> putWord32le 2+	CompressionBitFields	-> putWord32le 3+	CompressionJPEG		-> putWord32le 4+	CompressionPNG		-> putWord32le 5+	CompressionUnknown x	-> putWord32le x+	+	+-- | Check headers for problems and unsupported features.	 +--	With a V3 header we only support the uncompressed 24bit RGB format.+checkBitmapInfoV3 :: BitmapInfoV3 ->  Maybe Error+checkBitmapInfoV3 header+		+	| dib3Planes header /= 1+	= Just	$ ErrorUnhandledPlanesCount +		$ fromIntegral $ dib3Planes header+	+	| dib3ImageSize header == 0+	= Just	$ ErrorZeroImageSize+	+	| dib3ImageSize header `mod` dib3Height header /= 0+	= Just	$ ErrorLacksWholeNumberOfLines++	| dib3BitCount header /= 24+	= Just 	$ ErrorUnhandledColorDepth+		$ fromIntegral $ dib3BitCount header++	| dib3Compression header /= CompressionRGB+	= Just	$ ErrorUnhandledCompressionMode+	+	| otherwise+	= Nothing+	+

@@ -0,0 +1,130 @@+{-# LANGUAGE PatternGuards #-}+{-# OPTIONS_HADDOCK hide #-}+module Codec.BMP.BitmapInfoV4+	( BitmapInfoV4	(..)+	, CIEXYZ        (..)+	, sizeOfBitmapInfoV4+	, checkBitmapInfoV4)+where+import Codec.BMP.Error+import Codec.BMP.CIEXYZ+import Codec.BMP.BitmapInfoV3+import Data.Binary+import Data.Binary.Get	+import Data.Binary.Put++-- | Device Independent Bitmap (DIB) header for Windows V4 (95 and newer)+data BitmapInfoV4+	= BitmapInfoV4+	{ -- | Size of the image header, in bytes.+	  dib4InfoV3		:: BitmapInfoV3++	  -- | Color masks specify components of each pixel.+	  --   Only used with the bitfields compression mode.+	, dib4RedMask		:: Word32+	, dib4GreenMask		:: Word32+	, dib4BlueMask		:: Word32+	, dib4AlphaMask		:: Word32++	-- | The color space used by the image.+	, dib4ColorSpaceType	:: Word32++	-- | Specifies the XYZ coords of the three colors that correspond to the RGB endpoints+	--   for the logical color space associated with the bitmap. +	--   Only used when ColorSpaceType specifies a calibrated image.+	, dib4Endpoints		:: (CIEXYZ, CIEXYZ, CIEXYZ)++	-- | Toned response curves for each component. +	--   Only used when the ColorSpaceType specifies a calibrated image.+	, dib4GammaRed		:: Word32+	, dib4GammaGreen	:: Word32+	, dib4GammaBlue		:: Word32+	}+	deriving (Show)+++-- | Size of `BitmapInfoV4` header (in bytes)+sizeOfBitmapInfoV4 :: Int+sizeOfBitmapInfoV4 = 108+++instance Binary BitmapInfoV4 where+ get+  = do	infoV3	<- get+	rmask	<- getWord32le+	gmask	<- getWord32le+	bmask	<- getWord32le+	amask	<- getWord32le+	cstype	<- getWord32le+	ends	<- get+	rgamma	<- getWord32le+	ggamma	<- getWord32le+	bgamma	<- getWord32le+	+	return	$ BitmapInfoV4+		{ dib4InfoV3		= infoV3+		, dib4RedMask		= rmask+		, dib4GreenMask		= gmask+		, dib4BlueMask		= bmask+		, dib4AlphaMask		= amask+		, dib4ColorSpaceType	= cstype+		, dib4Endpoints		= ends+		, dib4GammaRed		= rgamma+		, dib4GammaGreen	= ggamma+		, dib4GammaBlue		= bgamma }+		++ put header+  = do	put		$ dib4InfoV3		header+	putWord32le	$ dib4RedMask		header+	putWord32le	$ dib4GreenMask		header+	putWord32le	$ dib4BlueMask		header+	putWord32le	$ dib4AlphaMask		header+	putWord32le	$ dib4ColorSpaceType	header+	put		$ dib4Endpoints 	header+	putWord32le	$ dib4GammaRed		header+	putWord32le	$ dib4GammaGreen	header+	putWord32le	$ dib4GammaBlue		header+++	+-- | Check headers for problems and unsupported features.	 +--	With a V4 header we support both the uncompressed 24bit RGB format,+--	and the uncompressed 32bit RGBA format.+--+checkBitmapInfoV4 :: BitmapInfoV4 ->  Maybe Error+checkBitmapInfoV4 headerV4+		+	| dib3Planes headerV3 /= 1+	= Just	$ ErrorUnhandledPlanesCount +		$ fromIntegral $ dib3Planes headerV3+	+	| dib3ImageSize headerV3 == 0+	= Just	$ ErrorZeroImageSize+	+	| dib3ImageSize headerV3 `mod` dib3Height headerV3 /= 0+	= Just	$ ErrorLacksWholeNumberOfLines++	-- Check for valid compression modes ----++	-- uncompressed 24bit RGB+	| dib3BitCount    headerV3 == 24 +	, dib3Compression headerV3 == CompressionRGB+	= Nothing+	+	-- uncompressed 32bit RGBA+	| dib3BitCount    headerV3 == 32+	, dib3Compression headerV3 == CompressionBitFields+	, dib4AlphaMask   headerV4 == 0xff000000+	, dib4RedMask     headerV4 == 0x00ff0000+	, dib4GreenMask   headerV4 == 0x0000ff00+	, dib4BlueMask    headerV4 == 0x000000ff+	= Nothing+	+	-- Some unsupported compression mode ----+	| otherwise+	= Just $ ErrorUnhandledCompressionMode+	+	where	headerV3 = dib4InfoV3 headerV4+	+	

@@ -0,0 +1,68 @@+{-# OPTIONS_HADDOCK hide #-}+module Codec.BMP.BitmapInfoV5+	( BitmapInfoV5	(..)+	, sizeOfBitmapInfoV5+	, checkBitmapInfoV5)+where+import Codec.BMP.Error+import Codec.BMP.BitmapInfoV4+import Data.Binary+import Data.Binary.Get	+import Data.Binary.Put+++-- | Device Independent Bitmap (DIB) header for Windows V5 (98/2000 and newer)+data BitmapInfoV5+	= BitmapInfoV5+	{ dib5InfoV4		:: BitmapInfoV4+	+	-- | Rendering intent for the bitmap.+	, dib5Intent		:: Word32++	-- | Offset (in bytes) from the beginning of the header to the start of the profile data.+	, dib5ProfileData	:: Word32++	-- | Size (in bytes) of embedded profile data.+	, dib5ProfileSize	:: Word32+	+	-- | Reserved, should be zero.+	, dib5Reserved		:: Word32+	}+	deriving (Show)++-- | Size of `BitmapInfoV5` header (in bytes)+sizeOfBitmapInfoV5 :: Int+sizeOfBitmapInfoV5 = 124+++instance Binary BitmapInfoV5 where+ get+  = do	infoV4	<- get+	intent	<- getWord32le+	pdata	<- getWord32le+	psize	<- getWord32le+	res	<- getWord32le+	+	return	$ BitmapInfoV5+		{ dib5InfoV4		= infoV4+		, dib5Intent		= intent+		, dib5ProfileData	= pdata+		, dib5ProfileSize	= psize+		, dib5Reserved		= res }+		++ put header+  = do	put		$ dib5InfoV4		header+	putWord32le	$ dib5Intent		header+	putWord32le	$ dib5ProfileData	header+	putWord32le	$ dib5ProfileSize	header+	putWord32le	$ dib5Reserved		header++	+-- | Check headers for problems and unsupported features.	 +--	The V5 header doesn't give us any more useful info than the V4 one.+checkBitmapInfoV5 :: BitmapInfoV5 ->  Maybe Error+checkBitmapInfoV5 header+	= checkBitmapInfoV4 $ dib5InfoV4 header++

@@ -0,0 +1,27 @@++module Codec.BMP.CIEXYZ+	(CIEXYZ(..))+where+import Data.Word+import Data.Binary+import Data.Binary.Get+import Data.Binary.Put ++-- | Contains the XYZ coordinates of a specific color in a specified color space.+data CIEXYZ +	= CIEXYZ Word32 Word32 Word32+	deriving Show+++instance Binary CIEXYZ where+ get +  = do	r	<- getWord32le+	g	<- getWord32le+	b	<- getWord32le+	return	$ CIEXYZ r g b+	+ put (CIEXYZ r g b)+  = do	putWord32le r+	putWord32le g+	putWord32le b+

@@ -17,7 +17,7 @@ 	| ErrorUnhandledBitmapHeaderSize  	Int 	| ErrorUnhandledPlanesCount		Int 	| ErrorUnhandledColorDepth		Int-	| ErrorUnhandledCompressionMode		Int+	| ErrorUnhandledCompressionMode 	| ErrorZeroImageSize 	| ErrorLacksWholeNumberOfLines 	deriving (Eq, Show)

@@ -5,7 +5,7 @@ 	, sizeOfFileHeader 	, checkFileHeader) where-import Codec.BMP.BitmapInfo+import Codec.BMP.BitmapInfoV3 import Codec.BMP.Error import Data.Binary import Data.Binary.Get	

@@ -5,6 +5,7 @@ where import Codec.BMP.Base import Codec.BMP.BitmapInfo+import Codec.BMP.BitmapInfoV3 import Codec.BMP.FileHeader import Foreign.Ptr import Foreign.Marshal.Alloc@@ -17,8 +18,8 @@ import Prelude			as P  -- | Pack a string of RGBA component values into a BMP image.---	The alpha component is ignored.  --	If the given dimensions don't match the input string then `error`.+--	This currently ignores the alpha component of the input string and produces a 24bit RGB image. packRGBA32ToBMP 	:: Int 		-- ^ Width of image. 	-> Int 		-- ^ Height of image.@@ -50,7 +51,7 @@ 		, dib3Height		= fromIntegral height 		, dib3Planes		= 1 		, dib3BitCount		= 24-		, dib3Compression	= 0+		, dib3Compression	= CompressionRGB 		, dib3ImageSize		= fromIntegral $ BS.length imageData  		-- The default resolution seems to be 72 pixels per inch.

@@ -5,6 +5,7 @@ where	 import Codec.BMP.Base import Codec.BMP.BitmapInfo+import Codec.BMP.BitmapInfoV3 import Foreign.Ptr import Foreign.Marshal.Alloc import Foreign.Storable@@ -16,15 +17,16 @@   -- | Unpack a BMP image to a string of RGBA component values.---	The alpha component is set to 255 for every pixel. unpackBMPToRGBA32 :: BMP -> ByteString unpackBMPToRGBA32 bmp - = case bmpBitmapInfo bmp of-	InfoV3 info-	 -> packRGB24ToRGBA32 -			(fromIntegral $ dib3Width info) -			(fromIntegral $ dib3Height info)-			(bmpRawImageData bmp)+ = let	info		= getBitmapInfoV3 $ bmpBitmapInfo bmp+	width		= fromIntegral $ dib3Width  info+	height		= fromIntegral $ dib3Height info+	bitCount	= dib3BitCount info+   in	case bitCount of+	 24	-> packRGB24ToRGBA32 width height (bmpRawImageData bmp)+	 32	-> packRGB32ToRGBA32 width height (bmpRawImageData bmp)+	 _	-> error "Codec.BMP.unpackBMPToRGBA32: unhandled bitcount"   -- | Unpack raw, uncompressed 24 bit BMP image data to a string of RGBA component values.@@ -73,6 +75,55 @@ 		pokeByteOff ptrDest (oDest + 3) (255 :: Word8) 		 		go (posX + 1) posY (oSrc + 3) (oDest + 4)++++-- | Unpack raw, uncompressed 32 bit BMP image data to a string of RGBA component values.+--   Note in the BMP file the components are arse-around ABGR instead of RGBA. +--   The 'unpacking' here is really just flipping the components around.+packRGB32ToRGBA32+	:: Int 			-- Width of image.+	-> Int			-- Height of image.+	-> ByteString 		-- Input string.+	-> ByteString+		+packRGB32ToRGBA32 width height str+  = let sizeDest = height * width * 4+    in  if sizeDest /= BS.length str+	 then error "Codec.BMP.unpackRGB24ToRGBA32: given image dimensions don't match input data."+ 	 else unsafePerformIO+       	 	$ allocaBytes sizeDest      $ \bufDest -> +   	   	  BS.unsafeUseAsCString str $ \bufSrc  ->+            	   do	packRGB32ToRGBA32' width height (castPtr bufSrc) (castPtr bufDest)+			packCStringLen (bufDest, sizeDest)+		+-- We're doing this via Ptrs because we don't want to take the+-- overhead of doing the bounds checks in ByteString.index.+packRGB32ToRGBA32' width height ptrSrc ptrDest + = go 0 0 0 0+ where	+	go posX posY oSrc oDest+	 -- skip over padding bytes at the end of each line.+	 | posX == width +	 = go 0 (posY + 1) oSrc oDest+	+	 -- we've finished the image.+	 | posY == height+	 = return ()+	+	 -- process a pixel.+	 | otherwise+	 = do	blue   :: Word8	<- peekByteOff ptrSrc (oSrc + 0)+		green  :: Word8	<- peekByteOff ptrSrc (oSrc + 1)+		red    :: Word8	<- peekByteOff ptrSrc (oSrc + 2)+		alpha  :: Word8 <- peekByteOff ptrSrc (oSrc + 3)++		pokeByteOff ptrDest (oDest + 0) red+		pokeByteOff ptrDest (oDest + 1) green+		pokeByteOff ptrDest (oDest + 2) blue+		pokeByteOff ptrDest (oDest + 3) alpha+		+		go (posX + 1) posY (oSrc + 4) (oDest + 4)   		

@@ -1,5 +1,5 @@ Name:                bmp-Version:             1.0.0.1+Version:             1.1.0.0 License:             MIT License-file:        LICENSE Author:              Ben Lippmeier@@ -11,10 +11,10 @@ Homepage:            http://code.haskell.org/~benl/code/bmp-head Bug-reports:         bmp@ouroborus.net Description:-	Read and write uncompressed 24bit BMP image files. 100% robust Haskell implementation.+	Read and write uncompressed BMP image files. 100% robust Haskell implementation.  Synopsis:-        Read and write uncompressed 24bit BMP image files.+        Read and write uncompressed BMP image files.  Tested-with: GHC == 6.12.1 @@ -33,6 +33,10 @@   Other-modules:         Codec.BMP.Base         Codec.BMP.BitmapInfo+        Codec.BMP.BitmapInfoV3+        Codec.BMP.BitmapInfoV4+        Codec.BMP.BitmapInfoV5+        Codec.BMP.CIEXYZ         Codec.BMP.Error         Codec.BMP.FileHeader         Codec.BMP.Pack