diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +## Juicy Pixels Extra 0.1.0 + +* Initial release. diff --git a/Codec/Picture/Extra.hs b/Codec/Picture/Extra.hs new file mode 100644 --- /dev/null +++ b/Codec/Picture/Extra.hs @@ -0,0 +1,127 @@ +-- | +-- Module : Codec.Picture.Extra +-- Copyright : © 2016 Mark Karpov +-- License : BSD 3 clause +-- +-- Maintainer : Mark Karpov +-- Stability : experimental +-- Portability : portable +-- +-- Utilities for image transformation with JuicyPixels. + +{-# LANGUAGE RecordWildCards #-} + +module Codec.Picture.Extra + ( -- * Scaling + scaleBilinear + -- * Cropping + , crop + -- * Rotation + , flipHorizontally + , flipVertically + , rotateLeft90 + , rotateRight90 ) +where + +import Codec.Picture +import Control.Monad.ST +import qualified Codec.Picture.Types as M + +-- | Scale image using bi-linear interpolation. This is specialized to +-- 'PixelRGB8' only for speed (polymorphic version is easily written, but +-- it's more than twice as slow). + +scaleBilinear + :: Int -- ^ Desired width + -> Int -- ^ Desired height + -> Image PixelRGB8 -- ^ Original image + -> Image PixelRGB8 -- ^ Scaled image +scaleBilinear width height img@Image {..} = 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 = + if i >= imageWidth || j >= imageHeight + then PixelRGB8 0 0 0 + else pixelAt img i 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 + +mulp :: PixelRGB8 -> Float -> PixelRGB8 +mulp pixel x = colorMap (floor . (* x) . fromIntegral) pixel +{-# INLINE mulp #-} + +addp :: PixelRGB8 -> PixelRGB8 -> PixelRGB8 +addp = mixWith (const f) + where + f x y = fromIntegral $ + (0xff :: Pixel8) `min` (fromIntegral x + fromIntegral y) +{-# INLINE addp #-} + +-- | Crop given image. If supplied coordinates are greater than size of +-- original image, image boundaries are used instead. + +crop :: Pixel a + => Int -- ^ Index (X axis) of first pixel to include + -> Int -- ^ Index (Y axis) of first pixel to include + -> Int -- ^ Width of resulting image + -> Int -- ^ Height of resulting image + -> Image a -- ^ Original image + -> Image a -- ^ Cropped image +crop x' y' w' h' img@Image {..} = + generateImage gen w h + where + gen i j = pixelAt img (x + i) (y + j) + x = min (imageWidth - 1) x' + y = min (imageHeight - 1) y' + w = min (imageWidth - x) w' + h = min (imageWidth - y) h' + +-- | Flip image horizontally. + +flipHorizontally :: Pixel a => Image a -> Image a +flipHorizontally img@Image {..} = + generateImage gen imageWidth imageHeight + where + gen x = pixelAt img (imageWidth - 1 - x) + +-- | Flip image vertically. + +flipVertically :: Pixel a => Image a -> Image a +flipVertically img@Image {..} = + generateImage gen imageWidth imageHeight + where + gen x y = pixelAt img x (imageHeight - 1 - y) + +-- | Rotate image to the left by 90°. + +rotateLeft90 :: Pixel a => Image a -> Image a +rotateLeft90 img@Image {..} = + generateImage gen imageHeight imageWidth + where + gen x y = pixelAt img y x + +-- | Rotate image to the right by 90°. + +rotateRight90 :: Pixel a => Image a -> Image a +rotateRight90 img@Image {..} = + generateImage gen imageHeight imageWidth + where + gen x y = pixelAt img y (imageHeight - 1 - x) diff --git a/JuicyPixels-extra.cabal b/JuicyPixels-extra.cabal new file mode 100644 --- /dev/null +++ b/JuicyPixels-extra.cabal @@ -0,0 +1,89 @@ +-- +-- Cabal configuration for ‘JuicyPixels-extra’ package. +-- +-- Copyright © 2016 Mark Karpov +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are +-- met: +-- +-- * Redistributions of source code must retain the above copyright notice, +-- this list of conditions and the following disclaimer. +-- +-- * Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in the +-- documentation and/or other materials provided with the distribution. +-- +-- * Neither the name Mark Karpov nor the names of contributors may be used +-- to endorse or promote products derived from this software without +-- specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY +-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY +-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +-- POSSIBILITY OF SUCH DAMAGE. + +name: JuicyPixels-extra +version: 0.1.0 +cabal-version: >= 1.10 +license: BSD3 +license-file: LICENSE.md +author: Mark Karpov +maintainer: Mark Karpov +homepage: https://github.com/mrkkrp/JuicyPixels-extra +bug-reports: https://github.com/mrkkrp/JuicyPixels-extra/issues +category: Graphics, Image +synopsis: Efficiently scale, crop, flip images with JuicyPixels +build-type: Simple +description: Efficiently scale, crop, flip images with JuicyPixels. +extra-source-files: CHANGELOG.md + , README.md + , data-examples/lenna.png + , data-examples/lenna-cropped.png + , data-examples/lenna-horizontal-flip.png + , data-examples/lenna-vertical-flip.png + , data-examples/lenna-left-rotated.png + , data-examples/lenna-right-rotated.png + , data-examples/lenna-scaled-down.png + , data-examples/lenna-scaled-up.png + +source-repository head + type: git + location: https://github.com/mrkkrp/JuicyPixels-extra.git + +flag dev + description: Turn on development settings. + manual: True + default: False + +library + build-depends: base >= 4.7 && < 5 + , JuicyPixels >= 3.2.6.4 + exposed-modules: Codec.Picture.Extra + if flag(dev) + ghc-options: -Wall -Werror + else + ghc-options: -O2 -Wall + default-language: Haskell2010 + +test-suite tests + main-is: Spec.hs + hs-source-dirs: tests + type: exitcode-stdio-1.0 + build-depends: base >= 4.7 && < 5 + , JuicyPixels >= 3.2.6.4 + , JuicyPixels-extra >= 0.1.0 + , hspec >= 2.0 + other-modules: Codec.Picture.ExtraSpec + if flag(dev) + ghc-options: -Wall -Werror + else + ghc-options: -O2 -Wall + default-language: Haskell2010 diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,28 @@ +Copyright © 2016 Mark Karpov + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + +* Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +* Neither the name Mark Karpov nor the names of contributors may be used to + endorse or promote products derived from this software without specific + prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY EXPRESS +OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN +NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, +OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, +EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,22 @@ +# Juicy Pixels Extra + +[![License BSD3](https://img.shields.io/badge/license-BSD3-brightgreen.svg)](http://opensource.org/licenses/BSD-3-Clause) +[![Hackage](https://img.shields.io/hackage/v/JuicyPixels-extra.svg?style=flat)](https://hackage.haskell.org/package/JuicyPixels-extra) +[![Stackage Nightly](http://stackage.org/package/JuicyPixels-extra/badge/nightly)](http://stackage.org/nightly/package/JuicyPixels-extra) +[![Stackage LTS](http://stackage.org/package/JuicyPixels-extra/badge/lts)](http://stackage.org/lts/package/JuicyPixels-extra) +[![Build Status](https://travis-ci.org/mrkkrp/JuicyPixels-extra.svg?branch=master)](https://travis-ci.org/mrkkrp/JuicyPixels-extra) +[![Coverage Status](https://coveralls.io/repos/mrkkrp/JuicyPixels-extra/badge.svg?branch=master&service=github)](https://coveralls.io/github/mrkkrp/JuicyPixels-extra?branch=master) + +Missing primitive stuff you shouldn't need to re-implement yourself. I think +haddocks are pretty self-explanatory. Currently the package includes the +following functionality: + +* scaling (bi-linear interpolation); +* cropping; +* flipping horizontally and vertically and 90° rotation (left and right). + +## License + +Copyright © 2016 Mark Karpov + +Distributed under BSD 3 clause license. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Distribution.Simple + +main :: IO () +main = defaultMain diff --git a/data-examples/lenna-cropped.png b/data-examples/lenna-cropped.png new file mode 100644 Binary files /dev/null and b/data-examples/lenna-cropped.png differ diff --git a/data-examples/lenna-horizontal-flip.png b/data-examples/lenna-horizontal-flip.png new file mode 100644 Binary files /dev/null and b/data-examples/lenna-horizontal-flip.png differ diff --git a/data-examples/lenna-left-rotated.png b/data-examples/lenna-left-rotated.png new file mode 100644 Binary files /dev/null and b/data-examples/lenna-left-rotated.png differ diff --git a/data-examples/lenna-right-rotated.png b/data-examples/lenna-right-rotated.png new file mode 100644 Binary files /dev/null and b/data-examples/lenna-right-rotated.png differ diff --git a/data-examples/lenna-scaled-down.png b/data-examples/lenna-scaled-down.png new file mode 100644 Binary files /dev/null and b/data-examples/lenna-scaled-down.png differ diff --git a/data-examples/lenna-scaled-up.png b/data-examples/lenna-scaled-up.png new file mode 100644 Binary files /dev/null and b/data-examples/lenna-scaled-up.png differ diff --git a/data-examples/lenna-vertical-flip.png b/data-examples/lenna-vertical-flip.png new file mode 100644 Binary files /dev/null and b/data-examples/lenna-vertical-flip.png differ diff --git a/data-examples/lenna.png b/data-examples/lenna.png new file mode 100644 Binary files /dev/null and b/data-examples/lenna.png differ diff --git a/tests/Codec/Picture/ExtraSpec.hs b/tests/Codec/Picture/ExtraSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Codec/Picture/ExtraSpec.hs @@ -0,0 +1,108 @@ +module Codec.Picture.ExtraSpec + ( main + , spec ) +where + +import Codec.Picture +import Codec.Picture.Extra +import Control.Monad +import Data.Function (on) +import Test.Hspec + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "scaleBilinear" scaleBilinearSpec + describe "crop" cropSpec + describe "flipHorizontally" flipHorizontallySpec + describe "flipVertically" flipVerticallySpec + describe "rotateLeft90Spec" rotateLeft90Spec + describe "rotateRight90Spec" rotateRight90Spec + +scaleBilinearSpec :: Spec +scaleBilinearSpec = do + context "when called with orginial dimensions" $ + it "produces the same image" $ + checkWithFiles (scaleBilinear 512 512) + "data-examples/lenna.png" + "data-examples/lenna.png" + context "when we scale down" $ + it "produces correct image" $ + checkWithFiles (scaleBilinear 100 100) + "data-examples/lenna.png" + "data-examples/lenna-scaled-down.png" + context "when we scale up" $ + it "produces correct image" $ + checkWithFiles (scaleBilinear 600 600) + "data-examples/lenna.png" + "data-examples/lenna-scaled-up.png" + +cropSpec :: Spec +cropSpec = + context "when we pass arguments within image size" $ + it "produces correct image" $ + checkWithFiles (crop 211 210 178 191) + "data-examples/lenna.png" + "data-examples/lenna-cropped.png" + +flipHorizontallySpec :: Spec +flipHorizontallySpec = + context "when we flip horizontally" $ + it "produces correct image" $ + checkWithFiles flipHorizontally + "data-examples/lenna.png" + "data-examples/lenna-horizontal-flip.png" + +flipVerticallySpec :: Spec +flipVerticallySpec = + context "when we flip vertically" $ + it "produces correct image" $ + checkWithFiles flipVertically + "data-examples/lenna.png" + "data-examples/lenna-vertical-flip.png" + +rotateLeft90Spec :: Spec +rotateLeft90Spec = + context "when we rotate to the left by 90°" $ + it "produces correct image" $ + checkWithFiles rotateLeft90 + "data-examples/lenna.png" + "data-examples/lenna-left-rotated.png" + +rotateRight90Spec :: Spec +rotateRight90Spec = + context "when we rotate to the right by 90°" $ + it "produces correct image" $ + checkWithFiles rotateRight90 + "data-examples/lenna.png" + "data-examples/lenna-right-rotated.png" + +-- | Run given transforming function on image loaded from one file and +-- compare resulting image with contents of another file. + +checkWithFiles + :: (Image PixelRGB8 -> Image PixelRGB8) -- ^ Transformation to test + -> FilePath -- ^ Where to get the original image + -> FilePath -- ^ Where to get image to compare with + -> Expectation +checkWithFiles f opath fpath = do + (Right (ImageRGB8 original)) <- readImage opath + (Right (ImageRGB8 flipped)) <- readImage fpath + f original `blindlySatisfy` sameImage flipped + +-- | The same as 'shouldSatisfy', but doesn't care if its argument is +-- instance of 'Show' or not. + +blindlySatisfy :: a -> (a -> Bool) -> Expectation +v `blindlySatisfy` p = + unless (p v) (expectationFailure "predicate failed") + +-- | Equality test for images. + +sameImage :: Image PixelRGB8 -> Image PixelRGB8 -> Bool +sameImage a b = + ((==) `on` imageWidth) a b && + ((==) `on` imageHeight) a b && + ((==) `on` imageData) a b diff --git a/tests/Spec.hs b/tests/Spec.hs new file mode 100644 --- /dev/null +++ b/tests/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}