JuicyPixels-scale-dct 0.1.1.0 → 0.1.1.1
raw patch · 4 files changed
+71/−51 lines, 4 filesdep −JuicyPixels-utildep ~JuicyPixels
Dependencies removed: JuicyPixels-util
Dependency ranges changed: JuicyPixels
Files
- CHANGELOG.md +4/−0
- JuicyPixels-scale-dct.cabal +11/−10
- example/Example.hs +19/−11
- src/Codec/Picture/ScaleDCT.hs +37/−30
CHANGELOG.md view
@@ -1,3 +1,7 @@+# 0.1.1.1++- Remove test dependency on `JuicyPixels-util`+ # 0.1.1.0 - Bundle missing test file
JuicyPixels-scale-dct.cabal view
@@ -1,11 +1,13 @@--- This file has been generated from package.yaml by hpack version 0.8.0.+-- This file has been generated from package.yaml by hpack version 0.14.0. -- -- see: https://github.com/sol/hpack name: JuicyPixels-scale-dct-version: 0.1.1.0+version: 0.1.1.1 synopsis: Scale JuicyPixels images with DCT description: Scale JuicyPixels Images with DCT+ .+ There is also a @friday@ version: <http://hackage.haskell.org/package/friday-scale-dct friday-scale-dct> category: Web homepage: https://github.com/phadej/JuicyPixels-scale-dct#readme bug-reports: https://github.com/phadej/JuicyPixels-scale-dct/issues@@ -13,7 +15,7 @@ maintainer: Oleg Grenrus <oleg.grenrus@iki.fi> license: BSD3 license-file: LICENSE-tested-with: GHC==7.8.4, GHC==7.10.2+tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.1 build-type: Simple cabal-version: >= 1.10 @@ -31,8 +33,8 @@ src ghc-options: -Wall build-depends:- base >=4.7 && <4.9- , base-compat >=0.6.0 && <0.9+ base >=4.7 && <4.10+ , base-compat >=0.6.0 && <0.10 , JuicyPixels >=3.2.5.3 && <3.3 , fft >=0.1.8.1 && <0.2 , carray >=0.1.6.1 && <0.2@@ -47,14 +49,13 @@ example ghc-options: -Wall build-depends:- base >=4.7 && <4.9- , base-compat >=0.6.0 && <0.9+ base >=4.7 && <4.10+ , base-compat >=0.6.0 && <0.10 , JuicyPixels >=3.2.5.3 && <3.3 , fft >=0.1.8.1 && <0.2 , carray >=0.1.6.1 && <0.2 , base- , JuicyPixels+ , JuicyPixels >=3.2.8 , JuicyPixels-scale-dct- , JuicyPixels-util >=0.2 && <0.3- , time >=1.4.2 && <1.6+ , time >=1.4.2 && <1.7 default-language: Haskell2010
example/Example.hs view
@@ -1,18 +1,26 @@ module Main (main) where -import Codec.Picture (readImage, writePng)-import Codec.Picture.RGBA8 (fromDynamicImage)+import Codec.Picture (convertRGBA8, readImage, writePng) import Codec.Picture.ScaleDCT (scale) import Data.Time (diffUTCTime, getCurrentTime) -main :: IO ()-main = do+processImage+ :: String -- ^ From+ -> (Int, Int) -- ^ Target size+ -> String -- ^ To+ -> IO ()+processImage src size dst = 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+ Right dimg <- readImage src+ let img = convertRGBA8 dimg+ let ava = scale size img+ writePng dst ava end <- getCurrentTime- print $ end `diffUTCTime` start+ putStrLn $ dst ++ ": " ++ show (end `diffUTCTime` start)++main :: IO ()+main = do+ processImage "cat.jpg" (96, 64) "cat-small.png"+ processImage "cat.jpg" (769, 512) "cat-large.png"+ processImage "phadej.png" (64, 64) "phadej-small.png"+ processImage "phadej.png" (600, 600) "phadej-large.png"
src/Codec/Picture/ScaleDCT.hs view
@@ -12,26 +12,27 @@ -- module Codec.Picture.ScaleDCT (scale) where -import Prelude ()+import Prelude () import Prelude.Compat -import Codec.Picture (Image (..), PixelRGBA8 (..), Traversal,- generateImage, imagePixels)+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.Array.CArray+ (CArray, amap, array, bounds, elems, listArray, size, (!))+import Data.Coerce (Coercible, coerce) 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+ :: (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@@ -51,15 +52,17 @@ imgNorm :: Array2D -> Double imgNorm ch = sqrt . (/n) . sum . fmap sq . elems $ ch- where sq x = x * x- n = fromIntegral $ size 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+ 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@@ -68,10 +71,11 @@ 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+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@@ -79,18 +83,21 @@ channelB = extractChannel pixelB channelA = extractChannel pixelA -fromChannels :: Array2D- -> Array2D- -> Array2D- -> Array2D- -> Image PixelRGBA8+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+ 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