diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,10 +1,15 @@ +1.5.5.0 +======= + +* Ability to encode animated gifs + 1.5.4.0 ======= * Addition of `disable-chart` flag * Bunch of semi-functional stuff from GSoC 2018 -1.5.2.0 +1.5.3.0 ======= * Fixed FFT performace issue diff --git a/hip.cabal b/hip.cabal --- a/hip.cabal +++ b/hip.cabal @@ -1,5 +1,5 @@ Name: hip -Version: 1.5.4.0 +Version: 1.5.5.0 License: BSD3 License-File: LICENSE Author: Alexey Kuleshevich @@ -36,7 +36,7 @@ HS-Source-Dirs: src Build-Depends: - JuicyPixels >= 3.2.7 + JuicyPixels >= 3.3.5 , base >= 4.5 && < 5 , bytestring >= 0.9.0.4 , colour >= 2.3.3 diff --git a/src/Graphics/Image/IO.hs b/src/Graphics/Image/IO.hs --- a/src/Graphics/Image/IO.hs +++ b/src/Graphics/Image/IO.hs @@ -156,8 +156,7 @@ -- 'RGBA' 'Double') would be written as @RGBA16@, hence preserving transparency -- and using highest supported precision 'Word16'. At the same time, writing -- that image in 'GIF' format would save it in @RGB8@, since 'Word8' is the --- highest precision 'GIF' supports and it currently cannot be saved with --- transparency. +-- highest precision 'GIF' supports. writeImage :: (Array VS cs e, Array arr cs e, Writable (Image VS cs e) OutputFormat) => FilePath -- ^ Location where an image should be written. diff --git a/src/Graphics/Image/IO/Formats/JuicyPixels.hs b/src/Graphics/Image/IO/Formats/JuicyPixels.hs --- a/src/Graphics/Image/IO/Formats/JuicyPixels.hs +++ b/src/Graphics/Image/IO/Formats/JuicyPixels.hs @@ -79,7 +79,7 @@ import qualified Data.Monoid as M (mempty) import qualified Data.Vector.Storable as V import Graphics.Image.ColorSpace -import Graphics.Image.Interface as I +import Graphics.Image.Interface as I hiding (map) import Graphics.Image.Interface.Vector (VS) import Graphics.Image.IO.Base @@ -168,6 +168,10 @@ fromJPImageY16 = jpImageToImageUnsafe {-# INLINE fromJPImageY16 #-} +fromJPImageY32 :: JP.Image JP.Pixel32 -> Image VS Y Word32 +fromJPImageY32 = jpImageToImageUnsafe +{-# INLINE fromJPImageY32 #-} + fromJPImageYA8 :: JP.Image JP.PixelYA8 -> Image VS YA Word8 fromJPImageYA8 = jpImageToImageUnsafe {-# INLINE fromJPImageYA8 #-} @@ -280,6 +284,7 @@ jpDynamicImageToImage (JP.ImageY8 jimg) = convert $ fromJPImageY8 jimg jpDynamicImageToImage (JP.ImageYA8 jimg) = convert $ fromJPImageYA8 jimg jpDynamicImageToImage (JP.ImageY16 jimg) = convert $ fromJPImageY16 jimg +jpDynamicImageToImage (JP.ImageY32 jimg) = convert $ fromJPImageY32 jimg jpDynamicImageToImage (JP.ImageYA16 jimg) = convert $ fromJPImageYA16 jimg jpDynamicImageToImage (JP.ImageYF jimg) = convert $ fromJPImageYF jimg jpDynamicImageToImage (JP.ImageRGB8 jimg) = convert $ fromJPImageRGB8 jimg @@ -296,6 +301,7 @@ jpImageShowCS :: JP.DynamicImage -> String jpImageShowCS (JP.ImageY8 _) = "Y8 (Pixel Y Word8)" jpImageShowCS (JP.ImageY16 _) = "Y16 (Pixel Y Word16)" +jpImageShowCS (JP.ImageY32 _) = "Y32 (Pixel Y Word32)" jpImageShowCS (JP.ImageYF _) = "YF (Pixel Y Float)" jpImageShowCS (JP.ImageYA8 _) = "YA8 (Pixel YA Word8)" jpImageShowCS (JP.ImageYA16 _) = "YA16 (Pixel YA Word16)" @@ -416,6 +422,7 @@ instance ImageFormat (Seq GIF) where data SaveOption (Seq GIF) = GIFSeqPalette JP.PaletteOptions | GIFSeqLooping JP.GifLooping + | GIFSeqDisposal JP.GifDisposalMethod ext _ = ext GIF @@ -585,8 +592,31 @@ {-# INLINE palletizeGif #-} {-# INLINE encodeGIFSeq #-} +{-# INLINE encodeGIFSeqA #-} +encodeGIFSeqA :: [SaveOption (Seq GIF)] + -> [(JP.GifDelay, Image VS RGBA Word8)] -> BL.ByteString +encodeGIFSeqA !opts frms = + case output of + Left err -> error err + Right res -> res + where width = JP.imageWidth $ snd $ head jPimgs + height = JP.imageHeight $ snd $ head jPimgs + jPimgs = map (\(d,i) -> (d,toJPImageRGBA8 i)) frms + frames = JP.palettizeWithAlpha jPimgs $ getGIFSeqDisposal opts + getGIFSeqDisposal [] = JP.DisposalRestoreBackground + getGIFSeqDisposal (GIFSeqDisposal disposal:_) = disposal + getGIFSeqDisposal (_:xs) = getGIFSeqDisposal xs + getGIFSeqLoop [] = JP.LoopingNever + getGIFSeqLoop (GIFSeqLooping l:_) = l + getGIFSeqLoop (_:xs) = getGIFSeqLoop xs + input = JP.GifEncode width height Nothing Nothing (getGIFSeqLoop opts) frames + output = JP.encodeComplexGifImage input + instance Writable [(JP.GifDelay, Image VS RGB Word8)] (Seq GIF) where encode _ opts = encodeGIFSeq opts + +instance Writable [(JP.GifDelay, Image VS RGBA Word8)] (Seq GIF) where + encode _ opts = encodeGIFSeqA opts instance Writable [(JP.GifDelay, Image VS RGB Double)] (Seq GIF) where encode _ opts = encodeGIFSeq opts . fmap (fmap toWord8I) diff --git a/src/Graphics/Image/Processing/Ahe.hs b/src/Graphics/Image/Processing/Ahe.hs --- a/src/Graphics/Image/Processing/Ahe.hs +++ b/src/Graphics/Image/Processing/Ahe.hs @@ -1,23 +1,23 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BangPatterns #-} -- | Adaptive histogram equalization is used to improve contrast in images. -- It adjusts image intensity in small regions (neighborhood) in the image. +-- +-- /__Warning__/ - This module is experimental and likely doesn't work as expected module Graphics.Image.Processing.Ahe where import Control.Monad (forM_, when) import Control.Monad.ST -import Data.STRef -import Debug.Trace (trace) +import Data.STRef import Prelude as P hiding (subtract) import Graphics.Image.Processing.Filter import Graphics.Image.Interface as I import Graphics.Image import Graphics.Image.Types as IP -import Graphics.Image.ColorSpace (X) -- | Supplementary function for applying border resolution and a general mask. simpleFilter :: (Array arr cs e, Array arr X e) => Direction -> Border (Pixel cs e) -> Filter arr cs e @@ -26,60 +26,64 @@ where !kernel = case dir of - Vertical -> fromLists $ [ [ 0, -1, 0 ], [ -1, 4, -1 ], [ 0, -1, 0 ] ] - Horizontal -> fromLists $ [ [ 0, -1, 0 ], [ -1, 4, -1 ], [ 0, -1, 0 ] ] + Vertical -> fromLists [ [ 0, -1, 0 ], [ -1, 4, -1 ], [ 0, -1, 0 ] ] + Horizontal -> fromLists [ [ 0, -1, 0 ], [ -1, 4, -1 ], [ 0, -1, 0 ] ] -- | 'ahe' operates on small 'contextual' regions of the image. It enhances the contrast of each -- region and this technique works well when the distribution of pixel values is similar throughout --- the image. +-- the image. -- -- The idea is to perform contrast enhancement in 'neighborhood region' of each pixel and the size --- of the region is a parameter of the method. It constitutes a characteristic length scale: contrast +-- of the region is a parameter of the method. It constitutes a characteristic length scale: contrast -- at smaller scales is enhanced, while contrast at larger scales is reduced (For general purposes, a size -- factor of 5 tends to give pretty good results). -- -- <> <> -- --- Usage : --- +-- Usage : +-- -- >>> img <- readImageY VU "images/yield.jpg" -- >>> input1 <- getLine -- >>> input2 <- getLine -- >>> let thetaSz = (P.read input1 :: Int) --- >>> let distSz = (P.read input2 :: Int) --- >>> let neighborhoodFactor = (P.read input2 :: Int) --- >>> let aheImage :: Image VU RGB Double --- >>> aheImage = ahe img thetaSz distSz neighborhoodFactor +-- >>> let distSz = (P.read input2 :: Int) +-- >>> let neighborhoodFactor = (P.read input2 :: Int) +-- >>> let aheImage = ahe img thetaSz distSz neighborhoodFactor :: Image VU RGB Double -- >>> writeImage "images/yield_ahe.png" (toImageRGB aheImage) -- -ahe - :: forall arr e cs . ( MArray arr Y Double, IP.Array arr Y Double, IP.Array arr Y Word16, MArray arr Y Word16, Array arr X Double) +ahe :: + forall arr. + ( MArray arr Y Double + , IP.Array arr Y Double + , IP.Array arr Y Word16 + , MArray arr Y Word16 + , Array arr X Double + ) => Image arr Y Double - -> Int -- ^ width of output image - -> Int -- ^ height of output image - -> Int -- ^ neighborhood size factor + -> Int -- ^ width of output image + -> Int -- ^ height of output image + -> Int -- ^ neighborhood size factor -> Image arr Y Word16 ahe image thetaSz distSz neighborhoodFactor = I.map (fmap toWord16) accBin where - ip = applyFilter (simpleFilter Horizontal Edge) image -- Pre-processing (Border resolution) - widthMax, var1, heightMax, var2 :: Int + ip = applyFilter (simpleFilter Horizontal Edge) image -- Pre-processing (Border resolution) + _widthMax, var1, _heightMax, var2 :: Int var1 = ((rows ip) - 1) - widthMax = ((rows ip) - 1) + _widthMax = ((rows ip) - 1) var2 = ((cols ip) - 1) - heightMax = ((cols ip) - 1) - + _heightMax = ((cols ip) - 1) + accBin :: Image arr Y Word16 accBin = runST $ -- Core part of the Algo begins here. do arr <- I.new (thetaSz, distSz) -- Create a mutable image with the given dimensions. forM_ [0 .. var1] $ \x -> do forM_ [0 .. var2] $ \y -> do rankRef <- newSTRef (0 :: Int) - let neighborhood a maxValue = filter (\a -> a >= 0 && a < maxValue) [a-5 .. a+5] + let neighborhood a maxValue = filter (\a -> a >= 0 && a < maxValue) [a-5 .. a+5] forM_ (neighborhood x var1) $ \i -> do - forM_ (neighborhood y var2) $ \j -> do + forM_ (neighborhood y var2) $ \j -> do when (I.index ip (x, y) > I.index ip (i, j)) $ modifySTRef' rankRef (+1) rank <- readSTRef rankRef - let px = ((rank * 255)) + let px = ((rank * 255)) I.write arr (x, y) (PixelY (fromIntegral px)) - freeze arr - + freeze arr diff --git a/src/Graphics/Image/Processing/Filter.hs b/src/Graphics/Image/Processing/Filter.hs --- a/src/Graphics/Image/Processing/Filter.hs +++ b/src/Graphics/Image/Processing/Filter.hs @@ -14,7 +14,7 @@ -- module Graphics.Image.Processing.Filter ( -- * Filter - Filter (..) + Filter (Filter) , applyFilter , Direction(..) -- * Gaussian @@ -32,10 +32,10 @@ , logFilter -- * Gaussian Smoothing , gaussianSmoothingFilter - -- * Mean + -- * Mean , meanFilter -- * Unsharp Masking - , unsharpMaskingFilter + , unsharpMaskingFilter ) where @@ -158,8 +158,8 @@ laplacianFilter !border = Filter (correlate border kernel) where - !kernel = fromLists $ [ [ -1, -1, -1 ] -- Unlike the Sobel edge detector, the Laplacian edge detector uses only one kernel. - , [ -1, 8, -1 ] -- It calculates second order derivatives in a single pass. + !kernel = fromLists $ [ [ -1, -1, -1 ] -- Unlike the Sobel edge detector, the Laplacian edge detector uses only one kernel. + , [ -1, 8, -1 ] -- It calculates second order derivatives in a single pass. , [ -1, -1, -1 ]] -- This is the approximated kernel used for it. (Includes diagonals) {-# INLINE laplacianFilter #-} @@ -167,7 +167,7 @@ -- an image before applying some derivative filter on it. This comes in -- need for reducing the noise sensitivity while working with noisy -- datasets or in case of approximating second derivative measurements. --- +-- -- The LoG operator takes the second derivative of the image. Where the image -- is basically uniform, the LoG will give zero. Wherever a change occurs, the LoG will -- give a positive response on the darker side and a negative response on the lighter side. @@ -191,15 +191,15 @@ , [ 0, 1, 1, 2, 2, 2, 1, 1, 0 ] ] {-# INLINE logFilter #-} --- | The Gaussian smoothing operator is a 2-D convolution operator that is used to --- `blur' images and remove detail and noise. The idea of Gaussian smoothing is to use --- this 2-D distribution as a `point-spread' function, and this is achieved by convolution. --- Since the image is stored as a collection of discrete pixels we need to produce a --- discrete approximation to the Gaussian function before we can perform the convolution. +-- | The Gaussian smoothing operator is a 2-D convolution operator that is used to +-- `blur' images and remove detail and noise. The idea of Gaussian smoothing is to use +-- this 2-D distribution as a `point-spread' function, and this is achieved by convolution. +-- Since the image is stored as a collection of discrete pixels we need to produce a +-- discrete approximation to the Gaussian function before we can perform the convolution. -- More info about the algo at --- --- <> <> -- +-- <> <> +-- gaussianSmoothingFilter :: (Fractional e, Array arr cs e, Array arr X e) => Border (Pixel cs e) -> Filter arr cs e gaussianSmoothingFilter !border = @@ -211,32 +211,32 @@ ,[ 4, 16, 26, 16, 4 ] ,[ 1, 4, 7, 4, 1 ]] -{-# INLINE gaussianSmoothingFilter #-} +{-# INLINE gaussianSmoothingFilter #-} --- | The mean filter is a simple sliding-window spatial filter that replaces the --- center value in the window with the average (mean) of all the pixel values in --- the window. The window, or kernel, can be any shape, but this one uses the most +-- | The mean filter is a simple sliding-window spatial filter that replaces the +-- center value in the window with the average (mean) of all the pixel values in +-- the window. The window, or kernel, can be any shape, but this one uses the most -- common 3x3 square kernel. -- More info about the algo at --- +-- -- <> <> --- +-- meanFilter :: (Fractional e, Array arr cs e, Array arr X e) => Border (Pixel cs e) -> Filter arr cs e meanFilter !border = Filter (I.map (/ 9) . correlate border kernel) - where + where !kernel = fromLists $[ [ 1, 1, 1 ] -- Replace each pixel with the mean value of its neighbors, including itself. - , [ 1, 1, 1 ] + , [ 1, 1, 1 ] , [ 1, 1, 1 ]] {-# INLINE meanFilter #-} -- | The unsharp-masking filter is a sharpening operator which derives its name from --- the fact that it enhances edges (and other high frequency components in an image) +-- the fact that it enhances edges (and other high frequency components in an image) -- via a procedure which subtracts an unsharp, or smoothed, version of an image from --- the original image. It is commonly used in the photographic and printing industries +-- the original image. It is commonly used in the photographic and printing industries -- for crispening edges. -- More info about the algo at -- @@ -246,13 +246,11 @@ Border (Pixel cs e) -> Filter arr cs e unsharpMaskingFilter !border = Filter (I.map (/256) . correlate border kernel) - where - !kernel = fromLists $ [[ -1, -4, -6, -4, -1 ] + where + !kernel = fromLists $ [[ -1, -4, -6, -4, -1 ] ,[ -4, -16, -24, -16, -4 ] -- Uses negative image to create a mask of the original image. ,[ -6, -24, 476, -24, -6 ] -- The unsharped mask is then combined with the positive (original) image. ,[ -4, -16, -24, -16, -4 ] -- So, the resulting image is less blurry, i.e clearer. ,[ -1, -4, -6, -4, -1 ]] {-# INLINE unsharpMaskingFilter #-} - - diff --git a/src/Graphics/Image/Processing/Hough.hs b/src/Graphics/Image/Processing/Hough.hs --- a/src/Graphics/Image/Processing/Hough.hs +++ b/src/Graphics/Image/Processing/Hough.hs @@ -2,9 +2,11 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} --- | Hough Transform is used as a part of feature extraction in images. +-- | Hough Transform is used as a part of feature extraction in images. -- It is a tool that makes it far easier to identify straight lines in -- the source image, whatever their orientation. +-- +-- /__Warning__/ - This module is experimental and likely doesn't work as expected module Graphics.Image.Processing.Hough where import Control.Monad (forM_, when) @@ -18,7 +20,7 @@ import Graphics.Image.Types as IP -- | Some helper functions : --- | Trivial function for subtracting co-ordinate pairs +-- | Trivial function for subtracting co-ordinate pairs sub :: Num x => (x, x) -> (x, x) -> (x, x) sub (x1, y1) (x2, y2) = (x1 - x2, y1 - y2) @@ -34,25 +36,25 @@ mag :: Floating x => (x, x) -> x mag x = sqrt (dotProduct x x) --- | 'hough' computes the Linear Hough Transform and maps each point in the target image, ​ (ρ, θ) ​ --- to the average color of the pixels on the corresponding line of the source image ​(x,y) ​- space, --- where the line corresponds to points of the form ​(xcosθ + ysinθ = ρ(rho)). +-- | 'hough' computes the Linear Hough Transform and maps each point in the target image, (ρ, θ) +-- to the average color of the pixels on the corresponding line of the source image (x,y) - space, +-- where the line corresponds to points of the form (xcosθ + ysinθ = ρ(rho)). -- --- The idea is that where there is a straight line in the original image, it corresponds to a --- bright (or dark, depending on the color of the background field) spot; by applying a suitable +-- The idea is that where there is a straight line in the original image, it corresponds to a +-- bright (or dark, depending on the color of the background field) spot; by applying a suitable -- filter to the results of the transform, it is possible to extract the locations of the lines in the original image. -- -- <> <> -- --- Usage : --- --- >>> frog <- readImageRGB VU "yield.jpg" +-- Usage : +-- +-- >>> yield <- readImageRGB VU "yield.jpg" -- >>> input1 <- getLine -- >>> input2 <- getLine -- >>> let thetaSz = (P.read input1 :: Int) -- >>> let distSz = (P.read input2 :: Int) -- >>> let houghImage :: Image VU RGB Double --- >>> houghImage = hough frog thetaSz distSz +-- >>> houghImage = hough yield thetaSz distSz -- >>> writeImage "test.png" houghImage -- hough @@ -80,7 +82,7 @@ slopeMap = [ ((x, y), slope x y) | x <- [0 .. widthMax], y <- [0 .. heightMax] ] distMax :: Double -- Compute Maximum distance - distMax = (sqrt . fromIntegral $ (heightMax + 1) ^ (2 :: Int) + (widthMax + 1) ^ (2 :: Int)) / 2 + distMax = (sqrt . fromIntegral $ (heightMax + 1) ^ (2 :: Int) + (widthMax + 1) ^ (2 :: Int)) / 2 accBin = runSTArray $ -- Core part of Algo begins here. Working in a safe way with a mutable array. do arr <- newArray ((0, 0), (thetaSz, distSz)) (0 :: Double) -- Build a new array, with every element initialised to the supplied value. @@ -99,11 +101,10 @@ writeArray arr idx (old + 1) return arr - maxAcc = F.maximum accBin + maxAcc = F.maximum accBin hTransform (x, y) = let l = 255 - truncate ((accBin ! (x, y)) / maxAcc * 255) -- pixel generating function in PixelY l hImage :: Image arr Y Word8 hImage = makeImage (thetaSz, distSz) hTransform -