JuicyPixels-scale-dct (empty) → 0.1.0.0
raw patch · 6 files changed
+250/−0 lines, 6 filesdep +JuicyPixelsdep +JuicyPixels-scale-dctdep +JuicyPixels-utilsetup-changed
Dependencies added: JuicyPixels, JuicyPixels-scale-dct, JuicyPixels-util, base, base-compat, carray, fft, time
Files
- JuicyPixels-scale-dct.cabal +58/−0
- LICENSE +30/−0
- README.md +23/−0
- Setup.hs +3/−0
- example/Example.hs +18/−0
- src/Codec/Picture/ScaleDCT.hs +118/−0
+ JuicyPixels-scale-dct.cabal view
@@ -0,0 +1,58 @@+-- This file has been generated from package.yaml by hpack version 0.8.0.+--+-- see: https://github.com/sol/hpack++name: JuicyPixels-scale-dct+version: 0.1.0.0+synopsis: Scale JuicyPixels images with DCT+description: Scale JuicyPixels Images with DCT+category: Web+homepage: https://github.com/phadej/JuicyPixels-scale-dct#readme+bug-reports: https://github.com/phadej/JuicyPixels-scale-dct/issues+author: Oleg Grenrus <oleg.grenrus@iki.fi>+maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>+license: BSD3+license-file: LICENSE+tested-with: GHC==7.8.4, GHC==7.10.2+build-type: Simple+cabal-version: >= 1.10++extra-source-files:+ README.md++source-repository head+ type: git+ location: https://github.com/phadej/JuicyPixels-scale-dct++library+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ base >=4.7 && <4.9+ , base-compat >=0.6.0 && <0.9+ , JuicyPixels >=3.2.5.3 && <3.3+ , fft >=0.1.8.1 && <0.2+ , carray >=0.1.6.1 && <0.2+ exposed-modules:+ Codec.Picture.ScaleDCT+ default-language: Haskell2010++test-suite example+ type: exitcode-stdio-1.0+ main-is: Example.hs+ hs-source-dirs:+ example+ ghc-options: -Wall+ build-depends:+ base >=4.7 && <4.9+ , base-compat >=0.6.0 && <0.9+ , JuicyPixels >=3.2.5.3 && <3.3+ , fft >=0.1.8.1 && <0.2+ , carray >=0.1.6.1 && <0.2+ , base+ , JuicyPixels+ , JuicyPixels-scale-dct+ , JuicyPixels-util >=0.2 && <0.3+ , time >=1.4.2 && <1.6+ default-language: Haskell2010
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Oleg Grenrus++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 of Oleg Grenrus nor the names of other+ 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 AND CONTRIBUTORS+"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+OWNER OR CONTRIBUTORS 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,23 @@+# JuicyPixels-scale-dct++> Scale JuicyPixels images with DCT++[](https://travis-ci.org/phadej/JuicyPixels-scale-dct)+[](http://hackage.haskell.org/package/JuicyPixels-scale-dct)+[](http://stackage.org/lts-2/package/JuicyPixels-scale-dct)+[](http://stackage.org/lts-3/package/JuicyPixels-scale-dct)+[](http://stackage.org/nightly/package/JuicyPixels-scale-dct)++---++## Example image++++### smaller++++### larger++
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple+main :: IO ()+main = defaultMain
+ example/Example.hs view
@@ -0,0 +1,18 @@+module Main (main) where++import Codec.Picture (readImage, writePng)+import Codec.Picture.RGBA8 (fromDynamicImage)+import Codec.Picture.ScaleDCT (scale)+import Data.Time (diffUTCTime, getCurrentTime)++main :: IO ()+main = do+ start <- getCurrentTime+ Right dimg <- readImage "phadej.png"+ let img = fromDynamicImage dimg+ let ava1 = scale (64, 64) img+ let ava2 = scale (600, 600) img+ writePng "phadej-small.png" ava1+ writePng "phadej-large.png" ava2+ end <- getCurrentTime+ print $ end `diffUTCTime` start
+ src/Codec/Picture/ScaleDCT.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+-----------------------------------------------------------------------------+-- |+-- Module : Code.Picture.ScaleDCT+-- Copyright : (C) 2015 Oleg Grenrus+-- License : BSD3+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- Scale pictures using Discrete Cosine Transform.+--+module Codec.Picture.ScaleDCT (scale) where++import Prelude ()+import Prelude.Compat++import Codec.Picture (Image (..), PixelRGBA8 (..), Traversal,+ generateImage, imagePixels)+import Control.Applicative (Const (..))+import Data.Array.CArray (CArray, amap, array, bounds, elems, listArray, size,+ (!))+import Data.Ix (inRange, range)+import Data.Monoid (Endo (..))+import Data.Word (Word8)+import Math.FFT (dct2N, dct3N)+import Data.Coerce (Coercible, coerce)++type Array2D = CArray (Int, Int) Double++-- | Scale the image using DCT transform.+scale :: (Int, Int) -- ^ Output width, height+ -> Image PixelRGBA8 -- ^ Input image+ -> Image PixelRGBA8 -- ^ Output image+scale dim img = fromChannels r' g' b' a'+ where+ r = channelR img+ g = channelG img+ b = channelB img+ a = channelA img++ transform ch = amap (k*) ch'+ where+ ch' = dct3N [1, 0] . cut dim . dct2N [0, 1] $ ch+ k = imgNorm ch / imgNorm ch'++ r' = transform r+ g' = transform g+ b' = transform b+ a' = transform a++imgNorm :: Array2D -> Double+imgNorm ch = sqrt . (/n) . sum . fmap sq . elems $ ch+ where sq x = x * x+ n = fromIntegral $ size ch++cut :: (Int, Int) -> Array2D -> Array2D+cut (w, h) img = array b [ (i, pick i) | i <- range b ]+ where b = ((0,0), (h-1, w-1))+ b' = bounds img+ pick i | inRange b' i = img ! i+ | otherwise = 0++pixelR, pixelG, pixelB, pixelA :: PixelRGBA8 -> Word8+pixelR (PixelRGBA8 r _ _ _) = r+pixelG (PixelRGBA8 _ g _ _) = g+pixelB (PixelRGBA8 _ _ b _) = b+pixelA (PixelRGBA8 _ _ _ a) = a++extractChannel :: (PixelRGBA8 -> Word8) -> Image PixelRGBA8 -> Array2D+extractChannel f img@(Image w h _) = listArray ((0, 0), (h - 1, w - 1))+ . map (fromInteger . toInteger . f)+ . toListOf imagePixels+ $ img++channelR, channelG, channelB, channelA :: Image PixelRGBA8 -> Array2D+channelR = extractChannel pixelR+channelG = extractChannel pixelG+channelB = extractChannel pixelB+channelA = extractChannel pixelA++fromChannels :: Array2D+ -> Array2D+ -> Array2D+ -> Array2D+ -> Image PixelRGBA8+fromChannels r g b a = generateImage f w h+ where f x y = PixelRGBA8 (f' r) (f' g) (f' b) (f' a)+ where i = (y, x)+ f' c = truncate (limit $ c ! i)+ (_, (h', w')) = bounds r+ w = w' + 1+ h = h' + 1++limit :: Double -> Double+limit x | x < 0 = 0+ | x > 255 = 255+ | otherwise = x++-- From 'Control.Lens.Lens' from 'lens' package+toListOf :: Traversal s s a a -> s -> [a]+toListOf l = foldrOf l (:) []+{-# INLINE toListOf #-}++foldrOf :: Traversal s s a a -> (a -> r -> r) -> r -> s -> r+foldrOf l f z = flip appEndo z . foldMapOf l (Endo #. f)+{-# INLINE foldrOf #-}++foldMapOf :: Monoid r => Traversal s s a a -> (a -> r) -> s -> r+foldMapOf l f = getConst #. l (Const #. f)+{-# INLINE foldMapOf #-}++(#.) :: Coercible c b => (b -> c) -> (a -> b) -> a -> c+(#.) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b+{-# INLINE (#.) #-}++--(.#) :: Coercible b a => (b -> c) -> (a -> b) -> a -> c+--(.#) pbc _ = coerce pbc