#if __GLASGOW_HASKELL__ >= 800
#endif
module OpenCV.Core.ArrayOps
(
matScalarAdd
, matScalarMult
, matAbs
, matAbsDiff
, matAdd
, matSubtract
, matAddWeighted
, matScaleAdd
, matMax
, CmpType(..)
, matScalarCompare
, bitwiseNot
, bitwiseAnd
, bitwiseOr
, bitwiseXor
, matMerge
, matSplit
, matChannelMapM
, minMaxLoc
, NormType(..)
, NormAbsRel(..)
, norm
, normDiff
, normalize
, matSum
, matSumM
, meanStdDev
, matFlip, FlipDirection(..)
, matTranspose
, hconcat
, vconcat
, perspectiveTransform
) where
import "base" Data.Proxy ( Proxy(..) )
import "base" Data.Word
import "base" Foreign.C.Types ( CDouble )
import "base" Foreign.Marshal.Alloc ( alloca )
import "base" Foreign.Marshal.Array ( allocaArray, peekArray )
import "base" Foreign.Ptr ( Ptr, castPtr )
import "base" Foreign.Storable ( Storable(..), peek )
import "base" GHC.TypeLits
import "base" Data.Int ( Int32 )
import "base" System.IO.Unsafe ( unsafePerformIO )
import qualified "inline-c" Language.C.Inline as C
import qualified "inline-c-cpp" Language.C.Inline.Cpp as C
import "linear" Linear.Vector ( zero )
import "linear" Linear.V2 ( V2(..) )
import "primitive" Control.Monad.Primitive ( PrimMonad, PrimState, unsafePrimToPrim )
import "this" OpenCV.Core.Types.Mat
import "this" OpenCV.Core.Types.Point
import "this" OpenCV.Internal.C.Inline ( openCvCtx )
import "this" OpenCV.Internal.C.Types
import "this" OpenCV.Internal.Core.ArrayOps
import "this" OpenCV.Internal.Core.Types
import "this" OpenCV.Internal.Core.Types.Mat
import "this" OpenCV.Internal.Exception
import "this" OpenCV.Internal.Mutable
import "this" OpenCV.TypeLevel
import "transformers" Control.Monad.Trans.Except
import qualified "vector" Data.Vector as V
C.context openCvCtx
C.include "opencv2/core.hpp"
C.using "namespace cv"
matScalarAdd
:: (ToScalar scalar)
=> Mat shape channels depth
-> scalar
-> Mat shape channels depth
matScalarAdd src x = unsafePerformIO $ do
dst <- newEmptyMat
withPtr (toScalar x) $ \xPtr ->
withPtr dst $ \dstPtr ->
withPtr src $ \srcPtr ->
[C.block| void {
*$(Mat * dstPtr) = *$(Mat * srcPtr) + *$(Scalar * xPtr);
}|]
pure $ unsafeCoerceMat dst
matScalarMult
:: Mat shape channels depth
-> Double
-> Mat shape channels depth
matScalarMult src x = unsafePerformIO $ do
dst <- newEmptyMat
withPtr dst $ \dstPtr ->
withPtr src $ \srcPtr ->
[C.block| void {
*$(Mat * dstPtr) = *$(Mat * srcPtr) * $(double c'x);
}|]
pure $ unsafeCoerceMat dst
where
c'x = realToFrac x
matAbs
:: Mat shape channels depth
-> Mat shape channels depth
matAbs src = unsafePerformIO $ do
dst <- newEmptyMat
withPtr dst $ \dstPtr ->
withPtr src $ \srcPtr ->
[C.block| void {
*$(Mat * dstPtr) = cv::abs(*$(Mat * srcPtr));
}|]
pure $ unsafeCoerceMat dst
matAbsDiff
:: Mat shape channels depth
-> Mat shape channels depth
-> Mat shape channels depth
matAbsDiff src1 src2 = unsafePerformIO $ do
dst <- newEmptyMat
withPtr dst $ \dstPtr ->
withPtr src1 $ \src1Ptr ->
withPtr src2 $ \src2Ptr ->
[C.block| void {
cv::absdiff( *$(Mat * src1Ptr)
, *$(Mat * src2Ptr)
, *$(Mat * dstPtr )
);
}|]
pure $ unsafeCoerceMat dst
matAdd
:: Mat shape channels depth
-> Mat shape channels depth
-> Mat shape channels depth
matAdd src1 src2 = unsafePerformIO $ do
dst <- newEmptyMat
withPtr dst $ \dstPtr ->
withPtr src1 $ \src1Ptr ->
withPtr src2 $ \src2Ptr ->
[C.block| void {
cv::add
( *$(Mat * src1Ptr)
, *$(Mat * src2Ptr)
, *$(Mat * dstPtr)
, cv::noArray()
);
}|]
pure $ unsafeCoerceMat dst
matSubtract
:: Mat shape channels depth
-> Mat shape channels depth
-> Mat shape channels depth
matSubtract src1 src2 = unsafePerformIO $ do
dst <- newEmptyMat
withPtr dst $ \dstPtr ->
withPtr src1 $ \src1Ptr ->
withPtr src2 $ \src2Ptr ->
[C.block| void {
cv::subtract
( *$(Mat * src1Ptr)
, *$(Mat * src2Ptr)
, *$(Mat * dstPtr)
, cv::noArray()
);
}|]
pure $ unsafeCoerceMat dst
matAddWeighted
:: forall shape channels srcDepth dstDepth
. (ToDepthDS (Proxy dstDepth))
=> Mat shape channels srcDepth
-> Double
-> Mat shape channels srcDepth
-> Double
-> Double
-> CvExcept (Mat shape channels dstDepth)
matAddWeighted src1 alpha src2 beta gamma = unsafeWrapException $ do
dst <- newEmptyMat
handleCvException (pure $ unsafeCoerceMat dst) $
withPtr src1 $ \src1Ptr ->
withPtr src2 $ \src2Ptr ->
withPtr dst $ \dstPtr ->
[cvExcept|
cv::addWeighted
( *$(Mat * src1Ptr)
, $(double c'alpha)
, *$(Mat * src2Ptr)
, $(double c'beta)
, $(double c'gamma)
, *$(Mat * dstPtr)
, $(int32_t c'dtype)
);
|]
where
c'alpha = realToFrac alpha
c'beta = realToFrac beta
c'gamma = realToFrac gamma
c'dtype = maybe (1) marshalDepth $ dsToMaybe $ toDepthDS (Proxy :: Proxy dstDepth)
matScaleAdd
:: Mat shape channels depth
-> Double
-> Mat shape channels depth
-> CvExcept (Mat shape channels depth)
matScaleAdd src1 scale src2 = unsafeWrapException $ do
dst <- newEmptyMat
handleCvException (pure $ unsafeCoerceMat dst) $
withPtr src1 $ \src1Ptr ->
withPtr src2 $ \src2Ptr ->
withPtr dst $ \dstPtr ->
[cvExcept|
cv::scaleAdd
( *$(Mat * src1Ptr)
, $(double c'scale)
, *$(Mat * src2Ptr)
, *$(Mat * dstPtr)
);
|]
where
c'scale = realToFrac scale
matMax
:: Mat shape channels depth
-> Mat shape channels depth
-> CvExcept (Mat shape channels depth)
matMax src1 src2 = unsafeWrapException $ do
dst <- newEmptyMat
handleCvException (pure $ unsafeCoerceMat dst) $
withPtr dst $ \dstPtr ->
withPtr src1 $ \src1Ptr ->
withPtr src2 $ \src2Ptr ->
[cvExcept|
cv::max
( *$(Mat * src1Ptr)
, *$(Mat * src2Ptr)
, *$(Mat * dstPtr)
);
|]
matScalarCompare
:: Mat shape channels depth
-> Double
-> CmpType
-> CvExcept (Mat shape channels depth)
matScalarCompare src x cmpType = unsafeWrapException $ do
dst <- newEmptyMat
handleCvException (pure $ unsafeCoerceMat dst) $
withPtr dst $ \dstPtr ->
withPtr src $ \srcPtr ->
[cvExcept|
cv::compare
( *$(Mat * srcPtr)
, $(double c'x)
, *$(Mat * dstPtr)
, $(int32_t c'cmpOp)
);
|]
where
c'x = realToFrac x
c'cmpOp = marshalCmpType cmpType
bitwiseNot
:: Mat shape channels depth
-> CvExcept (Mat shape channels depth)
bitwiseNot src = unsafeWrapException $ do
dst <- newEmptyMat
handleCvException (pure $ unsafeCoerceMat dst) $
withPtr src $ \srcPtr ->
withPtr dst $ \dstPtr ->
[cvExcept|
cv::bitwise_not
( *$(Mat * srcPtr)
, *$(Mat * dstPtr)
, cv::noArray()
);
|]
bitwiseAnd
:: Mat shape channels depth
-> Mat shape channels depth
-> CvExcept (Mat shape channels depth)
bitwiseAnd src1 src2 = unsafeWrapException $ do
dst <- newEmptyMat
handleCvException (pure $ unsafeCoerceMat dst) $
withPtr src1 $ \src1Ptr ->
withPtr src2 $ \src2Ptr ->
withPtr dst $ \dstPtr ->
[cvExcept|
cv::bitwise_and
( *$(Mat * src1Ptr)
, *$(Mat * src2Ptr)
, *$(Mat * dstPtr)
, cv::noArray()
);
|]
bitwiseOr
:: Mat shape channels depth
-> Mat shape channels depth
-> CvExcept (Mat shape channels depth)
bitwiseOr src1 src2 = unsafeWrapException $ do
dst <- newEmptyMat
handleCvException (pure $ unsafeCoerceMat dst) $
withPtr src1 $ \src1Ptr ->
withPtr src2 $ \src2Ptr ->
withPtr dst $ \dstPtr ->
[cvExcept|
cv::bitwise_or
( *$(Mat * src1Ptr)
, *$(Mat * src2Ptr)
, *$(Mat * dstPtr)
, cv::noArray()
);
|]
bitwiseXor
:: Mat shape channels depth
-> Mat shape channels depth
-> CvExcept (Mat shape channels depth)
bitwiseXor src1 src2 = unsafeWrapException $ do
dst <- newEmptyMat
handleCvException (pure $ unsafeCoerceMat dst) $
withPtr src1 $ \src1Ptr ->
withPtr src2 $ \src2Ptr ->
withPtr dst $ \dstPtr ->
[cvExcept|
cv::bitwise_xor
( *$(Mat * src1Ptr)
, *$(Mat * src2Ptr)
, *$(Mat * dstPtr)
, cv::noArray()
);
|]
matMerge
:: V.Vector (Mat shape ('S 1) depth)
-> Mat shape 'D depth
matMerge srcVec = unsafePerformIO $ do
dst <- newEmptyMat
withArrayPtr srcVec $ \srcVecPtr ->
withPtr dst $ \dstPtr ->
[C.block| void {
cv::merge
( $(Mat * srcVecPtr)
, $(size_t c'srcVecLength)
, *$(Mat * dstPtr)
);
}|]
pure $ unsafeCoerceMat dst
where
c'srcVecLength = fromIntegral $ V.length srcVec
matSplit
:: Mat shape channels depth
-> V.Vector (Mat shape ('S 1) depth)
matSplit src = unsafePerformIO $
withPtr src $ \srcPtr ->
allocaArray numChans $ \(splitsArray :: Ptr (Ptr C'Mat)) -> do
[C.block| void {
cv::Mat * srcPtr = $(Mat * srcPtr);
int32_t numChans = $(int32_t c'numChans);
cv::Mat *splits = new cv::Mat[numChans];
cv::split(*srcPtr, splits);
for(int i = 0; i < numChans; i++){
$(Mat * * splitsArray)[i] = new cv::Mat(splits[i]);
}
delete [] splits;
}|]
fmap V.fromList . mapM (fromPtr . pure) =<< peekArray numChans splitsArray
where
numChans = fromIntegral $ miChannels $ matInfo src
c'numChans :: Int32
c'numChans = fromIntegral numChans
matChannelMapM
:: Monad m
=> (Mat shape ('S 1) depth -> m (Mat shape ('S 1) depth))
-> Mat shape channelsOut depth
-> m (Mat shape channelsOut depth)
matChannelMapM f img = unsafeCoerceMat . matMerge <$> V.mapM f (matSplit img)
minMaxLoc
:: Mat ('S [height, width]) channels depth
-> CvExcept (Double, Double, Point2i, Point2i)
minMaxLoc src = unsafeWrapException $ do
minLoc <- toPointIO $ V2 0 0
maxLoc <- toPointIO $ V2 0 0
withPtr src $ \srcPtr ->
withPtr minLoc $ \minLocPtr ->
withPtr maxLoc $ \maxLocPtr ->
alloca $ \minValPtr ->
alloca $ \maxValPtr -> do
handleCvException
( (,, minLoc, maxLoc)
<$> (realToFrac <$> peek minValPtr)
<*> (realToFrac <$> peek maxValPtr)
)
[cvExcept|
cv::minMaxLoc( *$(Mat * srcPtr)
, $(double * minValPtr)
, $(double * maxValPtr)
, $(Point2i * minLocPtr)
, $(Point2i * maxLocPtr)
);
|]
norm
:: NormType
-> Maybe (Mat shape ('S 1) ('S Word8))
-> Mat shape channels depth
-> CvExcept Double
norm normType mbMask src = unsafeWrapException $
withPtr src $ \srcPtr ->
withPtr mbMask $ \mskPtr ->
alloca $ \normPtr ->
handleCvException (realToFrac <$> peek normPtr) $
[cvExcept|
Mat * mskPtr = $(Mat * mskPtr);
*$(double * normPtr) =
cv::norm( *$(Mat * srcPtr)
, $(int32_t c'normType)
, mskPtr ? _InputArray(*mskPtr) : _InputArray(cv::noArray())
);
|]
where
c'normType = marshalNormType NormAbsolute normType
normDiff
:: NormAbsRel
-> NormType
-> Maybe (Mat shape ('S 1) ('S Word8))
-> Mat shape channels depth
-> Mat shape channels depth
-> CvExcept Double
normDiff absRel normType mbMask src1 src2 = unsafeWrapException $
withPtr src1 $ \src1Ptr ->
withPtr src2 $ \src2Ptr ->
withPtr mbMask $ \mskPtr ->
alloca $ \normPtr ->
handleCvException (realToFrac <$> peek normPtr) $
[cvExcept|
Mat * mskPtr = $(Mat * mskPtr);
*$(double * normPtr) =
cv::norm( *$(Mat * src1Ptr)
, *$(Mat * src2Ptr)
, $(int32_t c'normType)
, mskPtr ? _InputArray(*mskPtr) : _InputArray(cv::noArray())
);
|]
where
c'normType = marshalNormType absRel normType
normalize
:: forall shape channels srcDepth dstDepth
. (ToDepthDS (Proxy dstDepth))
=> Double
-> Double
-> NormType
-> Maybe (Mat shape ('S 1) ('S Word8))
-> Mat shape channels srcDepth
-> CvExcept (Mat shape channels dstDepth)
normalize alpha beta normType mbMask src = unsafeWrapException $ do
dst <- newEmptyMat
handleCvException (pure $ unsafeCoerceMat dst) $
withPtr src $ \srcPtr ->
withPtr dst $ \dstPtr ->
withPtr mbMask $ \mskPtr ->
[cvExcept|
Mat * mskPtr = $(Mat * mskPtr);
cv::normalize( *$(Mat * srcPtr)
, *$(Mat * dstPtr)
, $(double c'alpha)
, $(double c'beta)
, $(int32_t c'normType)
, $(int32_t c'dtype)
, mskPtr ? _InputArray(*mskPtr) : _InputArray(cv::noArray())
);
|]
where
c'alpha = realToFrac alpha
c'beta = realToFrac beta
c'normType = marshalNormType NormAbsolute normType
c'dtype = maybe (1) marshalDepth $ dsToMaybe $ toDepthDS (Proxy :: Proxy dstDepth)
matSum
:: Mat shape channels depth
-> CvExcept Scalar
matSum src = runCvExceptST $ matSumM =<< unsafeThaw src
matSumM
:: (PrimMonad m)
=> Mut (Mat shape channels depth) (PrimState m)
-> CvExceptT m Scalar
matSumM srcM = ExceptT $ unsafePrimToPrim $ do
s <- newScalar zero
handleCvException (pure s) $
withPtr srcM $ \srcPtr ->
withPtr s $ \sPtr ->
[cvExcept|
*$(Scalar * sPtr) = cv::sum(*$(Mat * srcPtr));
|]
meanStdDev
:: (1 <= channels, channels <= 4)
=> Mat shape ('S channels) depth
-> Maybe (Mat shape ('S 1) ('S Word8))
-> CvExcept (Scalar, Scalar)
meanStdDev src mask = unsafeWrapException $ do
mean <- newScalar $ pure 0
stddev <- newScalar $ pure 0
handleCvException (pure (mean, stddev)) $
withPtr src $ \srcPtr ->
withPtr mask $ \maskPtr ->
withPtr mean $ \meanPtr ->
withPtr stddev $ \stddevPtr ->
[cvExcept|
cv::Mat * maskPtr = $(Mat * maskPtr);
cv::meanStdDev
( *$(Mat * srcPtr)
, *$(Scalar * meanPtr)
, *$(Scalar * stddevPtr)
, maskPtr ? cv::_InputArray(*maskPtr) : cv::_InputArray(cv::noArray())
);
|]
matFlip
:: Mat ('S '[height, width]) channels depth
-> FlipDirection
-> Mat ('S '[height, width]) channels depth
matFlip src flipDir = unsafePerformIO $ do
dst <- newEmptyMat
withPtr dst $ \dstPtr ->
withPtr src $ \srcPtr ->
[C.block| void {
cv::flip(*$(Mat * srcPtr), *$(Mat * dstPtr), $(int32_t flipCode));
}|]
pure $ unsafeCoerceMat dst
where
flipCode :: Int32
flipCode = marshallFlipDirection flipDir
data FlipDirection = FlipVertically
| FlipHorizontally
| FlipBoth
deriving (Show, Eq)
marshallFlipDirection :: FlipDirection -> Int32
marshallFlipDirection = \case
FlipVertically -> 0
FlipHorizontally -> 1
FlipBoth -> 1
matTranspose
:: Mat ('S '[height, width]) channels depth
-> Mat ('S '[width, height]) channels depth
matTranspose src = unsafePerformIO $ do
dst <- newEmptyMat
withPtr dst $ \dstPtr ->
withPtr src $ \srcPtr ->
[C.block| void {
cv::transpose(*$(Mat * srcPtr), *$(Mat * dstPtr));
}|]
pure $ unsafeCoerceMat dst
hconcat
:: V.Vector (Mat ('S '[rows, 'D]) channels depth)
-> CvExcept (Mat ('S '[rows, 'D]) channels depth)
hconcat mats = unsafeWrapException $ do
dst <- unsafeCoerceMat <$> newEmptyMat
handleCvException (pure dst) $
withArrayPtr mats $ \matsPtr ->
withPtr dst $ \dstPtr ->
[cvExcept|
cv::hconcat
( $(Mat * matsPtr)
, $(size_t c'numMats)
, *$(Mat * dstPtr)
);
|]
where
c'numMats :: C.CSize
c'numMats = fromIntegral $ V.length mats
vconcat
:: V.Vector (Mat ('S '[ 'D, cols ]) channels depth)
-> CvExcept (Mat ('S '[ 'D, cols ]) channels depth)
vconcat mats = unsafeWrapException $ do
dst <- unsafeCoerceMat <$> newEmptyMat
handleCvException (pure dst) $
withArrayPtr mats $ \matsPtr ->
withPtr dst $ \dstPtr ->
[cvExcept|
cv::vconcat
( $(Mat * matsPtr)
, $(size_t c'numMats)
, *$(Mat * dstPtr)
);
|]
where
c'numMats :: C.CSize
c'numMats = fromIntegral $ V.length mats
perspectiveTransform
:: (IsPoint2 point2 CDouble)
=> V.Vector (point2 CDouble)
-> Mat ('S '[ 'S 3, 'S 3 ]) ('S 1) ('S Double)
-> V.Vector Point2d
perspectiveTransform srcPoints transformationMat = unsafePerformIO $
withArrayPtr (V.map toPoint srcPoints) $ \srcPtr ->
withPtr transformationMat $ \tmPtr ->
allocaArray numPts $ \(dstPtr :: Ptr (V2 CDouble)) -> do
let dstPtr' = castPtr dstPtr
[C.block| void {
cv::_InputArray srcPts = cv::_InputArray( $(Point2d * srcPtr), $(int32_t c'numPts));
cv::_OutputArray dstPts = cv::_OutputArray($(Point2d * dstPtr'), $(int32_t c'numPts));
cv::perspectiveTransform
( srcPts
, dstPts
, *$(Mat * tmPtr)
);
}|]
peekArray numPts dstPtr >>= return . V.fromList . map toPoint
where
numPts = fromIntegral $ V.length srcPoints
c'numPts = fromIntegral $ V.length srcPoints