diff --git a/netpbm.cabal b/netpbm.cabal --- a/netpbm.cabal +++ b/netpbm.cabal @@ -1,5 +1,5 @@ name: netpbm -version: 0.3.0 +version: 1.0.0 license: MIT copyright: 2013 Niklas Hambüchen author: Niklas Hambüchen @@ -18,7 +18,12 @@ All netpbm image formats are implemented (P1 - P6). . The current implementation parses PPM images at around 10 MB/s on a Core i5-2520M. - + . + CHANGELOG + . + Version 1.0.0 + . + * Use storable instead of unboxed vectors to allow easier integration with Ptr based APIs. source-repository head type: git @@ -56,6 +61,7 @@ , bytestring >= 0.9 , hspec >= 1.3.0.1 , HUnit >= 1.2 + , vector >= 0.7 ghc-options: -Wall diff --git a/src/Graphics/Netpbm.hs b/src/Graphics/Netpbm.hs --- a/src/Graphics/Netpbm.hs +++ b/src/Graphics/Netpbm.hs @@ -39,10 +39,9 @@ import Foreign.Storable.Record as Store import Foreign.Storable (Storable (..)) -import qualified Data.Vector.Unboxed as U -import Data.Vector.Unboxed ((!)) -import qualified Data.Vector.Generic -import qualified Data.Vector.Generic.Mutable as VGM +import qualified Data.Vector.Storable as S +import Data.Vector.Storable ((!)) +import qualified Data.Vector.Storable.Mutable as SM import Data.Vector.Unboxed.Deriving @@ -63,10 +62,11 @@ , ppmData :: PpmPixelData } +-- | Meta information about the image: The exact PPM format and dimensions. data PPMHeader = PPMHeader { - ppmType :: PPMType -, ppmWidth :: Int -, ppmHeight :: Int + ppmType :: !PPMType +, ppmWidth :: !Int +, ppmHeight :: !Int } deriving (Eq, Show) instance Show PPM where @@ -101,27 +101,33 @@ -- | Image data, either 8 or 16 bits. -- TODO rename to PNM -data PpmPixelData = PpmPixelDataRGB8 (U.Vector PpmPixelRGB8) -- ^ For 8-bit PPMs. - | PpmPixelDataRGB16 (U.Vector PpmPixelRGB16) -- ^ For 16-bit PPMs. - | PbmPixelData (U.Vector PbmPixel) -- ^ For 1-bit PBMs. - | PgmPixelData8 (U.Vector PgmPixel8) -- ^ For 8-bit PGMs. - | PgmPixelData16 (U.Vector PgmPixel16) -- ^ For 16-bit PGMs. +data PpmPixelData = PpmPixelDataRGB8 (S.Vector PpmPixelRGB8) -- ^ For 8-bit PPMs. + | PpmPixelDataRGB16 (S.Vector PpmPixelRGB16) -- ^ For 16-bit PPMs. + | PbmPixelData (S.Vector PbmPixel) -- ^ For 1-bit PBMs. + | PgmPixelData8 (S.Vector PgmPixel8) -- ^ For 8-bit PGMs. + | PgmPixelData16 (S.Vector PgmPixel16) -- ^ For 16-bit PGMs. -pixelVectorToList :: (U.Unbox a) => U.Vector a -> [a] -pixelVectorToList = U.toList +-- | Converts a vector of pixels to a list for convenience. +pixelVectorToList :: (Storable a) => S.Vector a -> [a] +pixelVectorToList = S.toList +-- | Converts pixel data to a list of positive `Int`s. +-- +-- How big they can become depends on the bit depth of the pixel data. pixelDataToIntList :: PpmPixelData -> [Int] pixelDataToIntList d = case d of - PpmPixelDataRGB8 v -> concat [ map fromIntegral [r, g, b] | PpmPixelRGB8 r g b <- U.toList v ] - PpmPixelDataRGB16 v -> concat [ map fromIntegral [r, g, b] | PpmPixelRGB16 r g b <- U.toList v ] - PbmPixelData v -> [ if b then 1 else 0 | PbmPixel b <- U.toList v ] - PgmPixelData8 v -> [ fromIntegral x | PgmPixel8 x <- U.toList v ] - PgmPixelData16 v -> [ fromIntegral x | PgmPixel16 x <- U.toList v ] + PpmPixelDataRGB8 v -> concat [ map fromIntegral [r, g, b] | PpmPixelRGB8 r g b <- S.toList v ] + PpmPixelDataRGB16 v -> concat [ map fromIntegral [r, g, b] | PpmPixelRGB16 r g b <- S.toList v ] + PbmPixelData v -> [ if b then 1 else 0 | PbmPixel b <- S.toList v ] + PgmPixelData8 v -> [ fromIntegral x | PgmPixel8 x <- S.toList v ] + PgmPixelData16 v -> [ fromIntegral x | PgmPixel16 x <- S.toList v ] -- * Unbox instance for pixels +-- +-- Not used internally, but an Unbox instance might be convenient for users. derivingUnbox "PpmPixelRGB8" [t| PpmPixelRGB8 -> (Word8, Word8, Word8) |] @@ -316,9 +322,9 @@ raster <- case maxColorVal of -- 1 or 2 bytes per pixel -- Parse pixel data into vector, making sure that words don't exceed maxColorVal m | m < 256 -> let v = word8max (fromIntegral m) - in PpmPixelDataRGB8 <$> U.replicateM (height * width) (PpmPixelRGB8 <$> v <*> v <*> v) + in PpmPixelDataRGB8 <$> S.replicateM (height * width) (PpmPixelRGB8 <$> v <*> v <*> v) m | otherwise -> let v = word16max (fromIntegral m) - in PpmPixelDataRGB16 <$> U.replicateM (height * width) (PpmPixelRGB16 <$> v <*> v <*> v) + in PpmPixelDataRGB16 <$> S.replicateM (height * width) (PpmPixelRGB16 <$> v <*> v <*> v) return $ PPM header raster @@ -338,9 +344,9 @@ raster <- case maxGreyVal of -- 1 or 2 bytes per pixel -- Parse pixel data into vector, making sure that words don't exceed maxGreyVal m | m < 256 -> let v = word8max (fromIntegral m) - in PgmPixelData8 <$> U.replicateM (height * width) (PgmPixel8 <$> v) + in PgmPixelData8 <$> S.replicateM (height * width) (PgmPixel8 <$> v) m | otherwise -> let v = word16max (fromIntegral m) - in PgmPixelData16 <$> U.replicateM (height * width) (PgmPixel16 <$> v) + in PgmPixelData16 <$> S.replicateM (height * width) (PgmPixel16 <$> v) return $ PPM header raster @@ -355,10 +361,10 @@ let widthBytes = (width + 7) // 8 -- Parse pixel data first in into a Word8 vector, then translate to a Bool vector, leaving the don't-cares at the end out. - word8Vector <- U.replicateM (height * widthBytes) anyWord8 + word8Vector <- S.replicateM (height * widthBytes) anyWord8 - let bits = U.create $ do - v <- VGM.replicate (width * height) (PbmPixel False) + let bits = S.create $ do + v <- SM.replicate (width * height) (PbmPixel False) forM_ [0..height-1] $ \row -> forM_ [0..width-1] $ \col -> let i = row * width + col @@ -367,7 +373,7 @@ -- We negate (see "not"), because: -- "1 is black, 0 is white." -- Also, `testBit` indexes from the right (LSB). - in VGM.write v i (PbmPixel . not $ (word8Vector ! i8) `testBit` (7 - bitN)) + in SM.write v i (PbmPixel . not $ (word8Vector ! i8) `testBit` (7 - bitN)) return v return $ PPM header (PbmPixelData bits) @@ -391,7 +397,7 @@ -- "White space in the raster section is ignored." -- Don't allow it *after* so that we can check if there is a whitespace between raster and optional junk. -- I use `generateM` here instead of fromList . (`sepBy` [whitespace]) because I believe it's faster. - bits <- U.replicateM n (A.takeWhile isSpace_w8 *> asciiBit) + bits <- S.replicateM n (A.takeWhile isSpace_w8 *> asciiBit) -- From the spec (who the heck can even come up with this): -- "You can put any junk you want after the raster, if it starts with a white space character." @@ -428,8 +434,8 @@ -- TODO size-check the int by first putting it in Word64 and limiting decimal length raster <- case maxGreyVal of -- 1 or 2 bytes per pixel -- Parse pixel data into vector, making sure that words don't exceed maxGreyVal - m | m < 256 -> PgmPixelData8 <$> U.replicateM n (A.takeWhile isSpace_w8 *> (PgmPixel8 <$> decimal)) - _ -> PgmPixelData16 <$> U.replicateM n (A.takeWhile isSpace_w8 *> (PgmPixel16 <$> decimal)) + m | m < 256 -> PgmPixelData8 <$> S.replicateM n (A.takeWhile isSpace_w8 *> (PgmPixel8 <$> decimal)) + _ -> PgmPixelData16 <$> S.replicateM n (A.takeWhile isSpace_w8 *> (PgmPixel16 <$> decimal)) option () (A.takeWhile1 isSpace_w8 *> takeLazyByteString *> pure ()) @@ -458,8 +464,8 @@ -- TODO size-check the int by first putting it in Word64 and limiting decimal length raster <- case maxColorVal of -- 1 or 2 bytes per pixel -- Parse pixel data into vector, making sure that words don't exceed maxColorVal - m | m < 256 -> PpmPixelDataRGB8 <$> U.replicateM n (PpmPixelRGB8 <$> d8 <*> d8 <*> d8 ) - _ -> PpmPixelDataRGB16 <$> U.replicateM n (PpmPixelRGB16 <$> d16 <*> d16 <*> d16) + m | m < 256 -> PpmPixelDataRGB8 <$> S.replicateM n (PpmPixelRGB8 <$> d8 <*> d8 <*> d8 ) + _ -> PpmPixelDataRGB16 <$> S.replicateM n (PpmPixelRGB16 <$> d16 <*> d16 <*> d16) option () (A.takeWhile1 isSpace_w8 *> takeLazyByteString *> pure ()) @@ -539,3 +545,7 @@ Done rest images -> Right (images, Just rest) Partial _ -> error "parsePPM bug: Got a partial result after end of input" Fail _ cs e -> Left $ e ++ "; contexts: " ++ show cs + + +-- writePPM :: PPM -> ByteString +-- writePPM PPM { ppmHeader = PPMHeader { ppmType } } diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,8 +1,12 @@ {-# LANGUAGE NamedFieldPuns, OverloadedStrings #-} -import qualified Data.ByteString as BS import Control.Applicative import Control.Monad +import qualified Data.ByteString as BS +import qualified Data.ByteString.Internal as BSI +import qualified Data.Vector.Storable as S +import Foreign.Ptr (castPtr) +import Foreign.Marshal.Utils (copyBytes) import Test.Hspec import Test.HUnit @@ -311,6 +315,23 @@ parseTestFile "SIPI-convert-plain.pbm" "a file produced by convert" $ -- convert SIPI.tiff -compress none SIPI-convert-plain.pbm checkSinglePPM P1 (256,256) + + + describe "In-memory format" $ do + + it "represents 8-bit images in rgbrgbrgb... format" $ do + + let d = PpmPixelDataRGB8 $ S.fromList [ PpmPixelRGB8 1 2 3 + , PpmPixelRGB8 4 5 6 + , PpmPixelRGB8 7 8 9 ] + let PpmPixelDataRGB8 vec = d + + bs <- BSI.create 9 $ \bsPtrWord8 -> + S.unsafeWith vec $ \ppmPixelRgb8Ptr -> + copyBytes bsPtrWord8 (castPtr ppmPixelRgb8Ptr) 9 + + bs `shouldBe` "\1\2\3\4\5\6\7\8\9" + -- Some result data