{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
#if __GLASGOW_HASKELL__ >= 800
{-# LANGUAGE UndecidableSuperClasses #-}
#endif
module Graphics.Image.Processing.Binary (
toImageBinaryUsing, toImageBinaryUsing2,
threshold, threshold2,
thresholdWith, thresholdWith2, compareWith,
Thresholding(..),
or, and, (!&&!), (!||!), (.&&.), (.||.), invert, disjunction, conjunction,
erode, dialate, open, close
) where
import Control.Applicative
import Data.Bits
import qualified Data.Foldable as F
import Graphics.Image.ColorSpace
import Graphics.Image.Interface as I
import Graphics.Image.Processing.Convolution
import Graphics.Image.Utils ((.:), (.:!))
import Prelude as P hiding (and, or)
infix 4 .==., ./=., .<., .<=., .>=., .>., !==!, !/=!, !<!, !<=!, !>=!, !>!
infixr 3 .&&., !&&!
infixr 2 .||., !||!
class Thresholding a b arr | a b -> arr where
(!==!) :: (Applicative (Pixel cs), Array arr cs e, Array arr cs Bit) =>
a cs e -> b cs e -> Image arr cs Bit
(!/=!) :: (Applicative (Pixel cs), Array arr cs e, Array arr cs Bit) =>
a cs e -> b cs e -> Image arr cs Bit
(!<!) :: (Ord e, Applicative (Pixel cs), Array arr cs e, Array arr cs Bit) =>
a cs e -> b cs e -> Image arr cs Bit
(!<=!) :: (Ord e, Applicative (Pixel cs), Array arr cs e, Array arr cs Bit) =>
a cs e -> b cs e -> Image arr cs Bit
(!>!) :: (Ord e, Applicative (Pixel cs), Array arr cs e, Array arr cs Bit) =>
a cs e -> b cs e -> Image arr cs Bit
(!>=!) :: (Ord e, Applicative (Pixel cs), Array arr cs e, Array arr cs Bit) =>
a cs e -> b cs e -> Image arr cs Bit
(.==.) :: (Array arr cs e, Array arr X Bit) => a cs e -> b cs e -> Image arr X Bit
(./=.) :: (Array arr cs e, Array arr X Bit) => a cs e -> b cs e -> Image arr X Bit
(.<.) :: (Ord (Pixel cs e), Array arr cs e, Array arr X Bit) =>
a cs e -> b cs e -> Image arr X Bit
(.<=.) :: (Ord (Pixel cs e), Array arr cs e, Array arr X Bit) =>
a cs e -> b cs e -> Image arr X Bit
(.>.) :: (Ord (Pixel cs e), Array arr cs e, Array arr X Bit) =>
a cs e -> b cs e -> Image arr X Bit
(.>=.) :: (Ord (Pixel cs e), Array arr cs e, Array arr X Bit) =>
a cs e -> b cs e -> Image arr X Bit
instance Thresholding (Image arr) (Image arr) arr where
(.==.) = toImageBinaryUsing2 (==)
{-# INLINE (.==.) #-}
(./=.) = toImageBinaryUsing2 (/=)
{-# INLINE (./=.) #-}
(.<.) = toImageBinaryUsing2 (<)
{-# INLINE (.<.) #-}
(.<=.) = toImageBinaryUsing2 (<=)
{-# INLINE (.<=.) #-}
(.>.) = toImageBinaryUsing2 (>)
{-# INLINE (.>.) #-}
(.>=.) = toImageBinaryUsing2 (>=)
{-# INLINE (.>=.) #-}
(!==!) = threshold2 (pure (==))
{-# INLINE (!==!) #-}
(!/=!) = threshold2 (pure (/=))
{-# INLINE (!/=!) #-}
(!<!) = threshold2 (pure (<))
{-# INLINE (!<!) #-}
(!<=!) = threshold2 (pure (<=))
{-# INLINE (!<=!) #-}
(!>!) = threshold2 (pure (>))
{-# INLINE (!>!) #-}
(!>=!) = threshold2 (pure (>=))
{-# INLINE (!>=!) #-}
instance Array arr X Bit => Thresholding Pixel (Image arr) arr where
(.==.) !px = toImageBinaryUsing (==px)
{-# INLINE (.==.) #-}
(./=.) !px = toImageBinaryUsing (/=px)
{-# INLINE (./=.) #-}
(.<.) !px = toImageBinaryUsing (< px)
{-# INLINE (.<.) #-}
(.<=.) !px = toImageBinaryUsing (<=px)
{-# INLINE (.<=.) #-}
(.>.) !px = toImageBinaryUsing (> px)
{-# INLINE (.>.) #-}
(.>=.) !px = toImageBinaryUsing (>=px)
{-# INLINE (.>=.) #-}
(!==!) !px = threshold ((==) <$> px)
{-# INLINE (!==!) #-}
(!/=!) !px = threshold ((/=) <$> px)
{-# INLINE (!/=!) #-}
(!<!) !px = threshold ((<) <$> px)
{-# INLINE (!<!) #-}
(!<=!) !px = threshold ((<=) <$> px)
{-# INLINE (!<=!) #-}
(!>!) !px = threshold ((>) <$> px)
{-# INLINE (!>!) #-}
(!>=!) !px = threshold ((>=) <$> px)
{-# INLINE (!>=!) #-}
instance Array arr X Bit => Thresholding (Image arr) Pixel arr where
(.==.) !img !px = toImageBinaryUsing (==px) img
{-# INLINE (.==.) #-}
(./=.) !img !px = toImageBinaryUsing (/=px) img
{-# INLINE (./=.) #-}
(.<.) !img !px = toImageBinaryUsing (< px) img
{-# INLINE (.<.) #-}
(.<=.) !img !px = toImageBinaryUsing (<=px) img
{-# INLINE (.<=.) #-}
(.>.) !img !px = toImageBinaryUsing (> px) img
{-# INLINE (.>.) #-}
(.>=.) !img !px = toImageBinaryUsing (>=px) img
{-# INLINE (.>=.) #-}
(!==!) !img !px = threshold ((==) <$> px) img
{-# INLINE (!==!) #-}
(!/=!) !img !px = threshold ((/=) <$> px) img
{-# INLINE (!/=!) #-}
(!<!) !img !px = threshold ((<) <$> px) img
{-# INLINE (!<!) #-}
(!<=!) !img !px = threshold ((<=) <$> px) img
{-# INLINE (!<=!) #-}
(!>!) !img !px = threshold ((>) <$> px) img
{-# INLINE (!>!) #-}
(!>=!) !img !px = threshold ((>=) <$> px) img
{-# INLINE (!>=!) #-}
(.&&.) :: (Array arr cs Bit, Array arr X Bit) =>
Image arr cs Bit -> Image arr cs Bit -> Image arr X Bit
(.&&.) = squashWith2 ((.&.) .: (.&.)) one
{-# INLINE (.&&.) #-}
(.||.) :: (Array arr cs Bit, Array arr X Bit) =>
Image arr cs Bit -> Image arr cs Bit -> Image arr X Bit
(.||.) = squashWith2 ((.|.) .: (.|.)) zero
{-# INLINE (.||.) #-}
(!&&!) :: Array arr cs Bit =>
Image arr cs Bit -> Image arr cs Bit -> Image arr cs Bit
(!&&!) = I.zipWith (liftPx2 (.&.))
{-# INLINE (!&&!) #-}
(!||!) :: Array arr cs Bit =>
Image arr cs Bit -> Image arr cs Bit -> Image arr cs Bit
(!||!) = I.zipWith (liftPx2 (.|.))
{-# INLINE (!||!) #-}
invert :: Array arr cs Bit => Image arr cs Bit -> Image arr cs Bit
invert = I.map (liftPx complement)
{-# INLINE invert #-}
toImageBinaryUsing :: (Array arr cs e, Array arr X Bit) =>
(Pixel cs e -> Bool)
-> Image arr cs e
-> Image arr X Bit
toImageBinaryUsing f = I.map (fromBool . f)
{-# INLINE toImageBinaryUsing #-}
toImageBinaryUsing2 :: (Array arr cs e, Array arr X Bit) =>
(Pixel cs e -> Pixel cs e -> Bool)
-> Image arr cs e
-> Image arr cs e
-> Image arr X Bit
toImageBinaryUsing2 f = I.zipWith (fromBool .:! f)
{-# INLINE toImageBinaryUsing2 #-}
threshold :: (Applicative (Pixel cs), Array arr cs e, Array arr cs Bit) =>
Pixel cs (e -> Bool) -> Image arr cs e -> Image arr cs Bit
threshold fPx = I.map (fmap bool2bit . (fPx <*>))
{-# INLINE threshold #-}
threshold2 :: (Applicative (Pixel cs), Array arr cs e', Array arr cs e, Array arr cs Bit) =>
Pixel cs (e' -> e -> Bool)
-> Image arr cs e'
-> Image arr cs e
-> Image arr cs Bit
threshold2 fPx = I.zipWith (\ !px1 !px2 -> bool2bit <$> (fPx <*> px1 <*> px2))
{-# INLINE threshold2 #-}
thresholdWith :: (Applicative (Pixel cs), Foldable (Pixel cs),
Array arr cs e, Array arr X Bit) =>
Pixel cs (e -> Bool)
-> Image arr cs e
-> Image arr X Bit
thresholdWith fPx = I.map (fromBool . F.and . (fPx <*>))
{-# INLINE thresholdWith #-}
thresholdWith2 :: (Applicative (Pixel cs), Foldable (Pixel cs),
Array arr cs e1, Array arr cs e2, Array arr X Bit) =>
Pixel cs (e1 -> e2 -> Bool)
-> Image arr cs e1
-> Image arr cs e2
-> Image arr X Bit
thresholdWith2 fPx = I.zipWith (\ !px1 !px2 -> (fromBool . F.and) (fPx <*> px1 <*> px2))
{-# INLINE thresholdWith2 #-}
compareWith :: (Applicative (Pixel cs), Foldable (Pixel cs),
Array arr cs e1, Array arr cs e2, Array arr X Bit) =>
Pixel cs (e1 -> e2 -> Bool)
-> Image arr cs e1
-> Image arr cs e2
-> Image arr X Bit
compareWith = thresholdWith2
{-# INLINE compareWith #-}
{-# DEPRECATED compareWith "Use `thresholdWith2` instead." #-}
disjunction :: (Array arr cs Bit, Array arr X Bit) =>
Image arr cs Bit -> Image arr X Bit
disjunction = squashWith (.|.) zero
{-# INLINE disjunction #-}
conjunction :: (Array arr cs Bit, Array arr X Bit) =>
Image arr cs Bit -> Image arr X Bit
conjunction = squashWith (.&.) one
{-# INLINE conjunction #-}
or :: Array arr X Bit => Image arr X Bit -> Bool
or = isOn . fold (.|.) off
{-# INLINE or #-}
and :: Array arr X Bit => Image arr X Bit -> Bool
and = isOn . fold (.&.) on
{-# INLINE and #-}
erode :: Array arr X Bit =>
Image arr X Bit
-> Image arr X Bit
-> Image arr X Bit
erode !struc !img = invert $ convolve (Fill on) struc (invert img)
{-# INLINE erode #-}
dialate :: Array arr X Bit =>
Image arr X Bit
-> Image arr X Bit
-> Image arr X Bit
dialate !struc !img = convolve (Fill off) struc img
{-# INLINE dialate #-}
open :: Array arr X Bit =>
Image arr X Bit
-> Image arr X Bit
-> Image arr X Bit
open !struc = dialate struc . erode struc
{-# INLINE open #-}
close :: Array arr X Bit =>
Image arr X Bit
-> Image arr X Bit
-> Image arr X Bit
close !struc = erode struc . dialate struc
{-# INLINE close #-}