bmp 1.1.2.1 → 1.2.0.1
raw patch · 11 files changed
+297/−137 lines, 11 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Codec.BMP: ErrorDodgyFileHeaderFieldFileSize :: Int -> Error
- Codec.BMP: ErrorFileIsTruncated :: Error
- Codec.BMP: ErrorLacksWholeNumberOfLines :: Error
- Codec.BMP: ErrorReadOfFileHeaderFailed :: Error
- Codec.BMP: ErrorReadOfImageDataFailed :: Error
- Codec.BMP: ErrorReadOfImageHeaderFailed :: Error
- Codec.BMP: ErrorUnexpectedImageSize :: Error
+ Codec.BMP: ErrorFileHeaderTruncated :: Error
+ Codec.BMP: ErrorImageDataTruncated :: Int -> Int -> Error
+ Codec.BMP: ErrorImageHeaderTruncated :: Error
+ Codec.BMP: ErrorImagePhysicalSizeMismatch :: Word32 -> Word32 -> Error
+ Codec.BMP: ErrorInternalErrorPleaseReport :: Error
+ Codec.BMP: errorBitmapHeaderSize :: Error -> Word32
+ Codec.BMP: errorBytesAvailable :: Error -> Int
+ Codec.BMP: errorBytesNeeded :: Error -> Int
+ Codec.BMP: errorColorDepth :: Error -> Word16
+ Codec.BMP: errorCompression :: Error -> Compression
+ Codec.BMP: errorFileHeaderOffset :: Error -> Word32
+ Codec.BMP: errorImageSizeFromHeader :: Error -> Word32
+ Codec.BMP: errorImageSizeOfBuffer :: Error -> Word32
+ Codec.BMP: errorPlanesCount :: Error -> Word16
- Codec.BMP: ErrorDodgyFileHeaderFieldOffset :: Int -> Error
+ Codec.BMP: ErrorDodgyFileHeaderFieldOffset :: Word32 -> Error
- Codec.BMP: ErrorUnhandledBitmapHeaderSize :: Int -> Error
+ Codec.BMP: ErrorUnhandledBitmapHeaderSize :: Word32 -> Error
- Codec.BMP: ErrorUnhandledColorDepth :: Int -> Error
+ Codec.BMP: ErrorUnhandledColorDepth :: Word16 -> Error
- Codec.BMP: ErrorUnhandledCompressionMode :: Error
+ Codec.BMP: ErrorUnhandledCompressionMode :: Compression -> Error
- Codec.BMP: ErrorUnhandledPlanesCount :: Int -> Error
+ Codec.BMP: ErrorUnhandledPlanesCount :: Word16 -> Error
Files
- Codec/BMP.hs +40/−38
- Codec/BMP/Base.hs +2/−4
- Codec/BMP/BitmapInfo.hs +1/−0
- Codec/BMP/BitmapInfoV3.hs +61/−52
- Codec/BMP/BitmapInfoV4.hs +77/−18
- Codec/BMP/BitmapInfoV5.hs +8/−1
- Codec/BMP/Compression.hs +43/−0
- Codec/BMP/Error.hs +48/−12
- Codec/BMP/FileHeader.hs +5/−4
- Codec/BMP/Unpack.hs +8/−5
- bmp.cabal +4/−3
Codec/BMP.hs view
@@ -2,7 +2,8 @@ -- | Reading and writing uncompressed BMP files. ----- Reading works for both uncompressed 24bit RGB WindowsV3 and 32bit RGBA WindowsV4 formats.+-- 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. --@@ -23,9 +24,13 @@ -- > ... -- -- Release Notes:++-- > * bmp 1.2.0+-- Accept files with zero padding on the end.+-- Accept RGBA files with V3 headers. -- -- > * bmp 1.1.2 --- > Handle files with the image size field set to zero.+-- > Accept files with the image size field set to zero. -- module Codec.BMP ( BMP (..)@@ -80,14 +85,12 @@ = BSL.splitAt (fromIntegral sizeOfFileHeader) buf if (fromIntegral $ BSL.length bufFileHeader) /= sizeOfFileHeader- then return $ Left ErrorReadOfFileHeaderFailed+ then return $ Left ErrorFileHeaderTruncated else hGetBMP2 bufRest (decode bufFileHeader) hGetBMP2 buf fileHeader -- Check the magic before doing anything else.- -- If the specified file is not a BMP file then we'd prefer to get - -- this error than a `ReadOfImageHeaderFailed`. | fileHeaderType fileHeader /= bmpMagic = return $ Left $ ErrorBadMagic (fileHeaderType fileHeader) @@ -100,59 +103,58 @@ let (bufImageHeader, bufRest) = BSL.splitAt (fromIntegral sizeHeader) buf - -- How long we expect the image data to be.- -- For uncompressed data without a colour table, all of the file that- -- isn't the header should be image data. The length of the image data- -- is sometimes recorded in the imageSize field of the header, but- -- sometimes that field is zero, so we have to compute it like so..- let expectedImageSize+ -- 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.+ let physicalBufferSize = (fromIntegral $ BSL.length bufRest) :: Word32 if (fromIntegral $ BSL.length bufImageHeader) /= sizeHeader- then return $ Left ErrorReadOfImageHeaderFailed- else hGetBMP3 fileHeader bufImageHeader bufRest expectedImageSize+ then return $ Left ErrorImageHeaderTruncated+ else hGetBMP3 fileHeader bufImageHeader bufRest physicalBufferSize -hGetBMP3 fileHeader bufImageHeader bufRest expectedImageSize+hGetBMP3 fileHeader bufImageHeader bufRest physicalBufferSize | BSL.length bufImageHeader == 40 = do let info = decode bufImageHeader- case checkBitmapInfoV3 info expectedImageSize of+ case checkBitmapInfoV3 info physicalBufferSize of Just err -> return $ Left err- Nothing -> hGetBMP4 fileHeader (InfoV3 info) bufRest- (fromIntegral expectedImageSize)-{- (fromIntegral $ dib3ImageSize info) -}+ Nothing+ | Just imageSize <- imageSizeFromBitmapInfoV3 info+ -> hGetBMP4 fileHeader (InfoV3 info) bufRest imageSize+ | otherwise+ -> return $ Left $ ErrorInternalErrorPleaseReport | BSL.length bufImageHeader == 108 = do let info = decode bufImageHeader- case checkBitmapInfoV4 info expectedImageSize of+ case checkBitmapInfoV4 info physicalBufferSize of Just err -> return $ Left err- Nothing -> hGetBMP4 fileHeader (InfoV4 info) bufRest- (fromIntegral expectedImageSize)-{- (fromIntegral - $ dib3ImageSize - $ dib4InfoV3 info)--} + Nothing + | Just imageSize <- imageSizeFromBitmapInfoV4 info+ -> hGetBMP4 fileHeader (InfoV4 info) bufRest imageSize+ | otherwise+ -> return $ Left $ ErrorInternalErrorPleaseReport+ | BSL.length bufImageHeader == 124 = do let info = decode bufImageHeader- case checkBitmapInfoV5 info expectedImageSize of+ case checkBitmapInfoV5 info physicalBufferSize of Just err -> return $ Left err- Nothing -> hGetBMP4 fileHeader (InfoV5 info) bufRest- (fromIntegral expectedImageSize)-{- (fromIntegral- $ dib3ImageSize - $ dib4InfoV3- $ dib5InfoV4 info)--}+ Nothing + | Just imageSize <- imageSizeFromBitmapInfoV5 info+ -> hGetBMP4 fileHeader (InfoV5 info) bufRest imageSize+ | otherwise+ -> return $ Left $ ErrorInternalErrorPleaseReport | otherwise- = return - $ Left - $ ErrorUnhandledBitmapHeaderSize (fromIntegral $ BSL.length bufImageHeader)+ = return $ Left + $ ErrorUnhandledBitmapHeaderSize + $ fromIntegral $ BSL.length bufImageHeader hGetBMP4 fileHeader imageHeader bufImage (sizeImage :: Int)- = if (fromIntegral $ BSL.length bufImage) /= sizeImage- then return $ Left ErrorReadOfImageDataFailed+ = let bufLen = fromIntegral $ BSL.length bufImage+ in if bufLen < sizeImage+ then return $ Left $ ErrorImageDataTruncated sizeImage bufLen else return $ Right $ BMP { bmpFileHeader = fileHeader
Codec/BMP/Base.hs view
@@ -1,11 +1,12 @@ {-# OPTIONS_HADDOCK hide #-} module Codec.BMP.Base- (BMP (..))+ ( BMP (..)) where import Codec.BMP.FileHeader import Codec.BMP.BitmapInfo import Data.ByteString + -- | A BMP image. -- For an uncompressed image, the image data contains triples of BGR component values. -- Each line may also have zero pad values on the end, to bring them up to a multiple@@ -16,8 +17,5 @@ , bmpBitmapInfo :: BitmapInfo , bmpRawImageData :: ByteString } deriving Show---
Codec/BMP/BitmapInfo.hs view
@@ -18,6 +18,7 @@ | InfoV5 BitmapInfoV5 deriving (Show) + instance Binary BitmapInfo where get = do size <- lookAhead getWord32le
Codec/BMP/BitmapInfoV3.hs view
@@ -4,13 +4,16 @@ ( BitmapInfoV3 (..) , Compression (..) , sizeOfBitmapInfoV3- , checkBitmapInfoV3)+ , checkBitmapInfoV3+ , imageSizeFromBitmapInfoV3) where import Codec.BMP.Error+import Codec.BMP.Compression import Data.Binary import Data.Binary.Get import Data.Binary.Put + -- | Device Independent Bitmap (DIB) header for Windows V3. data BitmapInfoV3 = BitmapInfoV3 @@ -53,17 +56,7 @@ } 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@@ -109,54 +102,70 @@ 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 -> Word32 -> Maybe Error-checkBitmapInfoV3 header expectedImageSize- +checkBitmapInfoV3 header physicalBufferSize++ -- We only handle a single color plane. | dib3Planes header /= 1- = Just $ ErrorUnhandledPlanesCount - $ fromIntegral $ dib3Planes header- - | dib3ImageSize header /= 0- , dib3ImageSize header /= expectedImageSize- = Just $ ErrorUnexpectedImageSize+ = Just $ ErrorUnhandledPlanesCount $ dib3Planes header - | expectedImageSize `mod` dib3Height header /= 0- = Just $ ErrorLacksWholeNumberOfLines-+ -- We only handle 24 and 32 bit images. | dib3BitCount header /= 24- = Just $ ErrorUnhandledColorDepth- $ fromIntegral $ dib3BitCount header+ , dib3BitCount header /= 32+ = Just $ ErrorUnhandledColorDepth $ dib3BitCount header - | dib3Compression header /= CompressionRGB- = Just $ ErrorUnhandledCompressionMode- + -- If the image size field in the header is non-zero, + -- then it must be the same as the physical size of the image buffer.+ | headerImageSize <- dib3ImageSize header+ , headerImageSize /= 0+ , fromIntegral headerImageSize /= physicalBufferSize+ = Just $ ErrorImagePhysicalSizeMismatch+ headerImageSize physicalBufferSize++ -- Check that the physical buffer contains enough image data.+ -- It may contain more, as some encoders put padding bytes+ -- on the end.+ | Just calculatedImageSize <- imageSizeFromBitmapInfoV3 header+ , fromIntegral physicalBufferSize < calculatedImageSize+ = Just $ ErrorImageDataTruncated + calculatedImageSize+ (fromIntegral physicalBufferSize)++ -- We only handle uncompresssed images.+ | dib3Compression header /= CompressionRGB+ = Just $ ErrorUnhandledCompressionMode (dib3Compression header)+ | otherwise = Nothing ++-- | Compute the size of the image data from the header.+--+-- * We can't just use the 'dib3ImageSize' field because some encoders+-- set this to zero.+--+-- * We also can't use the physical size of the data in the file because+-- some encoders add zero padding bytes on the end. +--+imageSizeFromBitmapInfoV3 :: BitmapInfoV3 -> Maybe Int+imageSizeFromBitmapInfoV3 header+ | dib3BitCount header == 32+ , dib3Planes header == 1+ , dib3Compression header == CompressionRGB+ = Just $ fromIntegral (dib3Width header * dib3Height header * 4)++ | dib3BitCount header == 24+ , dib3Planes header == 1+ , dib3Compression header == CompressionRGB+ = let imageBytesPerLine = dib3Width header * 3+ tailBytesPerLine = imageBytesPerLine `mod` 4+ padBytesPerLine = if tailBytesPerLine > 0+ then 4 - tailBytesPerLine+ else 0+ in Just $ fromIntegral (dib3Height header * imageBytesPerLine + padBytesPerLine)++ | otherwise+ = Nothing
Codec/BMP/BitmapInfoV4.hs view
@@ -4,7 +4,8 @@ ( BitmapInfoV4 (..) , CIEXYZ (..) , sizeOfBitmapInfoV4- , checkBitmapInfoV4)+ , checkBitmapInfoV4+ , imageSizeFromBitmapInfoV4) where import Codec.BMP.Error import Codec.BMP.CIEXYZ@@ -93,27 +94,43 @@ -- and the uncompressed 32bit RGBA format. -- checkBitmapInfoV4 :: BitmapInfoV4 -> Word32 -> Maybe Error-checkBitmapInfoV4 headerV4 expectedImageSize+checkBitmapInfoV4 headerV4 physicalBufferSize + -- We only handle a single color plane. | dib3Planes headerV3 /= 1- = Just $ ErrorUnhandledPlanesCount - $ fromIntegral $ dib3Planes headerV3+ = Just $ ErrorUnhandledPlanesCount $ dib3Planes headerV3 - | dib3ImageSize headerV3 /= 0- , dib3ImageSize headerV3 /= expectedImageSize- = Just $ ErrorUnexpectedImageSize- - | expectedImageSize `mod` dib3Height headerV3 /= 0- = Just $ ErrorLacksWholeNumberOfLines+ -- We only handle 24 and 32 bit images.+ | dib3BitCount headerV3 /= 24+ , dib3BitCount headerV3 /= 32+ = Just $ ErrorUnhandledColorDepth $ dib3BitCount headerV3 + -- If the image size field in the header is non-zero, + -- then it must be the same as physical size of the image buffer.+ | headerImageSize <- dib3ImageSize headerV3+ , headerImageSize /= 0+ , fromIntegral headerImageSize /= physicalBufferSize+ = Just $ ErrorImagePhysicalSizeMismatch+ headerImageSize physicalBufferSize++ -- Check that the physical buffer contains enough image data.+ -- It may contain more, as some encoders put padding bytes+ -- on the end.+ | Just calculatedImageSize <- imageSizeFromBitmapInfoV4 headerV4+ , fromIntegral physicalBufferSize < calculatedImageSize+ = Just $ ErrorImageDataTruncated + calculatedImageSize+ (fromIntegral physicalBufferSize)++ -- Check for valid compression modes ---- - -- uncompressed 24bit RGB- | dib3BitCount headerV3 == 24 - , dib3Compression headerV3 == CompressionRGB- = Nothing+ -- uncompressed 32bit RGBA stated as CompressionRGB.+ | dib3BitCount headerV3 == 32+ , dib3Compression headerV3 == CompressionRGB+ = Nothing - -- uncompressed 32bit RGBA+ -- uncompressed 32bit RGBA stated as CompressionBitFields. | dib3BitCount headerV3 == 32 , dib3Compression headerV3 == CompressionBitFields , dib4AlphaMask headerV4 == 0xff000000@@ -121,11 +138,53 @@ , dib4GreenMask headerV4 == 0x0000ff00 , dib4BlueMask headerV4 == 0x000000ff = Nothing++ -- uncompressed 24bit RGB+ | dib3BitCount headerV3 == 24 + , dib3Compression headerV3 == CompressionRGB+ = Nothing -- Some unsupported compression mode ---- | otherwise- = Just $ ErrorUnhandledCompressionMode+ = Just $ ErrorUnhandledCompressionMode (dib3Compression headerV3) where headerV3 = dib4InfoV3 headerV4- - +++-- | Compute the size of the image data from the header.+--+-- * We can't just use the 'dib3ImageSize' field because some encoders+-- set this to zero.+--+-- * We also can't use the physical size of the data in the file because+-- some encoders add zero padding bytes on the end. +imageSizeFromBitmapInfoV4 :: BitmapInfoV4 -> Maybe Int+imageSizeFromBitmapInfoV4 headerV4+ | dib3BitCount headerV3 == 32+ , dib3Planes headerV3 == 1+ , dib3Compression headerV3 == CompressionRGB+ = Just $ fromIntegral (dib3Width headerV3 * dib3Height headerV3 * 4)++ | dib3BitCount headerV3 == 32+ , dib3Planes headerV3 == 1+ , dib3Compression headerV3 == CompressionBitFields+ , dib4AlphaMask headerV4 == 0xff000000+ , dib4RedMask headerV4 == 0x00ff0000+ , dib4GreenMask headerV4 == 0x0000ff00+ , dib4BlueMask headerV4 == 0x000000ff+ = Just $ fromIntegral (dib3Width headerV3 * dib3Height headerV3 * 4) ++ | dib3BitCount headerV3 == 24+ , dib3Planes headerV3 == 1+ , dib3Compression headerV3 == CompressionRGB+ = let imageBytesPerLine = dib3Width headerV3 * 3+ tailBytesPerLine = imageBytesPerLine `mod` 4+ padBytesPerLine = if tailBytesPerLine > 0+ then 4 - tailBytesPerLine+ else 0+ in Just $ fromIntegral (dib3Height headerV3 * imageBytesPerLine + padBytesPerLine)++ | otherwise+ = Nothing++ where headerV3 = dib4InfoV3 headerV4
Codec/BMP/BitmapInfoV5.hs view
@@ -2,7 +2,8 @@ module Codec.BMP.BitmapInfoV5 ( BitmapInfoV5 (..) , sizeOfBitmapInfoV5- , checkBitmapInfoV5)+ , checkBitmapInfoV5+ , imageSizeFromBitmapInfoV5) where import Codec.BMP.Error import Codec.BMP.BitmapInfoV4@@ -64,5 +65,11 @@ checkBitmapInfoV5 :: BitmapInfoV5 -> Word32 -> Maybe Error checkBitmapInfoV5 header expectedImageSize = checkBitmapInfoV4 (dib5InfoV4 header) expectedImageSize+++-- | Compute the size of the image data from the header.+imageSizeFromBitmapInfoV5 :: BitmapInfoV5 -> Maybe Int+imageSizeFromBitmapInfoV5 + = imageSizeFromBitmapInfoV4 . dib5InfoV4
+ Codec/BMP/Compression.hs view
@@ -0,0 +1,43 @@+{-# OPTIONS_HADDOCK hide #-}+module Codec.BMP.Compression+ (Compression(..))+where+import Data.Word+import Data.Binary+import Data.Binary.Get +import Data.Binary.Put+++data Compression+ = CompressionRGB+ | CompressionRLE8+ | CompressionRLE4+ | CompressionBitFields+ | CompressionJPEG+ | CompressionPNG+ | CompressionUnknown Word32+ deriving (Show, Eq)+++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+
Codec/BMP/Error.hs view
@@ -2,23 +2,59 @@ module Codec.BMP.Error (Error(..)) where+import Codec.BMP.Compression import Data.Word -- | Things that can go wrong when loading a BMP file. data Error- = ErrorReadOfFileHeaderFailed- | ErrorReadOfImageHeaderFailed- | ErrorReadOfImageDataFailed- | ErrorBadMagic Word16++ -- | Magic number was not at the start of the file, + -- so this probably isn't a BMP file.+ = ErrorBadMagic Word16++ -- | File is too short to contain a file header.+ | ErrorFileHeaderTruncated++ -- | File is too short to contain an image header.+ | ErrorImageHeaderTruncated++ -- | File is too short to contain the image data.+ | ErrorImageDataTruncated+ { errorBytesNeeded :: Int+ , errorBytesAvailable :: Int }++ -- | Reserved fields should be zero. | ErrorReservedFieldNotZero- | ErrorDodgyFileHeaderFieldOffset Int- | ErrorDodgyFileHeaderFieldFileSize Int- | ErrorFileIsTruncated- | ErrorUnhandledBitmapHeaderSize Int- | ErrorUnhandledPlanesCount Int- | ErrorUnhandledColorDepth Int++ -- | The offset to the image data from the file header doesn't+ -- point anywhere sensible.+ | ErrorDodgyFileHeaderFieldOffset+ { errorFileHeaderOffset :: Word32 }++ -- | We handle V3 V4 and V5 image headers, but the size of + -- the header indicates it has some other format.+ | ErrorUnhandledBitmapHeaderSize+ { errorBitmapHeaderSize :: Word32 }++ -- | We only handle single color planes.+ | ErrorUnhandledPlanesCount+ { errorPlanesCount :: Word16 }++ -- | We only handle 24 and 32 bit images.+ | ErrorUnhandledColorDepth+ { errorColorDepth :: Word16 }++ -- | We only handle uncompressed images. | ErrorUnhandledCompressionMode- | ErrorUnexpectedImageSize- | ErrorLacksWholeNumberOfLines+ { errorCompression :: Compression}++ -- | Mismatch between the image size stated in the header+ -- and that which is calculuated from the other fields.+ | ErrorImagePhysicalSizeMismatch + { errorImageSizeFromHeader :: Word32+ , errorImageSizeOfBuffer :: Word32 }++ -- | Something went wrong in the library.+ | ErrorInternalErrorPleaseReport deriving (Eq, Show)
Codec/BMP/FileHeader.hs view
@@ -70,10 +70,11 @@ | fileHeaderType header /= bmpMagic = Just $ ErrorBadMagic (fileHeaderType header) - | fileHeaderFileSize header - < fromIntegral (sizeOfFileHeader + sizeOfBitmapInfoV3)- = Just $ ErrorDodgyFileHeaderFieldFileSize - $ fromIntegral $ fileHeaderFileSize header+ | fileHeaderFileSize header < fromIntegral sizeOfFileHeader+ = Just $ ErrorFileHeaderTruncated++ | fileHeaderFileSize header < fromIntegral (sizeOfFileHeader + sizeOfBitmapInfoV3)+ = Just $ ErrorImageHeaderTruncated | fileHeaderReserved1 header /= 0 = Just $ ErrorReservedFieldNotZero
Codec/BMP/Unpack.hs view
@@ -26,7 +26,7 @@ in case bitCount of 24 -> packRGB24ToRGBA32 width height (bmpRawImageData bmp) 32 -> packRGB32ToRGBA32 width height (bmpRawImageData bmp)- _ -> error "Codec.BMP.unpackBMPToRGBA32: unhandled bitcount"+ _ -> error "Codec.BMP.unpackBMPToRGBA32: unhandled bitcount." -- | Unpack raw, uncompressed 24 bit BMP image data to a string of RGBA component values.@@ -41,13 +41,16 @@ = let bytesPerLine = BS.length str `div` height padPerLine = bytesPerLine - width * 3 sizeDest = width * height * 4- in if height * (width * 3 + padPerLine) /= BS.length str- then error "Codec.BMP.unpackRGB24ToRGBA32: given image dimensions don't match input data."++ -- 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." else unsafePerformIO $ allocaBytes sizeDest $ \bufDest -> BS.unsafeUseAsCString str $ \bufSrc -> do packRGB24ToRGBA32' width height padPerLine (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.@@ -89,8 +92,8 @@ 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."+ in if BS.length str < sizeDest+ then error "Codec.BMP.packRGB24ToRGBA32: image data is truncated." else unsafePerformIO $ allocaBytes sizeDest $ \bufDest -> BS.unsafeUseAsCString str $ \bufSrc ->
bmp.cabal view
@@ -1,5 +1,5 @@ Name: bmp-Version: 1.1.2.1+Version: 1.2.0.1 License: MIT License-file: LICENSE Author: Ben Lippmeier@@ -16,7 +16,7 @@ Synopsis: Read and write uncompressed BMP image files. -Tested-with: GHC == 6.12.1+Tested-with: GHC == 7.2 Library Build-Depends: @@ -25,13 +25,14 @@ binary >= 0.5.0.2 && < 0.6.0.0 ghc-options:- -Wall -fno-warn-missing-signatures -fno-warn-missing-fields+ -Wall -fno-warn-missing-signatures Exposed-modules: Codec.BMP Other-modules: Codec.BMP.Base+ Codec.BMP.Compression Codec.BMP.BitmapInfo Codec.BMP.BitmapInfoV3 Codec.BMP.BitmapInfoV4