packages feed

JuicyPixels-extra (empty) → 0.1.0

raw patch · 16 files changed

+384/−0 lines, 16 filesdep +JuicyPixelsdep +JuicyPixels-extradep +basesetup-changedbinary-added

Dependencies added: JuicyPixels, JuicyPixels-extra, base, hspec

Files

+ CHANGELOG.md view
@@ -0,0 +1,3 @@+## Juicy Pixels Extra 0.1.0++* Initial release.
+ Codec/Picture/Extra.hs view
@@ -0,0 +1,127 @@+-- |+-- Module      :  Codec.Picture.Extra+-- Copyright   :  © 2016 Mark Karpov+-- License     :  BSD 3 clause+--+-- Maintainer  :  Mark Karpov <markkarpov@openmailbox.org>+-- 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)
+ JuicyPixels-extra.cabal view
@@ -0,0 +1,89 @@+--+-- Cabal configuration for ‘JuicyPixels-extra’ package.+--+-- Copyright © 2016 Mark Karpov <markkarpov@openmailbox.org>+--+-- 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 <markkarpov@openmailbox.org>+maintainer:           Mark Karpov <markkarpov@openmailbox.org>+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
+ LICENSE.md view
@@ -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.
+ README.md view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ data-examples/lenna-cropped.png view

binary file changed (absent → 62830 bytes)

+ data-examples/lenna-horizontal-flip.png view

binary file changed (absent → 471314 bytes)

+ data-examples/lenna-left-rotated.png view

binary file changed (absent → 473674 bytes)

+ data-examples/lenna-right-rotated.png view

binary file changed (absent → 466243 bytes)

+ data-examples/lenna-scaled-down.png view

binary file changed (absent → 29045 bytes)

+ data-examples/lenna-scaled-up.png view

binary file changed (absent → 985586 bytes)

+ data-examples/lenna-vertical-flip.png view

binary file changed (absent → 471109 bytes)

+ data-examples/lenna.png view

binary file changed (absent → 473831 bytes)

+ tests/Codec/Picture/ExtraSpec.hs view
@@ -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
+ tests/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}