{-# LANGUAGE BangPatterns
           , FlexibleContexts
           , TypeFamilies #-}

-- | Provides high level filtering functions for images.
--
-- Use 'Vision.Image.Filter.Internal' if you want to create new image filters.
--
-- Filters are operations on images on which the surrounding of each processed
-- pixel is considered according to a kernel.
--
-- See <http://en.wikipedia.org/wiki/Kernel_(image_processing)> for details.
--
-- The @radius@ argument of some filters is used to determine the kernel size.
-- A radius as of 1 means a kernel of size 3, 2 a kernel of size 5 and so on.
--
-- /Note:/ filters are currently not supported on multi-channel images (RGB,
-- RGBA ...) are currently not supported.
module Vision.Image.Filter (
    -- * Classes and type
      Filterable, Filter, SeparatelyFiltrable
    -- * Morphological operators
    , dilate, erode
    -- * Blur
    , blur, gaussianBlur
    -- * Derivation
    , DerivativeType (..), scharr, sobel
    -- * Others
    , mean
    ) where

import Data.Int
import Foreign.Storable (Storable)

import Vision.Image.Class (MaskedImage (..), Image (..), FromFunction (..))
import Vision.Image.Filter.Internal (
      Filterable, Filter, SeparatelyFiltrable (..)
    , DerivativeType
    )
import Vision.Primitive (Size)

import qualified Vision.Image.Filter.Internal as Internal

-- Morphological operators -----------------------------------------------------

dilate, erode :: ( Image src, Ord (ImagePixel src)
                 , FromFunction res, FromFunctionPixel res ~ ImagePixel src
                 , SeparatelyFiltrable src res (ImagePixel src))
       => Int           -- ^ Kernel radius.
       -> src
       -> res

dilate :: forall src res.
(Image src, Ord (ImagePixel src), FromFunction res,
 FromFunctionPixel res ~ ImagePixel src,
 SeparatelyFiltrable src res (ImagePixel src)) =>
Int -> src -> res
dilate Int
radius src
img = forall pix. Ord pix => Int -> Morphological pix
Internal.dilate Int
radius forall src res f. Filterable src res f => f -> src -> res
`Internal.apply` src
img
{-# INLINABLE dilate #-}

erode :: forall src res.
(Image src, Ord (ImagePixel src), FromFunction res,
 FromFunctionPixel res ~ ImagePixel src,
 SeparatelyFiltrable src res (ImagePixel src)) =>
Int -> src -> res
erode  Int
radius src
img = forall pix. Ord pix => Int -> Morphological pix
Internal.erode Int
radius forall src res f. Filterable src res f => f -> src -> res
`Internal.apply` src
img
{-# INLINABLE erode #-}

-- Blur ------------------------------------------------------------------------

-- | Blurs the image by averaging the pixel inside the kernel.
--
-- Uses an 'Int32' as accumulator during the averaging operation.
blur :: ( Image src, Integral (ImagePixel src)
        , FromFunction res, Num (FromFunctionPixel res)
        , SeparatelyFiltrable src res Int32)
       => Int           -- ^ Blur radius.
       -> src
       -> res
blur :: forall src res.
(Image src, Integral (ImagePixel src), FromFunction res,
 Num (FromFunctionPixel res), SeparatelyFiltrable src res Int32) =>
Int -> src -> res
blur Int
radius src
img =
    let filt :: (Integral src, Num res) => Internal.Blur src Int32 res
        filt :: forall src res. (Integral src, Num res) => Blur src Int32 res
filt = forall src acc res.
(Integral src, Integral acc, Num res) =>
Int -> Blur src acc res
Internal.blur Int
radius
    in forall src res. (Integral src, Num res) => Blur src Int32 res
filt forall src res f. Filterable src res f => f -> src -> res
`Internal.apply` src
img
{-# INLINABLE blur #-}

-- | Blurs the image by averaging the pixel inside the kernel using a Gaussian
-- function.
--
-- See <http://en.wikipedia.org/wiki/Gaussian_blur>
gaussianBlur :: ( Image src, Integral (ImagePixel src)
                , FromFunction res, Integral (FromFunctionPixel res)
                , Floating acc, RealFrac acc, Storable acc
                , SeparatelyFiltrable src res acc)
             => Int     -- ^ Blur radius.
             -> Maybe acc
             -- ^ Sigma value of the Gaussian function. If not given, will be
             -- automatically computed from the radius so that the kernel
             -- fits 3σ of the distribution.
             -> src
             -> res
gaussianBlur :: forall src res acc.
(Image src, Integral (ImagePixel src), FromFunction res,
 Integral (FromFunctionPixel res), Floating acc, RealFrac acc,
 Storable acc, SeparatelyFiltrable src res acc) =>
Int -> Maybe acc -> src -> res
gaussianBlur Int
radius Maybe acc
mSig src
img =
    forall src acc res.
(Integral src, Floating acc, RealFrac acc, Storable acc,
 Integral res) =>
Int -> Maybe acc -> Blur src acc res
Internal.gaussianBlur Int
radius Maybe acc
mSig forall src res f. Filterable src res f => f -> src -> res
`Internal.apply` src
img
{-# INLINABLE gaussianBlur #-}

-- Derivation ------------------------------------------------------------------

-- | Estimates the first derivative using the Scharr's 3x3 kernel.
--
-- Convolves the following kernel for the X derivative:
--
-- @
--  -3   0   3
-- -10   0  10
--  -3   0   3
-- @
--
-- And this kernel for the Y derivative:
--
-- @
--  -3 -10  -3
--   0   0   0
--   3  10   3
-- @
--
-- Uses an 'Int32' as accumulator during kernel application.
scharr :: ( Image src, Integral (ImagePixel src)
          , FromFunction res, Integral (FromFunctionPixel res)
          , Storable (FromFunctionPixel res)
          , SeparatelyFiltrable src res (FromFunctionPixel res))
       => DerivativeType -> src -> res
scharr :: forall src res.
(Image src, Integral (ImagePixel src), FromFunction res,
 Integral (FromFunctionPixel res), Storable (FromFunctionPixel res),
 SeparatelyFiltrable src res (FromFunctionPixel res)) =>
DerivativeType -> src -> res
scharr DerivativeType
der src
img = forall src res.
(Integral src, Integral res) =>
DerivativeType -> Derivative src res
Internal.scharr DerivativeType
der forall src res f. Filterable src res f => f -> src -> res
`Internal.apply` src
img
{-# INLINABLE scharr #-}

-- | Estimates the first derivative using a Sobel's kernel.
--
-- Prefer 'scharr' when radius equals @1@ as Scharr's kernel is more accurate
-- and is implemented faster.
--
-- Uses an 'Int32' as accumulator during kernel application.
sobel :: ( Image src, Integral (ImagePixel src)
          , FromFunction res, Integral (FromFunctionPixel res)
          , Storable (FromFunctionPixel res)
          , SeparatelyFiltrable src res (FromFunctionPixel res))
      => Int            -- ^ Kernel radius.
      -> DerivativeType
      -> src
      -> res
sobel :: forall src res.
(Image src, Integral (ImagePixel src), FromFunction res,
 Integral (FromFunctionPixel res), Storable (FromFunctionPixel res),
 SeparatelyFiltrable src res (FromFunctionPixel res)) =>
Int -> DerivativeType -> src -> res
sobel Int
radius DerivativeType
der src
img = forall src res.
(Integral src, Integral res, Storable res) =>
Int -> DerivativeType -> Derivative src res
Internal.sobel Int
radius DerivativeType
der forall src res f. Filterable src res f => f -> src -> res
`Internal.apply` src
img
{-# INLINABLE sobel #-}

-- Others ----------------------------------------------------------------------

-- | Computes the average of a kernel of the given size.
--
-- This is similar to 'blur' but with a rectangular kernel and a 'Fractional'
-- result.
--
-- Uses an 'Int32' as accumulator during the averaging operation.
mean :: ( Image src, Integral (ImagePixel src)
        , FromFunction res, Fractional (FromFunctionPixel res)
        , SeparatelyFiltrable src res Int32)
     => Size -> src -> res
mean :: forall src res.
(Image src, Integral (ImagePixel src), FromFunction res,
 Fractional (FromFunctionPixel res),
 SeparatelyFiltrable src res Int32) =>
Size -> src -> res
mean Size
size src
img =
    let filt :: (Integral src, Fractional res) => Internal.Mean src Int32 res
        filt :: forall src res.
(Integral src, Fractional res) =>
Mean src Int32 res
filt = forall src acc res.
(Integral src, Integral acc, Fractional res) =>
Size -> SeparableFilter src () acc res
Internal.mean Size
size
    in forall src res.
(Integral src, Fractional res) =>
Mean src Int32 res
filt forall src res f. Filterable src res f => f -> src -> res
`Internal.apply` src
img
{-# INLINABLE mean #-}