bmp 1.2.3.2 → 1.2.3.3

raw patch · 10 files changed

+158/−80 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Codec/BMP/BitmapInfo.hs +1/−1
• Codec/BMP/BitmapInfoV3.hs +22/−4
• Codec/BMP/BitmapInfoV4.hs +2/−1
• Codec/BMP/CIEXYZ.hs +1/−0
• Codec/BMP/Compression.hs +1/−0
• Codec/BMP/Error.hs +1/−1
• Codec/BMP/FileHeader.hs +2/−1
• Codec/BMP/Pack.hs +39/−20
• Codec/BMP/Unpack.hs +79/−46
• bmp.cabal +10/−6

@@ -9,7 +9,7 @@ import Data.Binary import Data.Binary.Get --- Image Headers --------------------------------------------------------------+ -- | A wrapper for the various image header types. --    data BitmapInfo

@@ -12,8 +12,10 @@ import Data.Binary import Data.Binary.Get	 import Data.Binary.Put+import Data.Int import Debug.Trace + -- | Device Independent Bitmap (DIB) header for Windows V3. data BitmapInfoV3 	= BitmapInfoV3			@@ -26,6 +28,10 @@ 	  -- | (+8) Height of the image, in pixels. 	, dib3Height		:: Word32 	+          -- | If the height field in the file is negative then this is interpreted+          --   as an image with the rows flipped.+        , dib3HeightFlipped     :: Bool+ 	  -- | (+12) Number of color planes. 	, dib3Planes		:: Word16 @@ -65,9 +71,19 @@  instance Binary BitmapInfoV3 where  get-  = do	size	<- getWord32le-	width	<- getWord32le-	height	<- getWord32le+  = do	size	  <- getWord32le+	width	  <- getWord32le++        -- We're supposed to treat the height field as a signed integer.+        -- If it's negative it means the image is flipped along the X axis.+        -- (which is crazy, but we just have to eat it)+	heightW32 <- getWord32le+        let heightI32 = (fromIntegral heightW32 :: Int32)+        let (height, flipped)+                = if heightI32 < 0+                        then (fromIntegral (abs heightI32), True)+                        else (heightW32,                      False)+ 	planes	<- getWord16le 	bitc	<- getWord16le 	comp	<- get@@ -81,6 +97,7 @@ 		{ dib3Size		= size 		, dib3Width		= width 		, dib3Height		= height+                , dib3HeightFlipped     = flipped 		, dib3Planes		= planes 		, dib3BitCount		= bitc 		, dib3Compression	= comp@@ -132,7 +149,8 @@         --  in the header, because some encoders add padding to the end.         | Just calculatedImageSize      <- imageSizeFromBitmapInfoV3 header         , fromIntegral physicalBufferSize < calculatedImageSize-        = Just  $ ErrorImageDataTruncated +        = trace (show header)+        $ Just  $ ErrorImageDataTruncated                          calculatedImageSize                         (fromIntegral physicalBufferSize) 

@@ -14,6 +14,7 @@ import Data.Binary.Get	 import Data.Binary.Put + -- | Device Independent Bitmap (DIB) header for Windows V4 (95 and newer) data BitmapInfoV4 	= BitmapInfoV4@@ -126,7 +127,6 @@   	-- Check for valid compression modes -----         -- uncompressed 32bit RGBA stated as CompressionRGB.         | dib3BitCount    headerV3 == 32         , dib3Compression headerV3 == CompressionRGB@@ -191,3 +191,4 @@         = Nothing          where   headerV3 = dib4InfoV3 headerV4+

@@ -7,6 +7,7 @@ import Data.Binary.Get import Data.Binary.Put  + -- | Contains the XYZ coordinates of a specific color in a specified color --   space. data CIEXYZ 

@@ -8,6 +8,7 @@ import Data.Binary.Put  +-- | The Compression mode says how the image data is encoded in the file. data Compression         = CompressionRGB         | CompressionRLE8

@@ -5,9 +5,9 @@ import Codec.BMP.Compression import Data.Word + -- | Things that can go wrong when loading a BMP file. data Error-         -- | Magic number was not at the start of the file,          --   so this probably isn't a BMP file.         = ErrorBadMagic

@@ -12,7 +12,6 @@ import Data.Binary.Put  --- File Headers --------------------------------------------------------------- -- | BMP file header. data FileHeader 	= FileHeader			@@ -33,9 +32,11 @@ 	} 	deriving (Show) + -- | Size of a file header (in bytes). sizeOfFileHeader :: Int sizeOfFileHeader = 14+  -- | Magic number that should come at the start of a BMP file. bmpMagic :: Word16

