JuicyPixels-extra 0.5.2 → 0.6.0

raw patch · 7 files changed

+159/−41 lines, 7 filesdep ~basebinary-addedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• Codec/Picture/Extra.hs +69/−26
• JuicyPixels-extra.cabal +14/−14
• data-examples/fully-transparent.png binary
• data-examples/macaque-transparent-cropped.png binary
• data-examples/macaque-transparent.png binary
• tests/Codec/Picture/ExtraSpec.hs +71/−1

@@ -1,3 +1,8 @@+## Juicy Pixels Extra 0.6.0++* Added new functions `trim` and `square`. [See PR+  34](https://github.com/mrkkrp/JuicyPixels-extra/pull/34).+ ## Juicy Pixels Extra 0.5.2  * Replacing CPP preprocessing rules with expicit SPECIALIZE pragmas. [See PR

@@ -19,6 +19,7 @@      -- * Cropping     crop,+    trim,      -- * Rotation     flipHorizontally,@@ -30,13 +31,15 @@     -- * Other     beside,     below,+    square,   ) where  import Codec.Picture import qualified Codec.Picture.Types as M import Control.Monad.ST-import Data.List (foldl1')+import Data.List (find, foldl1')+import Data.Maybe (fromMaybe)  -- | Scale an image using bi-linear interpolation. scaleBilinear ::@@ -54,32 +57,32 @@   Image a scaleBilinear width height img@Image {..}   | width <= 0 || height <= 0 =-    generateImage (error "scaleBilinear: absurd") (max 0 width) (max 0 height)+      generateImage (error "scaleBilinear: absurd") (max 0 width) (max 0 height)   | otherwise = runST $ do-    mimg <- M.newMutableImage width height-    let sx, sy :: Float-        sx = fromIntegral imageWidth / fromIntegral width-        sy = fromIntegral imageHeight / fromIntegral height-        go x' y'-          | x' >= width = go 0 (y' + 1)-          | y' >= height = M.unsafeFreezeImage mimg-          | otherwise = do-            let xf = fromIntegral x' * sx-                yf = fromIntegral y' * sy-                x, y :: Int-                x = floor xf-                y = floor yf-                δx = xf - fromIntegral x-                δy = yf - fromIntegral y-                pixelAt' i j =-                  pixelAt img (min (pred imageWidth) i) (min (pred imageHeight) j)-            writePixel mimg x' y' $-              mulp (pixelAt' x y) ((1 - δx) * (1 - δy))-                `addp` mulp (pixelAt' (x + 1) y) (δx * (1 - δy))-                `addp` mulp (pixelAt' x (y + 1)) ((1 - δx) * δy)-                `addp` mulp (pixelAt' (x + 1) (y + 1)) (δx * δy)-            go (x' + 1) y'-    go 0 0+      mimg <- M.newMutableImage width height+      let sx, sy :: Float+          sx = fromIntegral imageWidth / fromIntegral width+          sy = fromIntegral imageHeight / fromIntegral height+          go x' y'+            | x' >= width = go 0 (y' + 1)+            | y' >= height = M.unsafeFreezeImage mimg+            | otherwise = do+                let xf = fromIntegral x' * sx+                    yf = fromIntegral y' * sy+                    x, y :: Int+                    x = floor xf+                    y = floor yf+                    δx = xf - fromIntegral x+                    δy = yf - fromIntegral y+                    pixelAt' i j =+                      pixelAt img (min (pred imageWidth) i) (min (pred imageHeight) j)+                writePixel mimg x' y' $+                  mulp (pixelAt' x y) ((1 - δx) * (1 - δy))+                    `addp` mulp (pixelAt' (x + 1) y) (δx * (1 - δy))+                    `addp` mulp (pixelAt' x (y + 1)) ((1 - δx) * δy)+                    `addp` mulp (pixelAt' (x + 1) (y + 1)) (δx * δy)+                go (x' + 1) y'+      go 0 0 {-# SPECIALIZE scaleBilinear :: Int -> Int -> Image M.PixelRGBA16 -> Image M.PixelRGBA16 #-} {-# SPECIALIZE scaleBilinear :: Int -> Int -> Image M.PixelRGBA8 -> Image M.PixelRGBA8 #-} {-# SPECIALIZE scaleBilinear :: Int -> Int -> Image M.PixelCMYK16 -> Image M.PixelCMYK16 #-}@@ -140,6 +143,25 @@     h = min (imageHeight - y) h' {-# INLINEABLE crop #-} +-- | Trim the completely transparent edges of an image.+--+-- @since 0.6.0+trim :: (Pixel a, Eq (PixelBaseComponent a)) => Image a -> Image a+trim img@Image {..} = crop left top width height img+  where+    isInvisible p = pixelOpacity p == 0+    isInvisibleRow y = all isInvisible $ flip (pixelAt img) y <$> [0 .. imageWidth - 1]+    isInvisibleCol x = all isInvisible $ pixelAt img x <$> [0 .. imageHeight - 1]++    top = fromMaybe 0 (find (not . isInvisibleRow) [0 .. imageHeight - 1])+    bottom = fromMaybe 0 (find (not . isInvisibleRow) [imageHeight - 1, imageHeight - 2 .. 0]) + 1+    height = bottom - top++    left = fromMaybe 0 (find (not . isInvisibleCol) [0 .. imageWidth - 1])+    right = fromMaybe 0 (find (not . isInvisibleCol) [imageWidth - 1, imageWidth - 2 .. 1]) + 1+    width = right - left+{-# INLINEABLE trim #-}+ -- | Flip an image horizontally. flipHorizontally :: Pixel a => Image a -> Image a flipHorizontally img@Image {..} =@@ -214,3 +236,24 @@           | otherwise = pixelAt img2 x (y - h1)         w = min w1 w2 {-# INLINEABLE below #-}++-- | Make an image a perfect square by adding filler around it.+--+-- @since 0.6.0+square :: Pixel a => a -> Image a -> Image a+square filler img@Image {..} =+  if imageWidth == imageHeight+    then img+    else generateImage gen size size+  where+    size = max imageWidth imageHeight+    extraWidth = size - imageWidth+    extraHeight = size - imageHeight+    offsetX = extraWidth `div` 2+    offsetY = extraHeight `div` 2+    gen i _ | i < offsetX = filler+    gen i _ | i >= imageWidth + offsetX = filler+    gen _ j | j < offsetY = filler+    gen _ j | j >= imageHeight + offsetY = filler+    gen i j = pixelAt img (i - offsetX) (j - offsetY)+{-# INLINEABLE square #-}

@@ -1,11 +1,11 @@-cabal-version:   1.18+cabal-version:   2.4 name:            JuicyPixels-extra-version:         0.5.2-license:         BSD3+version:         0.6.0+license:         BSD-3-Clause license-file:    LICENSE.md maintainer:      Mark Karpov <markkarpov92@gmail.com> author:          Mark Karpov <markkarpov92@gmail.com>-tested-with:     ghc ==8.8.4 ghc ==8.10.5 ghc ==9.0.1+tested-with:     ghc ==9.0.2 ghc ==9.2.4 ghc ==9.4.1 homepage:        https://github.com/mrkkrp/JuicyPixels-extra bug-reports:     https://github.com/mrkkrp/JuicyPixels-extra/issues synopsis:        Efficiently scale, crop, flip images with JuicyPixels@@ -30,7 +30,7 @@     exposed-modules:  Codec.Picture.Extra     default-language: Haskell2010     build-depends:-        base >=4.13 && <5,+        base >=4.15 && <5,         JuicyPixels >=3.2.6.4 && <3.4      if flag(dev)@@ -45,14 +45,14 @@             -Wnoncanonical-monad-instances  test-suite tests-    type:             exitcode-stdio-1.0-    main-is:          Spec.hs-    build-tools:      hspec-discover >=2.0 && <3.0-    hs-source-dirs:   tests-    other-modules:    Codec.Picture.ExtraSpec-    default-language: Haskell2010+    type:               exitcode-stdio-1.0+    main-is:            Spec.hs+    build-tool-depends: hspec-discover:hspec-discover >=2.0 && <3.0+    hs-source-dirs:     tests+    other-modules:      Codec.Picture.ExtraSpec+    default-language:   Haskell2010     build-depends:-        base >=4.13 && <5,+        base >=4.15 && <5,         JuicyPixels >=3.2.6.4 && <3.4,         JuicyPixels-extra,         hspec >=2.0@@ -69,10 +69,10 @@     hs-source-dirs:   bench     default-language: Haskell2010     build-depends:-        base >=4.13 && <5,+        base >=4.15 && <5,         JuicyPixels >=3.2.6.4 && <3.4,         JuicyPixels-extra,-        criterion >=0.6.2.1 && <1.6+        criterion >=0.6.2.1 && <1.7      if flag(dev)         ghc-options: -O2 -Wall -Werror

binary file changed (absent → 1497 bytes)

binary file changed (absent → 237644 bytes)

binary file changed (absent → 245633 bytes)

@@ -1,3 +1,5 @@+{-# LANGUAGE FlexibleContexts #-}+ module Codec.Picture.ExtraSpec   ( main,     spec,@@ -8,6 +10,7 @@ import Codec.Picture.Extra import Control.Monad import Data.Function (on)+import Foreign (Storable) import Test.Hspec  main :: IO ()@@ -17,6 +20,7 @@ spec = do   describe "scaleBilinear" scaleBilinearSpec   describe "crop" cropSpec+  describe "trim" trimSpec   describe "flipHorizontally" flipHorizontallySpec   describe "flipVertically" flipVerticallySpec   describe "rotateLeft90Spec" rotateLeft90Spec@@ -24,6 +28,7 @@   describe "rotate180" rotate180Spec   describe "beside" besideSpec   describe "below" belowSpec+  describe "square" squareSpec  scaleBilinearSpec :: Spec scaleBilinearSpec = do@@ -79,6 +84,32 @@         "data-examples/macaque-below.png"         "data-examples/macaque.png" +trimSpec :: Spec+trimSpec = do+  context "when we pass an image without transparency" $+    it "does nothing" $+      checkWithFiles+        trim+        "data-examples/macaque.png"+        "data-examples/macaque.png"+  context "when passing an image with transparency" $ do+    it "does nothing if there are no fully transparent edges" $+      checkWithFilesAlpha+        trim+        "data-examples/macaque-transparent-cropped.png"+        "data-examples/macaque-transparent-cropped.png"+    it "removed the transparent edges" $+      checkWithFilesAlpha+        trim+        "data-examples/macaque-transparent.png"+        "data-examples/macaque-transparent-cropped.png"+  context "when passing a fully transparent image" $+    it "returns an empty image" $ do+      (Right (ImageRGBA8 original)) <- readImage "data-examples/fully-transparent.png"+      let trimmed = trim original+      imageWidth trimmed `shouldBe` 1+      imageHeight trimmed `shouldBe` 1+ flipHorizontallySpec :: Spec flipHorizontallySpec =   context "when we flip horizontally" $@@ -142,6 +173,31 @@         "data-examples/macaque.png"         "data-examples/macaque-below.png" +squareSpec :: Spec+squareSpec = do+  context "when we pass an already square image" $ do+    it "does nothing" $+      checkWithFiles+        (square $ PixelRGB8 0 0 0)+        "data-examples/macaque.png"+        "data-examples/macaque.png"+    it "does nothing (alpha)" $+      checkWithFilesAlpha+        (square $ PixelRGBA8 0 0 0 0)+        "data-examples/macaque-transparent.png"+        "data-examples/macaque-transparent.png"+  context "when we pass a non-square image" $ do+    it "adds the required filler to wider than heigh image" $ do+      (Right (ImageRGB8 original)) <- readImage "data-examples/macaque-beside.png"+      let squared = square (PixelRGB8 0 0 0) original+      imageWidth squared `shouldBe` 1024+      imageHeight squared `shouldBe` 1024+    it "adds the required filler to higher than wide image" $ do+      (Right (ImageRGB8 original)) <- readImage "data-examples/macaque-below.png"+      let squared = square (PixelRGB8 0 0 0) original+      imageWidth squared `shouldBe` 1024+      imageHeight squared `shouldBe` 1024+ -- | Run a transforming on the image loaded from a file and compare the -- resulting image with the contents of another file. checkWithFiles ::@@ -157,6 +213,20 @@   (Right (ImageRGB8 result)) <- readImage fpath   f original `blindlySatisfy` sameImage result +-- | `checkWithFiles` for images with an alpha channel.+checkWithFilesAlpha ::+  -- | Transformation to test+  (Image PixelRGBA8 -> Image PixelRGBA8) ->+  -- | Where to get the original image+  FilePath ->+  -- | Where to get the image to compare with+  FilePath ->+  Expectation+checkWithFilesAlpha f opath fpath = do+  (Right (ImageRGBA8 original)) <- readImage opath+  (Right (ImageRGBA8 result)) <- readImage fpath+  f original `blindlySatisfy` sameImage result+ -- | The same as 'shouldSatisfy', but doesn't care if its argument is an -- instance of 'Show' or not. blindlySatisfy :: a -> (a -> Bool) -> Expectation@@ -164,7 +234,7 @@   unless (p v) (expectationFailure "predicate failed")  -- | The equality test for images.-sameImage :: Image PixelRGB8 -> Image PixelRGB8 -> Bool+sameImage :: (Eq a, Eq (PixelBaseComponent a), Storable (PixelBaseComponent a)) => Image a -> Image a -> Bool sameImage a b =   ((==) `on` imageWidth) a b     && ((==) `on` imageHeight) a b