opencv-0.0.0.0: src/OpenCV/ImgProc/MiscImgTransform.hs
{-# language CPP #-}
{-# language QuasiQuotes #-}
{-# language TemplateHaskell #-}
#if __GLASGOW_HASKELL__ >= 800
{-# options_ghc -Wno-redundant-constraints #-}
#endif
module OpenCV.ImgProc.MiscImgTransform
( -- * Color conversion
cvtColor
, module OpenCV.ImgProc.MiscImgTransform.ColorCodes
-- * Flood filling
, floodFill
, FloodFillOperationFlags(..)
, defaultFloodFillOperationFlags
-- * Thresholding
, ThreshType(..)
, ThreshValue(..)
, threshold
-- * Watershed
, watershed
-- * GrabCut
, GrabCutOperationMode(..)
, grabCut
-- * In range
, inRange
) where
import "base" Data.Bits
import "base" Data.Int
import "base" Data.Proxy ( Proxy(..) )
import "base" Data.Word
import "base" Foreign.Marshal.Alloc ( alloca )
import "base" Foreign.Storable ( peek )
import "base" GHC.TypeLits
import "primitive" Control.Monad.Primitive ( PrimMonad, PrimState, unsafePrimToPrim )
import qualified "inline-c" Language.C.Inline as C
import qualified "inline-c-cpp" Language.C.Inline.Cpp as C
import "linear" Linear.V4 ( V4 )
import "this" OpenCV.Core.Types
import "this" OpenCV.ImgProc.MiscImgTransform.ColorCodes
import "this" OpenCV.Internal.C.Inline ( openCvCtx )
import "this" OpenCV.Internal.C.Types
import "this" OpenCV.Internal.Exception
import "this" OpenCV.Internal.Core.Types.Mat
import "this" OpenCV.Internal.ImgProc.MiscImgTransform
import "this" OpenCV.Internal.ImgProc.MiscImgTransform.TypeLevel
import "this" OpenCV.Internal.ImgProc.MiscImgTransform.ColorCodes ( colorConversionCode )
import "this" OpenCV.TypeLevel
--------------------------------------------------------------------------------
C.context openCvCtx
C.include "opencv2/core.hpp"
C.include "opencv2/imgproc.hpp"
C.using "namespace cv"
--------------------------------------------------------------------------------
-- ignore next Haddock code block, because of the hash sign in the link at the end of the comment.
{- | Converts an image from one color space to another
The function converts an input image from one color space to
another. In case of a transformation to-from RGB color space, the
order of the channels should be specified explicitly (RGB or
BGR). Note that the default color format in OpenCV is often
referred to as RGB but it is actually BGR (the bytes are
reversed). So the first byte in a standard (24-bit) color image
will be an 8-bit Blue component, the second byte will be Green, and
the third byte will be Red. The fourth, fifth, and sixth bytes
would then be the second pixel (Blue, then Green, then Red), and so
on.
The conventional ranges for R, G, and B channel values are:
* 0 to 255 for 'Word8' images
* 0 to 65535 for 'Word16' images
* 0 to 1 for 'Float' images
In case of linear transformations, the range does not matter. But
in case of a non-linear transformation, an input RGB image should
be normalized to the proper value range to get the correct results,
for example, for RGB to L*u*v* transformation. For example, if you
have a 32-bit floating-point image directly converted from an 8-bit
image without any scaling, then it will have the 0..255 value range
instead of 0..1 assumed by the function. So, before calling
'cvtColor', you need first to scale the image down:
> cvtColor (img * 1/255) 'ColorConvBGR2Luv'
If you use 'cvtColor' with 8-bit images, the conversion will have
some information lost. For many applications, this will not be
noticeable but it is recommended to use 32-bit images in
applications that need the full range of colors or that convert an
image before an operation and then convert back.
If conversion adds the alpha channel, its value will set to the
maximum of corresponding channel range: 255 for 'Word8', 65535 for
'Word16', 1 for 'Float'.
Example:
@
cvtColorImg
:: forall (width :: Nat)
(width2 :: Nat)
(height :: Nat)
(channels :: Nat)
(depth :: *)
. ( Mat (ShapeT [height, width]) ('S channels) ('S depth) ~ Birds_512x341
, width2 ~ (width + width)
)
=> Mat (ShapeT [height, width2]) ('S channels) ('S depth)
cvtColorImg = exceptError $
withMatM ((Proxy :: Proxy height) ::: (Proxy :: Proxy width2) ::: Z)
(Proxy :: Proxy channels)
(Proxy :: Proxy depth)
white $ \\imgM -> do
birds_gray <- pureExcept $ cvtColor gray bgr
=<< cvtColor bgr gray birds_512x341
matCopyToM imgM (V2 0 0) birds_512x341 Nothing
matCopyToM imgM (V2 w 0) birds_gray Nothing
lift $ arrowedLine imgM (V2 startX midY) (V2 pointX midY) red 4 LineType_8 0 0.15
where
h, w :: Int32
h = fromInteger $ natVal (Proxy :: Proxy height)
w = fromInteger $ natVal (Proxy :: Proxy width)
startX, pointX :: Int32
startX = round $ fromIntegral w * (0.95 :: Double)
pointX = round $ fromIntegral w * (1.05 :: Double)
midY = h \`div\` 2
@
<<doc/generated/examples/cvtColorImg.png cvtColorImg>>
<http://goo.gl/3rfrhu OpenCV Sphinx Doc>
-}
-- the link avove is minified because it includes a hash, which the CPP tries to parse and fails
-- TODO (RvD): Allow value level color codes
-- Allow statically unknown color codes: fromColor :: DS ColorCode
cvtColor :: forall (fromColor :: ColorCode)
(toColor :: ColorCode)
(shape :: DS [DS Nat])
(srcChannels :: DS Nat)
(dstChannels :: DS Nat)
(srcDepth :: DS *)
(dstDepth :: DS *)
. ( ColorConversion fromColor toColor
, ColorCodeMatchesChannels fromColor srcChannels
, dstChannels ~ 'S (ColorCodeChannels toColor)
, srcDepth `In` ['D, 'S Word8, 'S Word16, 'S Float]
, dstDepth ~ ColorCodeDepth fromColor toColor srcDepth
)
=> Proxy fromColor -- ^ Convert from 'ColorCode'. Make sure the source image has this 'ColorCode'
-> Proxy toColor -- ^ Convert to 'ColorCode'.
-> Mat shape srcChannels srcDepth -- ^ Source image
-> CvExcept (Mat shape dstChannels dstDepth)
cvtColor fromColor toColor src = unsafeWrapException $ do
dst <- newEmptyMat
handleCvException (pure $ unsafeCoerceMat dst) $
withPtr src $ \srcPtr ->
withPtr dst $ \dstPtr ->
[cvExcept|
cv::cvtColor( *$(Mat * srcPtr)
, *$(Mat * dstPtr)
, $(int32_t c'code)
, 0
);
|]
where
c'code = colorConversionCode fromColor toColor
{- | The function 'floodFill' fills a connected component starting from the seed point with the specified color.
The connectivity is determined by the color/brightness closeness of the neighbor pixels. See the OpenCV
documentation for details on the algorithm.
Example:
@
floodFillImg
:: forall (width :: Nat)
(width2 :: Nat)
(height :: Nat)
(channels :: Nat)
(depth :: *)
. ( Mat (ShapeT [height, width]) ('S channels) ('S depth) ~ Sailboat_768x512
, width2 ~ (width + width)
)
=> Mat (ShapeT [height, width2]) ('S channels) ('S depth)
floodFillImg = exceptError $
withMatM ((Proxy :: Proxy height) ::: (Proxy :: Proxy width2) ::: Z)
(Proxy :: Proxy channels)
(Proxy :: Proxy depth)
white $ \\imgM -> do
sailboatEvening_768x512 <- thaw sailboat_768x512
mask <- mkMatM (Proxy :: Proxy [height + 2, width + 2])
(Proxy :: Proxy 1)
(Proxy :: Proxy Word8)
black
circle mask (V2 450 120 :: V2 Int32) 45 white (-1) LineType_AA 0
rect <- floodFill sailboatEvening_768x512 (Just mask) seedPoint eveningRed (Just tolerance) (Just tolerance) defaultFloodFillOperationFlags
rectangle sailboatEvening_768x512 rect blue 2 LineType_8 0
frozenSailboatEvening_768x512 <- freeze sailboatEvening_768x512
matCopyToM imgM (V2 0 0) sailboat_768x512 Nothing
matCopyToM imgM (V2 w 0) frozenSailboatEvening_768x512 Nothing
lift $ arrowedLine imgM (V2 startX midY) (V2 pointX midY) red 4 LineType_8 0 0.15
where
h, w :: Int32
h = fromInteger $ natVal (Proxy :: Proxy height)
w = fromInteger $ natVal (Proxy :: Proxy width)
startX, pointX :: Int32
startX = round $ fromIntegral w * (0.95 :: Double)
pointX = round $ fromIntegral w * (1.05 :: Double)
midY = h \`div\` 2
seedPoint :: V2 Int32
seedPoint = V2 100 50
eveningRed :: V4 Double
eveningRed = V4 0 100 200 255
tolerance :: V4 Double
tolerance = pure 7
@
<<doc/generated/examples/floodFillImg.png floodFillImg>>
<http://goo.gl/9XIIne OpenCV Sphinx Doc>
-}
floodFill
:: ( PrimMonad m
, channels `In` '[ 'S 1, 'S 3 ]
, depth `In` '[ 'D, 'S Word8, 'S Float, 'S Double ]
, IsPoint2 point2 Int32
, ToScalar color
)
=> Mut (Mat shape channels depth) (PrimState m)
-- ^ Input/output 1- or 3-channel, 8-bit, or floating-point image. It is modified by the function unless the FLOODFILL_MASK_ONLY flag is set.
-> Maybe (Mut (Mat (WidthAndHeightPlusTwo shape) ('S 1) ('S Word8)) (PrimState m))
-- ^ Operation mask that should be a single-channel 8-bit image, 2 pixels wider and 2 pixels taller than image. Since this is both an input and output parameter, you must take responsibility of initializing it. Flood-filling cannot go across non-zero pixels in the input mask. For example, an edge detector output can be used as a mask to stop filling at edges. On output, pixels in the mask corresponding to filled pixels in the image are set to 1 or to the a value specified in flags as described below. It is therefore possible to use the same mask in multiple calls to the function to make sure the filled areas do not overlap.
-- Note: Since the mask is larger than the filled image, a pixel (x, y) in image corresponds to the pixel (x+1, y+1) in the mask.
-> point2 Int32
-- ^ Starting point.
-> color
-- ^ New value of the repainted domain pixels.
-> Maybe color
-- ^ Maximal lower brightness/color difference between the currently observed pixel and one of its neighbors belonging to the component, or a seed pixel being added to the component. Zero by default.
-> Maybe color
-- ^ Maximal upper brightness/color difference between the currently observed pixel and one of its neighbors belonging to the component, or a seed pixel being added to the component. Zero by default.
-> FloodFillOperationFlags
-> m Rect2i
floodFill img mbMask seedPoint color mLoDiff mUpDiff opFlags =
unsafePrimToPrim $
withPtr img $ \matPtr ->
withPtr mbMask $ \maskPtr ->
withPtr (toPoint seedPoint) $ \seedPointPtr ->
withPtr (toScalar color) $ \colorPtr ->
withPtr loDiff $ \loDiffPtr ->
withPtr upDiff $ \upDiffPtr ->
withPtr rect $ \rectPtr -> do
[C.block|void {
cv::Mat * maskPtr = $(Mat * maskPtr);
cv::floodFill( *$(Mat * matPtr)
, maskPtr ? cv::_InputOutputArray(*maskPtr) : cv::_InputOutputArray(noArray())
, *$(Point2i * seedPointPtr)
, *$(Scalar * colorPtr)
, $(Rect2i * rectPtr)
, *$(Scalar * loDiffPtr)
, *$(Scalar * upDiffPtr)
, $(int32_t c'opFlags)
);
}|]
pure rect
where
rect :: Rect2i
rect = toRect HRect{ hRectTopLeft = pure 0
, hRectSize = pure 0
}
c'opFlags = marshalFloodFillOperationFlags opFlags
zeroScalar = toScalar (pure 0 :: V4 Double)
loDiff = maybe zeroScalar toScalar mLoDiff
upDiff = maybe zeroScalar toScalar mUpDiff
data FloodFillOperationFlags
= FloodFillOperationFlags
{ floodFillConnectivity :: Word8
-- ^ Connectivity value. The default value of 4 means that only the four nearest neighbor pixels (those that share
-- an edge) are considered. A connectivity value of 8 means that the eight nearest neighbor pixels (those that share
-- a corner) will be considered.
, floodFillMaskFillColor :: Word8
-- ^ Value between 1 and 255 with which to fill the mask (the default value is 1).
, floodFillFixedRange :: Bool
-- ^ If set, the difference between the current pixel and seed pixel is considered. Otherwise, the difference
-- between neighbor pixels is considered (that is, the range is floating).
, floodFillMaskOnly :: Bool
-- ^ If set, the function does not change the image ( newVal is ignored), and only fills the mask with the
-- value specified in bits 8-16 of flags as described above. This option only make sense in function variants
-- that have the mask parameter.
}
defaultFloodFillOperationFlags :: FloodFillOperationFlags
defaultFloodFillOperationFlags =
FloodFillOperationFlags
{ floodFillConnectivity = 4
, floodFillMaskFillColor = 1
, floodFillFixedRange = False
, floodFillMaskOnly = False
}
marshalFloodFillOperationFlags :: FloodFillOperationFlags -> Int32
marshalFloodFillOperationFlags opFlags =
let connectivityBits = fromIntegral (floodFillConnectivity opFlags)
maskFillColorBits = fromIntegral (floodFillMaskFillColor opFlags) `shiftL` 8
fixedRangeBits = if floodFillFixedRange opFlags then c'FLOODFILL_FIXED_RANGE else 0
fillMaskOnlyBits = if floodFillMaskOnly opFlags then c'FLOODFILL_MASK_ONLY else 0
in connectivityBits .|. maskFillColorBits .|. fixedRangeBits .|. fillMaskOnlyBits
-- TODO (RvD): Otsu and triangle are only implemented for 8 bit images.
{- | Applies a fixed-level threshold to each array element
The function applies fixed-level thresholding to a single-channel array. The
function is typically used to get a bi-level (binary) image out of a
grayscale image or for removing a noise, that is, filtering out pixels with
too small or too large values. There are several types of thresholding
supported by the function.
Example:
@
grayBirds :: Mat (ShapeT [341, 512]) ('S 1) ('S Word8)
grayBirds = exceptError $ cvtColor bgr gray birds_512x341
threshBinaryBirds :: Mat (ShapeT [341, 512]) ('S 3) ('S Word8)
threshBinaryBirds =
exceptError $ cvtColor gray bgr $ fst $ exceptError $
threshold (ThreshVal_Abs 100) (Thresh_Binary 150) grayBirds
threshBinaryInvBirds :: Mat (ShapeT [341, 512]) ('S 3) ('S Word8)
threshBinaryInvBirds =
exceptError $ cvtColor gray bgr $ fst $ exceptError $
threshold (ThreshVal_Abs 100) (Thresh_BinaryInv 150) grayBirds
threshTruncateBirds :: Mat (ShapeT [341, 512]) ('S 3) ('S Word8)
threshTruncateBirds =
exceptError $ cvtColor gray bgr $ fst $ exceptError $
threshold (ThreshVal_Abs 100) Thresh_Truncate grayBirds
threshToZeroBirds :: Mat (ShapeT [341, 512]) ('S 3) ('S Word8)
threshToZeroBirds =
exceptError $ cvtColor gray bgr $ fst $ exceptError $
threshold (ThreshVal_Abs 100) Thresh_ToZero grayBirds
threshToZeroInvBirds :: Mat (ShapeT [341, 512]) ('S 3) ('S Word8)
threshToZeroInvBirds =
exceptError $ cvtColor gray bgr $ fst $ exceptError $
threshold (ThreshVal_Abs 100) Thresh_ToZeroInv grayBirds
@
<<doc/generated/examples/threshBinaryBirds.png threshBinaryBirds>>
<<doc/generated/examples/threshBinaryInvBirds.png threshBinaryInvBirds>>
<<doc/generated/examples/threshTruncateBirds.png threshTruncateBirds>>
<<doc/generated/examples/threshToZeroBirds.png threshToZeroBirds>>
<<doc/generated/examples/threshToZeroInvBirds.png threshToZeroInvBirds>>
<http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/miscellaneous_transformations.html#threshold OpenCV Sphinx doc>
-}
threshold
:: (depth `In` [Word8, Float])
=> ThreshValue -- ^
-> ThreshType
-> (Mat shape ('S 1) ('S depth))
-> CvExcept (Mat shape ('S 1) ('S depth), Double)
threshold threshVal threshType src = unsafeWrapException $ do
dst <- newEmptyMat
alloca $ \calcThreshPtr ->
handleCvException ((unsafeCoerceMat dst, ) . realToFrac <$> peek calcThreshPtr) $
withPtr src $ \srcPtr ->
withPtr dst $ \dstPtr ->
[cvExcept|
*$(double * calcThreshPtr) =
cv::threshold( *$(Mat * srcPtr)
, *$(Mat * dstPtr)
, $(double c'threshVal)
, $(double c'maxVal)
, $(int32_t c'type)
);
|]
where
c'type = c'threshType .|. c'threshValMode
(c'threshType, c'maxVal) = marshalThreshType threshType
(c'threshValMode, c'threshVal) = marshalThreshValue threshVal
{- | Performs a marker-based image segmentation using the watershed algorithm.
The function implements one of the variants of watershed, non-parametric marker-based segmentation algorithm, described in [Meyer, F. Color Image Segmentation, ICIP92, 1992].
Before passing the image to the function, you have to roughly outline the desired regions in the image markers with positive (>0) indices. So, every region is represented as one or more connected components with the pixel values 1, 2, 3, and so on. Such markers can be retrieved from a binary mask using 'findContours' and 'drawContours'. The markers are “seeds” of the future image regions. All the other pixels in markers , whose relation to the outlined regions is not known and should be defined by the algorithm, should be set to 0’s. In the function output, each pixel in markers is set to a value of the “seed” components or to -1 at boundaries between the regions.
<http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/miscellaneous_transformations.html#watershed OpenCV Sphinx doc>
-}
watershed
:: (PrimMonad m)
=> Mat ('S [h, w]) ('S 3) ('S Word8) -- ^ Input 8-bit 3-channel image
-> Mut (Mat ('S [h, w]) ('S 1) ('S Int32)) (PrimState m) -- ^ Input/output 32-bit single-channel image (map) of markers
-> CvExceptT m ()
watershed img markers =
unsafePrimToPrim $
withPtr img $ \imgPtr ->
withPtr markers $ \markersPtr ->
[C.exp|void {
cv::watershed( *$(Mat * imgPtr)
, *$(Mat * markersPtr)
)
}|]
{- | Runs the <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/miscellaneous_transformations.html#grabcut GrabCut> algorithm.
Example:
@
grabCutBird :: Birds_512x341
grabCutBird = exceptError $ do
mask <- withMatM (Proxy :: Proxy [341, 512])
(Proxy :: Proxy 1)
(Proxy :: Proxy Word8)
black $ \\mask -> do
fgTmp <- mkMatM (Proxy :: Proxy [1, 65]) (Proxy :: Proxy 1) (Proxy :: Proxy Double) black
bgTmp <- mkMatM (Proxy :: Proxy [1, 65]) (Proxy :: Proxy 1) (Proxy :: Proxy Double) black
grabCut birds_512x341 mask fgTmp bgTmp 5 (GrabCut_InitWithRect rect)
mask' <- matScalarCompare mask 3 Cmp_Ge
withMatM (Proxy :: Proxy [341, 512])
(Proxy :: Proxy 3)
(Proxy :: Proxy Word8)
transparent $ \\imgM -> do
matCopyToM imgM (V2 0 0) birds_512x341 (Just mask')
where
rect :: Rect Int32
rect = toRect $ HRect { hRectTopLeft = V2 264 60, hRectSize = V2 248 281 }
@
<<doc/generated/examples/grabCutBird.png grabCutBird>>
-}
grabCut
:: ( PrimMonad m
, depth `In` '[ 'D, 'S Word8 ]
)
=> Mat shape ('S 3) depth
-- ^ Input 8-bit 3-channel image.
-> Mut (Mat shape ('S 1) ('S Word8)) (PrimState m)
-- ^ Input/output 8-bit single-channel mask. The mask is initialized by the function when mode is set to GC_INIT_WITH_RECT. Its elements may have one of following values:
--
-- * GC_BGD defines an obvious background pixels.
--
-- * GC_FGD defines an obvious foreground (object) pixel.
--
-- * GC_PR_BGD defines a possible background pixel.
--
-- * GC_PR_FGD defines a possible foreground pixel.
-> Mut (Mat ('S ['S 1, 'S 65]) ('S 1) ('S Double)) (PrimState m)
-- ^ Temporary array for the background model. Do not modify it while you are processing the same image.
-> Mut (Mat ('S ['S 1, 'S 65]) ('S 1) ('S Double)) (PrimState m)
-- ^ Temporary arrays for the foreground model. Do not modify it while you are processing the same image.
-> Int32
-- ^ Number of iterations the algorithm should make before returning the result. Note that the result can be refined with further calls with mode==GC_INIT_WITH_MASK or mode==GC_EVAL.
-> GrabCutOperationMode
-- ^ Operation mode
-> CvExceptT m ()
grabCut img mask bgdModel fgdModel iterCount mode =
unsafePrimToPrim $
withPtr img $ \imgPtr ->
withPtr mask $ \maskPtr ->
withPtr rect $ \rectPtr ->
withPtr bgdModel $ \bgdModelPtr ->
withPtr fgdModel $ \fgdModelPtr ->
[C.block|void {
cv::grabCut( *$(Mat * imgPtr)
, *$(Mat * maskPtr)
, *$(Rect2i * rectPtr)
, *$(Mat * bgdModelPtr)
, *$(Mat * fgdModelPtr)
, $(int32_t iterCount)
, $(int32_t c'modeFlags)
);
}|]
where
rect = marshalGrabCutOperationModeRect mode
c'modeFlags = marshalGrabCutOperationMode mode
{- | Returns 0 if the pixels are not in the range, 255 otherwise. -}
inRange ::
(ToScalar scalar)
=> Mat ('S [w, h]) channels depth
-> scalar -- ^ Lower bound
-> scalar -- ^ Upper bound
-> CvExcept (Mat ('S [w, h]) ('S 1) ('S Word8))
inRange src lo hi = unsafeWrapException $ do
dst <- newEmptyMat
withPtr src $ \srcPtr ->
handleCvException (return (unsafeCoerceMat dst)) $
withPtr (toScalar lo) $ \loPtr ->
withPtr (toScalar hi) $ \hiPtr ->
withPtr dst $ \dstPtr ->
[cvExcept|
cv::inRange(*$(Mat * srcPtr), *$(Scalar * loPtr), *$(Scalar * hiPtr), *$(Mat * dstPtr));
|]