netpbm 0.3.0 → 1.0.0

raw patch · 3 files changed

+72/−35 lines, 3 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• netpbm.cabal +8/−2
• src/Graphics/Netpbm.hs +42/−32
• test/Main.hs +22/−1

@@ -1,5 +1,5 @@ name:          netpbm-version:       0.3.0+version:       1.0.0 license:       MIT copyright:     2013 Niklas Hambüchen <mail@nh2.me> author:        Niklas Hambüchen <mail@nh2.me>@@ -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  

@@ -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 } }

@@ -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