diff --git a/JuicyPixels.cabal b/JuicyPixels.cabal --- a/JuicyPixels.cabal +++ b/JuicyPixels.cabal @@ -1,5 +1,5 @@ Name: JuicyPixels -Version: 3.2.3.2 +Version: 3.2.4 Synopsis: Picture loading/serialization (in png, jpeg, bitmap, gif, tga, tiff and radiance) Description: <> @@ -18,8 +18,8 @@ -- Constraint on the version of Cabal needed to build this package. Cabal-version: >= 1.10 -extra-source-files: changelog, docimages/*.png -extra-doc-files: docimages/*.png +extra-source-files: changelog, docimages/*.png, docimages/*.svg +extra-doc-files: docimages/*.png, docimages/*.svg Source-Repository head Type: git @@ -28,7 +28,7 @@ Source-Repository this Type: git Location: git://github.com/Twinside/Juicy.Pixels.git - Tag: v3.2.3.2 + Tag: v3.2.4 Flag Mmap Description: Enable the file loading via mmap (memory map) diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,5 +1,8 @@ -*-change-log-*- +v3.2.4 April 2015 + * Adding: Traversals compatible with the lens library. + v3.2.3.2 April 2015 * Bumping: zlib max bound diff --git a/docimages/pixelgraph.svg b/docimages/pixelgraph.svg new file mode 100644 --- /dev/null +++ b/docimages/pixelgraph.svg @@ -0,0 +1,264 @@ + + + + + + +pixelGraphic + + +PixelRGB8 + +PixelRGB8 + + +PixelRGBA8 + +PixelRGBA8 + + +PixelRGB8->PixelRGBA8 + + +promotePixel + + +PixelRGBF + +PixelRGBF + + +PixelRGB8->PixelRGBF + + +promotePixel + + +Pixel8 + +Pixel8 + + +PixelRGB8->Pixel8 + + +computeLuma + + +PixelCMYK8 + +PixelCMYK8 + + +PixelRGB8->PixelCMYK8 + + +convertPixel + + +PixelYCbCr8 + +PixelYCbCr8 + + +PixelRGB8->PixelYCbCr8 + + +convertPixel + + +PixelRGB16 + +PixelRGB16 + + +PixelRGBA16 + +PixelRGBA16 + + +PixelRGB16->PixelRGBA16 + + +promotePixel + + +Pixel16 + +Pixel16 + + +PixelRGB16->Pixel16 + + +computeLuma + + +PixelCMYK16 + +PixelCMYK16 + + +PixelRGB16->PixelCMYK16 + + +convertPixel + + +PixelRGBA16->PixelRGB16 + + +dropTransparency + + +PixelRGBA8->PixelRGB8 + + +dropTransparency + + +PixelRGBA8->Pixel8 + + +computeLuma + + +PixelF + +PixelF + + +PixelRGBF->PixelF + + +computeLuma + + +PixelYA16 + +PixelYA16 + + +PixelYA16->PixelRGBA16 + + +promotePixel + + +PixelYA16->Pixel16 + + +dropTransparency + + +PixelYA8 + +PixelYA8 + + +PixelYA8->PixelRGB8 + + +promotePixel + + +PixelYA8->PixelRGBA8 + + +promotePixel + + +PixelYA8->Pixel8 + + +dropTransparency + + +PixelYA8->Pixel8 + + +computeLuma + + +PixelF->PixelRGBF + + +promotePixel + + +Pixel16->PixelRGB16 + + +promotePixel + + +Pixel16->PixelRGBA16 + + +promotePixel + + +Pixel16->PixelYA16 + + +promotePixel + + +Pixel8->PixelRGB8 + + +promotePixel + + +Pixel8->PixelRGBA8 + + +promotePixel + + +Pixel8->PixelYA8 + + +promotePixel + + +Pixel8->PixelF + + +promotePixel + + +Pixel8->Pixel16 + + +promotePixel + + +PixelCMYK16->PixelRGB16 + + +convertPixel + + +PixelCMYK8->PixelRGB8 + + +convertPixel + + +PixelYCbCr8->PixelRGB8 + + +convertPixel + + +PixelYCbCr8->Pixel8 + + +computeLuma + + + diff --git a/src/Codec/Picture.hs b/src/Codec/Picture.hs --- a/src/Codec/Picture.hs +++ b/src/Codec/Picture.hs @@ -20,6 +20,11 @@ , generateFoldImage , withImage + -- * Lens compatibility + , Traversal + , imagePixels + , imageIPixels + -- * Generic image writing , saveBmpImage , saveJpgImage diff --git a/src/Codec/Picture/Types.hs b/src/Codec/Picture/Types.hs --- a/src/Codec/Picture/Types.hs +++ b/src/Codec/Picture/Types.hs @@ -25,6 +25,11 @@ , thawImage , unsafeThawImage + -- ** Image Lenses + , Traversal + , imagePixels + , imageIPixels + -- ** Pixel types , Pixel8 , Pixel16 @@ -95,12 +100,13 @@ #if !MIN_VERSION_base(4,8,0) import Data.Monoid( Monoid, mempty ) +import Control.Applicative( Applicative, pure, (<*>), (<$>) ) #endif import Data.Monoid( (<>) ) import Control.Monad( foldM, liftM, ap ) import Control.DeepSeq( NFData( .. ) ) -import Control.Monad.ST( runST ) +import Control.Monad.ST( ST, runST ) import Control.Monad.Primitive ( PrimMonad, PrimState ) import Foreign.ForeignPtr( castForeignPtr ) import Foreign.Storable ( Storable ) @@ -912,6 +918,81 @@ -- safe because newArray can't be referenced as a mutable array -- outside of this where block V.unsafeFreeze newArr + + +-- | Helpers to embed a rankNTypes inside an Applicative +newtype GenST a = GenST { genAction :: forall s. ST s (M.STVector s a) } + +-- | Traversal type matching the definition in the Lens package. +type Traversal s t a b = + forall f. Applicative f => (a -> f b) -> s -> f t + +writePx :: Pixel px + => Int -> GenST (PixelBaseComponent px) -> px -> GenST (PixelBaseComponent px) +{-# INLINE writePx #-} +writePx idx act px = GenST $ do + vec <- genAction act + unsafeWritePixel vec idx px + return vec + +freezeGenST :: Pixel px + => Int -> Int -> GenST (PixelBaseComponent px) -> Image px +freezeGenST w h act = + Image w h (runST (genAction act >>= V.unsafeFreeze)) + +-- | Traversal in "raster" order, from left to right the top to bottom. +-- This traversal is matching pixelMap in spirit. +-- +-- Since 3.2.4 +imagePixels :: forall pxa pxb. (Pixel pxa, Pixel pxb) + => Traversal (Image pxa) (Image pxb) pxa pxb +{-# INLINE imagePixels #-} +imagePixels f Image { imageWidth = w, imageHeight = h, imageData = vec } = + freezeGenST w h <$> pixels + where + sourceComponentCount = componentCount (undefined :: pxa) + destComponentCount = componentCount (undefined :: pxb) + + maxi = w * h * sourceComponentCount + pixels = + go (pure $ GenST $ M.new (w * h * destComponentCount)) 0 0 + + go act readIdx _ | readIdx >= maxi = act + go act readIdx writeIdx = + go newAct (readIdx + sourceComponentCount) (writeIdx + destComponentCount) + where + px = f (unsafePixelAt vec readIdx) + newAct = writePx writeIdx <$> act <*> px + +-- | Traversal providing the pixel position with it's value. +-- The traversal in raster order, from lef to right, then top +-- to bottom. The traversal match pixelMapXY in spirit. +-- +-- Since 3.2.4 +imageIPixels :: forall pxa pxb. (Pixel pxa, Pixel pxb) + => Traversal (Image pxa) (Image pxb) (Int, Int, pxa) pxb +{-# INLINE imageIPixels #-} +imageIPixels f Image { imageWidth = w, imageHeight = h, imageData = vec } = + freezeGenST w h <$> pixels + where + sourceComponentCount = componentCount (undefined :: pxa) + destComponentCount = componentCount (undefined :: pxb) + + pixels = + lineMapper (pure $ GenST $ M.new (w * h * destComponentCount)) 0 0 0 + + lineMapper act _ _ y | y >= h = act + lineMapper act readIdxLine writeIdxLine y = + go act readIdxLine writeIdxLine 0 + where + go cact readIdx writeIdx x + | x >= w = lineMapper cact readIdx writeIdx $ y + 1 + | otherwise = do + let px = f (x, y, unsafePixelAt vec readIdx) + go (writePx writeIdx <$> cact <*> px) + (readIdx + sourceComponentCount) + (writeIdx + destComponentCount) + (x + 1) -- | Just like `pixelMap` only the function takes the pixel coordinates as -- additional parameters.