diff --git a/Codec/BMP/Base.hs b/Codec/BMP/Base.hs --- a/Codec/BMP/Base.hs +++ b/Codec/BMP/Base.hs @@ -8,9 +8,9 @@ -- | 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 --- of 4 bytes in length. +-- 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 of 4 bytes in length. data BMP = BMP { bmpFileHeader :: FileHeader diff --git a/Codec/BMP/BitmapInfo.hs b/Codec/BMP/BitmapInfo.hs --- a/Codec/BMP/BitmapInfo.hs +++ b/Codec/BMP/BitmapInfo.hs @@ -9,7 +9,7 @@ import Data.Binary import Data.Binary.Get --- Image Headers ---------------------------------------------------------------------------------- +-- Image Headers -------------------------------------------------------------- -- | A wrapper for the various image header types. -- data BitmapInfo diff --git a/Codec/BMP/BitmapInfoV3.hs b/Codec/BMP/BitmapInfoV3.hs --- a/Codec/BMP/BitmapInfoV3.hs +++ b/Codec/BMP/BitmapInfoV3.hs @@ -12,7 +12,7 @@ import Data.Binary import Data.Binary.Get import Data.Binary.Put - +import Debug.Trace -- | Device Independent Bitmap (DIB) header for Windows V3. data BitmapInfoV3 @@ -36,10 +36,11 @@ , dib3Compression :: Compression -- | (+20) Size of raw image data. - -- Some encoders set this to zero, so we need to calculate it based on the - -- overall file size. + -- Some encoders set this to zero, so we need to calculate it based + -- on the overall file size. -- - -- If it is non-zero then we check it matches the file size - header size. + -- If it is non-zero then we check it matches the file size - header + -- size. , dib3ImageSize :: Word32 -- | (+24) Prefered resolution in pixels per meter, along the X axis. @@ -117,16 +118,18 @@ = Just $ ErrorUnhandledColorDepth $ dib3BitCount header -- 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. + -- then it must be less than the physical size of the image buffer. + -- The buffer may be larger than the size of the image stated + -- in the header, because some encoders add padding to the end. | headerImageSize <- dib3ImageSize header , headerImageSize /= 0 - , fromIntegral headerImageSize /= physicalBufferSize + , physicalBufferSize < headerImageSize = 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. + -- The buffer may be larger than the size of the image stated + -- in the header, because some encoders add padding to the end. | Just calculatedImageSize <- imageSizeFromBitmapInfoV3 header , fromIntegral physicalBufferSize < calculatedImageSize = Just $ ErrorImageDataTruncated @@ -134,7 +137,8 @@ (fromIntegral physicalBufferSize) -- We only handle uncompresssed images. - | dib3Compression header /= CompressionRGB + | dib3Compression header /= CompressionRGB + && dib3Compression header /= CompressionBitFields = Just $ ErrorUnhandledCompressionMode (dib3Compression header) | otherwise @@ -153,19 +157,22 @@ imageSizeFromBitmapInfoV3 header | dib3BitCount header == 32 , dib3Planes header == 1 - , dib3Compression header == CompressionRGB + , dib3Compression header == CompressionRGB + || dib3Compression header == CompressionBitFields = Just $ fromIntegral (dib3Width header * dib3Height header * 4) | dib3BitCount header == 24 , dib3Planes header == 1 - , dib3Compression header == CompressionRGB + , dib3Compression header == CompressionRGB + || dib3Compression header == CompressionBitFields = 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) + in Just $ fromIntegral + $ dib3Height header * imageBytesPerLine + padBytesPerLine | otherwise - = Nothing + = trace (show header) $ Nothing diff --git a/Codec/BMP/BitmapInfoV4.hs b/Codec/BMP/BitmapInfoV4.hs --- a/Codec/BMP/BitmapInfoV4.hs +++ b/Codec/BMP/BitmapInfoV4.hs @@ -30,9 +30,9 @@ -- | 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. + -- | 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. @@ -106,10 +106,12 @@ = 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. + -- then it must be less than the physical size of the image buffer. + -- The buffer may be larger than the size of the image stated + -- in the header, because some encoders add padding to the end. | headerImageSize <- dib3ImageSize headerV3 , headerImageSize /= 0 - , fromIntegral headerImageSize /= physicalBufferSize + , physicalBufferSize < headerImageSize = Just $ ErrorImagePhysicalSizeMismatch headerImageSize physicalBufferSize @@ -182,7 +184,8 @@ padBytesPerLine = if tailBytesPerLine > 0 then 4 - tailBytesPerLine else 0 - in Just $ fromIntegral (dib3Height headerV3 * imageBytesPerLine + padBytesPerLine) + in Just $ fromIntegral + $ dib3Height headerV3 * imageBytesPerLine + padBytesPerLine | otherwise = Nothing diff --git a/Codec/BMP/BitmapInfoV5.hs b/Codec/BMP/BitmapInfoV5.hs --- a/Codec/BMP/BitmapInfoV5.hs +++ b/Codec/BMP/BitmapInfoV5.hs @@ -20,7 +20,8 @@ -- | Rendering intent for the bitmap. , dib5Intent :: Word32 - -- | Offset (in bytes) from the beginning of the header to the start of the profile data. + -- | 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. diff --git a/Codec/BMP/CIEXYZ.hs b/Codec/BMP/CIEXYZ.hs --- a/Codec/BMP/CIEXYZ.hs +++ b/Codec/BMP/CIEXYZ.hs @@ -7,7 +7,8 @@ import Data.Binary.Get import Data.Binary.Put --- | Contains the XYZ coordinates of a specific color in a specified color space. +-- | Contains the XYZ coordinates of a specific color in a specified color +-- space. data CIEXYZ = CIEXYZ Word32 Word32 Word32 deriving Show diff --git a/Codec/BMP/FileHeader.hs b/Codec/BMP/FileHeader.hs --- a/Codec/BMP/FileHeader.hs +++ b/Codec/BMP/FileHeader.hs @@ -12,7 +12,7 @@ import Data.Binary.Put --- File Headers ----------------------------------------------------------------------------------- +-- File Headers --------------------------------------------------------------- -- | BMP file header. data FileHeader = FileHeader @@ -71,10 +71,12 @@ | fileHeaderType header /= bmpMagic = Just $ ErrorBadMagic (fileHeaderType header) - | fileHeaderFileSize header < fromIntegral sizeOfFileHeader + | fileHeaderFileSize header + < fromIntegral sizeOfFileHeader = Just $ ErrorFileHeaderTruncated - | fileHeaderFileSize header < fromIntegral (sizeOfFileHeader + sizeOfBitmapInfoV3) + | fileHeaderFileSize header + < fromIntegral (sizeOfFileHeader + sizeOfBitmapInfoV3) = Just $ ErrorImageHeaderTruncated | fileHeaderReserved1 header /= 0 @@ -83,7 +85,8 @@ | fileHeaderReserved2 header /= 0 = Just $ ErrorReservedFieldNotZero - | fromIntegral (fileHeaderOffset header) /= sizeOfFileHeader + sizeOfBitmapInfoV3 + | fromIntegral (fileHeaderOffset header) + /= sizeOfFileHeader + sizeOfBitmapInfoV3 = Just $ ErrorDodgyFileHeaderFieldOffset $ fromIntegral $ fileHeaderOffset header diff --git a/Codec/BMP/Pack.hs b/Codec/BMP/Pack.hs --- a/Codec/BMP/Pack.hs +++ b/Codec/BMP/Pack.hs @@ -19,11 +19,13 @@ -- | 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. +-- 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. - -> ByteString -- ^ A string of RGBA component values. Must have length (@width * height * 4@) + -> ByteString -- ^ A string of RGBA component values. + -- Must have length (@width * height * 4@) -> BMP packRGBA32ToBMP width height str diff --git a/bmp.cabal b/bmp.cabal --- a/bmp.cabal +++ b/bmp.cabal @@ -1,5 +1,5 @@ Name: bmp -Version: 1.2.1.1 +Version: 1.2.2.1 License: MIT License-file: LICENSE Author: Ben Lippmeier