@@ -17,20 +17,32 @@ import Data.ByteString.Unsafe	as BS import Prelude			as P + -- | Pack a string of RGBA component values into a BMP image.---	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.+--+--  * If the given dimensions don't match the input string then `error`.+--+--  * If the width or height fields are negative 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.+	:: Int 		-- ^ Width of image  (must be positive).+	-> Int 		-- ^ Height of image (must be positive). 	-> ByteString	-- ^ A string of RGBA component values.                         --   Must have length (@width * height * 4@) 	-> BMP 	 packRGBA32ToBMP width height str+ | width < 0+ = error "Codec.BMP: Negative width field."++ | height < 0+ = error "Codec.BMP: Negative height field."+  | height * width * 4 /= BS.length str- = error "Codec.BMP.packRGBAToBMP: given image dimensions don't match input data."+ = error "Codec.BMP: Image dimensions don't match input data."   | otherwise  = let	(imageData, _)	= packRGBA32ToRGB24 width height str@@ -39,18 +51,22 @@ 		= FileHeader 		{ fileHeaderType	= bmpMagic -		, fileHeaderFileSize	= fromIntegral-					$ sizeOfFileHeader + sizeOfBitmapInfoV3	+ BS.length imageData+		, fileHeaderFileSize	+                        = fromIntegral+			$ sizeOfFileHeader + sizeOfBitmapInfoV3	+                                           + BS.length imageData  		, fileHeaderReserved1	= 0 		, fileHeaderReserved2	= 0-		, fileHeaderOffset	= fromIntegral (sizeOfFileHeader + sizeOfBitmapInfoV3) }+		, fileHeaderOffset	+                        = fromIntegral (sizeOfFileHeader + sizeOfBitmapInfoV3)}  	bitmapInfoV3 		= BitmapInfoV3 		{ dib3Size		= fromIntegral sizeOfBitmapInfoV3 		, dib3Width		= fromIntegral width 		, dib3Height		= fromIntegral height+                , dib3HeightFlipped     = False 		, dib3Planes		= 1 		, dib3BitCount		= 24 		, dib3Compression	= CompressionRGB@@ -65,9 +81,12 @@ 		, dib3ColorsUsed	= 0 		, dib3ColorsImportant	= 0 } 		+        -- We might as well check to see if we've made a well-formed BMP file.+        -- It would be sad if we couldn't read a file we just wrote. 	errs	= catMaybes		 			[ checkFileHeader   fileHeader-			, checkBitmapInfoV3 bitmapInfoV3 (fromIntegral $ BS.length imageData)]+			, checkBitmapInfoV3 bitmapInfoV3 +                                           (fromIntegral $ BS.length imageData)] 		    in	case errs of 	 [] -> BMP @@ -75,19 +94,21 @@ 		, bmpBitmapInfo		= InfoV3 bitmapInfoV3 		, bmpRawImageData	= imageData } 	 -	 _  -> error $ "Codec.BMP: packRGBA32ToBMP constructed BMP file has errors, sorry.\n" ++ show errs+	 _  -> error $ "Codec.BMP: Constructed BMP file has errors, sorry." +                     ++ show errs    packRGBA32ToRGB24 -	:: Int			-- ^ Width of image.-	-> Int			-- ^ Height of image.-	-> ByteString-	-> (ByteString, Int)	-- output bytestring, and number of pad bytes per line.+	:: Int		       -- ^ Width of image.+	-> Int		       -- ^ Height of image.+	-> ByteString          -- ^ Source bytestring holding the image data. +	-> (ByteString, Int)   -- output bytestring, and number of pad+                               -- bytes per line. 	 packRGBA32ToRGB24 width height str  | height * width * 4 /= BS.length str- = error "Codec.BMP.packRGBAToRGB24: given image dimensions don't match input data."+ = error "Codec.BMP: Image dimensions don't match input data."   | otherwise  = let	padPerLine	@@ -122,9 +143,8 @@ 	 	 -- process a pixel 	 | otherwise-	 = do	-		red	:: Word8  <- peekByteOff ptrSrc (oSrc + 0)-		green	:: Word8  <- peekByteOff ptrSrc (oSrc + 1)+	 = do   red	:: Word8  <- peekByteOff ptrSrc (oSrc + 0)+                green	:: Word8  <- peekByteOff ptrSrc (oSrc + 1) 		blue	:: Word8  <- peekByteOff ptrSrc (oSrc + 2) 	 		pokeByteOff ptrDest (oDest + 0) blue@@ -132,5 +152,4 @@ 		pokeByteOff ptrDest (oDest + 2) red 		 		go (posX + 1) posY (oSrc + 4) (oDest + 3)- 

