Added trim and square functions

CHANGELOG.md

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

Codec/Picture/Extra.hs

@@ -19,6 +19,7 @@ module Codec.Picture.Extra
 
     -- * Cropping
     crop,
+    trim,
 
     -- * Rotation
     flipHorizontally,
@@ -30,13 +31,15 @@ module Codec.Picture.Extra
     -- * 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 ::
@@ -140,6 +143,25 @@ crop x' y' w' h' img@Image {..} =
     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 @@ below = foldl1' go
           | 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 #-}

tests/Codec/Picture/ExtraSpec.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleContexts #-}
+
 module Codec.Picture.ExtraSpec
   ( main,
     spec,
@@ -8,6 +10,7 @@ import Codec.Picture
 import Codec.Picture.Extra
 import Control.Monad
 import Data.Function (on)
+import Foreign (Storable)
 import Test.Hspec
 
 main :: IO ()
@@ -17,13 +20,15 @@ spec :: Spec
 spec = do
   describe "scaleBilinear" scaleBilinearSpec
   describe "crop" cropSpec
+  describe "trim" trimSpec
   describe "flipHorizontally" flipHorizontallySpec
   describe "flipVertically" flipVerticallySpec
   describe "rotateLeft90Spec" rotateLeft90Spec
   describe "rotateRight90Spec" rotateRight90Spec
   describe "rotate180" rotate180Spec
   describe "beside" besideSpec
   describe "below" belowSpec
+  describe "square" squareSpec
 
 scaleBilinearSpec :: Spec
 scaleBilinearSpec = do
@@ -79,6 +84,32 @@ cropSpec = do
         "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 @@ belowSpec =
         "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,14 +213,28 @@ checkWithFiles f opath fpath = do
   (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
 v `blindlySatisfy` p =
   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