bmp 1.2.4.1 → 1.2.5.1
raw patch · 6 files changed
+151/−49 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Codec.BMP: packRGBA32ToBMP24 :: Int -> Int -> ByteString -> BMP
+ Codec.BMP: packRGBA32ToBMP32 :: Int -> Int -> ByteString -> BMP
Files
- Codec/BMP.hs +11/−16
- Codec/BMP/BitmapInfoV3.hs +1/−2
- Codec/BMP/BitmapInfoV4.hs +2/−3
- Codec/BMP/Pack.hs +133/−25
- Codec/BMP/Unpack.hs +1/−2
- bmp.cabal +3/−1
Codec/BMP.hs view
@@ -1,12 +1,9 @@-{-# LANGUAGE ScopedTypeVariables, PatternGuards #-} -- | Reading and writing uncompressed BMP files. ----- Reading works for both uncompressed 24bit RGB and 32bit RGBA--- WindowsV3, WindowsV4 and WindowsV5 formats.+-- Supports 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.@@ -26,22 +23,18 @@ -- -- Release Notes: --+-- > * bmp 1.2.5+-- > Add support for writing uncompressed 32-bit files.+-- >+-- > * bmp 1.2.4+-- > Update to use binary 0.6.+-- > -- > * bmp 1.2.3 -- > Add pure parseBMP / renderBMP API. -- > -- > * bmp 1.2.2 -- > Allow the physical image buffer to be larger than the image -- > size stated in the header, to accept output of foolish Win7 codec.--- >--- > * bmp 1.2.1--- > Fix slow ByteString conversion via lists. --- >--- > * 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. -- module Codec.BMP ( -- * Data Structures@@ -62,7 +55,9 @@ , writeBMP, hPutBMP, renderBMP -- * Pack and Unpack- , packRGBA32ToBMP + , packRGBA32ToBMP+ , packRGBA32ToBMP32+ , packRGBA32ToBMP24 , unpackBMPToRGBA32 , bmpDimensions) where
Codec/BMP/BitmapInfoV3.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE PatternGuards #-} {-# OPTIONS_HADDOCK hide #-} module Codec.BMP.BitmapInfoV3 ( BitmapInfoV3 (..)@@ -82,7 +81,7 @@ let (height, flipped) = if heightI32 < 0 then (fromIntegral (abs heightI32), True)- else (heightW32, False)+ else (heightW32, False) planes <- getWord16le bitc <- getWord16le
Codec/BMP/BitmapInfoV4.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE PatternGuards #-} {-# OPTIONS_HADDOCK hide #-} module Codec.BMP.BitmapInfoV4 ( BitmapInfoV4 (..)@@ -88,7 +87,6 @@ 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,@@ -159,7 +157,8 @@ -- 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. +-- some encoders add zero padding bytes on the end. +-- imageSizeFromBitmapInfoV4 :: BitmapInfoV4 -> Maybe Int imageSizeFromBitmapInfoV4 headerV4 | dib3BitCount headerV3 == 32
Codec/BMP/Pack.hs view
@@ -1,7 +1,8 @@ {-# OPTIONS_HADDOCK hide #-}-{-# LANGUAGE ScopedTypeVariables #-} module Codec.BMP.Pack- (packRGBA32ToBMP)+ ( packRGBA32ToBMP+ , packRGBA32ToBMP24+ , packRGBA32ToBMP32) where import Codec.BMP.Base import Codec.BMP.BitmapInfo@@ -18,36 +19,93 @@ import Prelude as P --- | Pack a string of RGBA component values into a BMP image.+-- | Pack a string of RGBA component values into a 32-bit BMP image.+-- +-- Alias for `packRGBA32ToBMP32`. --+packRGBA32ToBMP+ :: 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 = packRGBA32ToBMP32+{-# INLINE packRGBA32ToBMP #-}+++-- BMP 32 bit -----------------------------------------------------------------+-- | Pack a string of RGBA component values into a 32-bit BMP 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.+packRGBA32ToBMP32+ :: 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++packRGBA32ToBMP32 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: Image dimensions don't match input data."++ | otherwise+ = let imageData = packRGBA32ToBGRA32 width height str+ in packDataToBMP 32 width height imageData+++-- BMP 24 bit -----------------------------------------------------------------+-- | Pack a string of RGBA component values into a 24-bit BMP image,+-- discarding the alpha channel of the source data. ---packRGBA32ToBMP- :: Int -- ^ Width of image (must be positive).- -> Int -- ^ Height of image (must be positive).- -> ByteString -- ^ A string of RGBA component values.+-- * If the given dimensions don't match the input string then `error`.+--+-- * If the width or height fields are negative then `error`.++packRGBA32ToBMP24+ :: 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+ -> BMP++packRGBA32ToBMP24 width height str+ | width < 0 = error "Codec.BMP: Negative width field." - | height < 0+ | height < 0 = error "Codec.BMP: Negative height field." | height * width * 4 /= BS.length str = error "Codec.BMP: Image dimensions don't match input data." | otherwise- = let (imageData, _) = packRGBA32ToRGB24 width height str+ = let imageData = packRGBA32ToBGR24 width height str+ in packDataToBMP 24 width height imageData - fileHeader++-- data -----------------------------------------------------------------------+-- | Wrap pre-packed image data into BMP image.+--+packDataToBMP+ :: Int -- ^ Number of bits per pixel+ -> 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+ +packDataToBMP bits width height imageData+ = let fileHeader = FileHeader { fileHeaderType = bmpMagic @@ -68,7 +126,7 @@ , dib3Height = fromIntegral height , dib3HeightFlipped = False , dib3Planes = 1- , dib3BitCount = 24+ , dib3BitCount = fromIntegral bits , dib3Compression = CompressionRGB , dib3ImageSize = fromIntegral $ BS.length imageData @@ -98,15 +156,15 @@ ++ show errs --packRGBA32ToRGB24 +-------------------------------------------------------------------------------+-- | Pack RGBA data into the format need by BMP image data.+packRGBA32ToBGR24 :: 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.+ -> ByteString -- output bytestring. -packRGBA32ToRGB24 width height str+packRGBA32ToBGR24 width height str | height * width * 4 /= BS.length str = error "Codec.BMP: Image dimensions don't match input data." @@ -120,13 +178,13 @@ in unsafePerformIO $ allocaBytes sizeDest $ \bufDest -> BS.unsafeUseAsCString str $ \bufSrc ->- do packRGBA32ToRGB24' width height padPerLine+ do packRGBA32ToBGR24' width height padPerLine (castPtr bufSrc) (castPtr bufDest) bs <- packCStringLen (bufDest, sizeDest)- return (bs, padPerLine)+ return bs -packRGBA32ToRGB24' width height pad ptrSrc ptrDest+packRGBA32ToBGR24' width height pad ptrSrc ptrDest = go 0 0 0 0 where go posX posY oSrc oDest@@ -152,4 +210,54 @@ pokeByteOff ptrDest (oDest + 2) red go (posX + 1) posY (oSrc + 4) (oDest + 3)+++-------------------------------------------------------------------------------+-- | Pack RGBA data into the byte order needed by BMP image data.+packRGBA32ToBGRA32 + :: Int -- ^ Width of image.+ -> Int -- ^ Height of image.+ -> ByteString -- ^ Source bytestring holding the image data. + -> ByteString ++packRGBA32ToBGRA32 width height str+ | height * width * 4 /= BS.length str+ = error "Codec.BMP: Image dimensions don't match input data."++ | otherwise+ = let sizeDest = height * (width * 4)+ in unsafePerformIO+ $ allocaBytes sizeDest $ \bufDest ->+ BS.unsafeUseAsCString str $ \bufSrc ->+ do packRGBA32ToBGRA32' width height+ (castPtr bufSrc) (castPtr bufDest)+ bs <- packCStringLen (bufDest, sizeDest)+ return bs+ +packRGBA32ToBGRA32' width height ptrSrc ptrDest+ = go 0 0 0 0+ where+ go posX posY oSrc oDest++ -- advance to the next line.+ | posX == width+ = do go 0 (posY + 1) oSrc oDest+ + -- we've finished the image.+ | posY == height+ = return ()+ + -- process a pixel+ | otherwise+ = do red :: Word8 <- peekByteOff ptrSrc (oSrc + 0)+ green :: Word8 <- peekByteOff ptrSrc (oSrc + 1)+ blue :: Word8 <- peekByteOff ptrSrc (oSrc + 2)+ alpha :: Word8 <- peekByteOff ptrSrc (oSrc + 3)+ + pokeByteOff ptrDest (oDest + 0) blue+ pokeByteOff ptrDest (oDest + 1) green+ pokeByteOff ptrDest (oDest + 2) red+ pokeByteOff ptrDest (oDest + 3) alpha+ + go (posX + 1) posY (oSrc + 4) (oDest + 4)
Codec/BMP/Unpack.hs view
@@ -1,5 +1,4 @@ {-# OPTIONS_HADDOCK hide #-}-{-# LANGUAGE ScopedTypeVariables #-} module Codec.BMP.Unpack (unpackBMPToRGBA32) where @@ -101,7 +100,6 @@ go_line (posX + 1) posY (oSrc + 3) (oDst + 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. @@ -124,6 +122,7 @@ 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.
bmp.cabal view
@@ -1,5 +1,5 @@ Name: bmp-Version: 1.2.4.1+Version: 1.2.5.1 License: MIT License-file: LICENSE Author: Ben Lippmeier@@ -30,6 +30,8 @@ extensions: BangPatterns+ ScopedTypeVariables+ PatternGuards exposed-modules: Codec.BMP