@@ -22,11 +22,12 @@  = let	info		= getBitmapInfoV3 $ bmpBitmapInfo bmp 	width		= fromIntegral $ dib3Width  info 	height		= fromIntegral $ dib3Height info+        flipX           = dib3HeightFlipped 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."+	 24	-> packRGB24ToRGBA32 width height flipX (bmpRawImageData bmp)+	 32	-> packRGB32ToRGBA32 width height flipX (bmpRawImageData bmp)+	 _	-> error "Codec.BMP: Unhandled bitcount."   -- | Unpack raw, uncompressed 24 bit BMP image data to a string of@@ -34,53 +35,70 @@ -- --   The alpha component is set to 255 for every pixel. packRGB24ToRGBA32-	:: Int 			-- Width of image.-	-> Int			-- Height of image.-	-> ByteString 		-- Input string.+	:: Int 			-- ^ Width of image.+	-> Int			-- ^ Height of image.+        -> Bool                 -- ^ Image data is flipped along the X axis.+	-> ByteString 		-- ^ Input string. 	-> ByteString 		-packRGB24ToRGBA32 width height str- = let	bytesPerLine	= BS.length str `div` height-	padPerLine	= bytesPerLine - width * 3+packRGB24ToRGBA32 width height flipX str+ = let	-- Number of bytes per line in the source file, +        -- including padding bytes.+        srcBytesPerLine	= BS.length str `div` height 	sizeDest	= width * height * 4          -- We allow padding bytes on the end of the image data.-   in	if BS.length str < height * (width * 3 + padPerLine)-	 then error "Codec.BMP.unpackRGB24ToRGBA32: image data is truncated."+   in	if BS.length str < height * srcBytesPerLine+	 then error "Codec.BMP: Image data is truncated."  	 else unsafePerformIO        	 	$ allocaBytes sizeDest      $ \bufDest ->     	   	  BS.unsafeUseAsCString str $ \bufSrc  ->-            	   do	packRGB24ToRGBA32' width height padPerLine+            	   do	packRGB24ToRGBA32' +                                width height flipX +                                srcBytesPerLine                                 (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.-packRGB24ToRGBA32' width height pad ptrSrc ptrDest - = go 0 0 0 0+packRGB24ToRGBA32' width height flipX srcBytesPerLine ptrSrc ptrDst + = go 0  where	-	go posX posY oSrc oDest-	 -- skip over padding bytes at the end of each line.+        go posY+         -- we've finished the image.+         | posY == height+         = return ()++         -- Image source data is flipped along the X axis.+         | flipX+         = let  !oSrc   = srcBytesPerLine * (height - 1 - posY)+                !oDst   = width * 4 * posY+           in   go_line 0 posY oSrc oDst++         -- Image source data is in the natural order.+         | otherwise+         = let  !oSrc   = srcBytesPerLine * posY+                !oDst   = width * 4 * posY+           in   go_line 0 posY oSrc oDst++	go_line posX posY oSrc oDst+	 -- move to the next line. 	 | posX == width -	 = go 0 (posY + 1) (oSrc + pad) oDest-	-	 -- we've finished the image.-	 | posY == height-	 = return ()-	+	 = go (posY + 1)+		 	 -- process a pixel. 	 | otherwise 	 = do	blue  :: Word8	<- peekByteOff ptrSrc (oSrc + 0) 		green :: Word8	<- peekByteOff ptrSrc (oSrc + 1) 		red   :: Word8	<- peekByteOff ptrSrc (oSrc + 2) -		pokeByteOff ptrDest (oDest + 0) red-		pokeByteOff ptrDest (oDest + 1) green-		pokeByteOff ptrDest (oDest + 2) blue-		pokeByteOff ptrDest (oDest + 3) (255 :: Word8)+		pokeByteOff ptrDst (oDst + 0) red+		pokeByteOff ptrDst (oDst + 1) green+		pokeByteOff ptrDst (oDst + 2) blue+		pokeByteOff ptrDst (oDst + 3) (255 :: Word8) 		-		go (posX + 1) posY (oSrc + 3) (oDest + 4)+		go_line (posX + 1) posY (oSrc + 3) (oDst + 4)   @@ -89,35 +107,50 @@ --   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.+	:: Int 			-- ^ Width of image.+	-> Int			-- ^ Height of image.+        -> Bool                 -- ^ Image data is flipped along the X axis.+	-> ByteString 		-- ^ Input string. 	-> ByteString 		-packRGB32ToRGBA32 width height str+packRGB32ToRGBA32 width height flipX str   = let sizeDest = height * width * 4     in  if  BS.length str < sizeDest-	 then error "Codec.BMP.packRGB24ToRGBA32: image data is truncated."+	 then error "Codec.BMP: Image data is truncated."  	 else unsafePerformIO        	 	$ allocaBytes sizeDest      $ \bufDest ->     	   	  BS.unsafeUseAsCString str $ \bufSrc  ->             	   do	packRGB32ToRGBA32' width height+                                flipX                                 (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+packRGB32ToRGBA32' width height flipX ptrSrc ptrDst+ = go 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+	go posY+         -- we've finished the image.+         | posY == height+         = return ()++         -- Image source data is flipped along the X axis.+         | flipX+         = let  !oSrc   = width * 4 * (height - 1 - posY)+                !oDst   = width * 4 * posY+           in   go_line 0 posY oSrc oDst 	-	 -- we've finished the image.-	 | posY == height-	 = return ()+         -- Image source data is in the natural order.+         | otherwise+         = let  !oSrc   = width * 4 * posY+                !oDst   = width * 4 * posY+           in   go_line 0 posY oSrc oDst++        go_line posX posY oSrc oDst+         -- move to the next line.+         | posX == width +         = go (posY + 1) 	 	 -- process a pixel. 	 | otherwise@@ -126,10 +159,10 @@ 		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+		pokeByteOff ptrDst (oDst + 0) red+		pokeByteOff ptrDst (oDst + 1) green+		pokeByteOff ptrDst (oDst + 2) blue+		pokeByteOff ptrDst (oDst + 3) alpha 		-		go (posX + 1) posY (oSrc + 4) (oDest + 4)+		go_line (posX + 1) posY (oSrc + 4) (oDst + 4) 

@@ -1,5 +1,5 @@ Name:                bmp-Version:             1.2.3.2+Version:             1.2.3.3 License:             MIT License-file:        LICENSE Author:              Ben Lippmeier@@ -12,14 +12,15 @@ Bug-reports:         bmp@ouroborus.net Description: 	Read and write uncompressed BMP image files. 100% robust Haskell implementation.- Synopsis:         Read and write uncompressed BMP image files. -Tested-with: GHC == 7.2+source-repository head+        type:           darcs+        location:       http://code.ouroborus.net/bmp-head  Library-  Build-Depends: +  build-Depends:          base                 == 4.*,         bytestring           == 0.10.*,         binary               == 0.5.*@@ -27,10 +28,13 @@   ghc-options:         -Wall -fno-warn-missing-signatures -  Exposed-modules:+  extensions:+        BangPatterns++  exposed-modules:         Codec.BMP -  Other-modules:+  other-modules:         Codec.BMP.Base         Codec.BMP.Compression         Codec.BMP.BitmapInfo