module OpenCV.Calib3d
( FundamentalMatMethod(..)
, FindHomographyMethod(..)
, FindHomographyParams(..)
, WhichImage(..)
, findFundamentalMat
, findHomography
, computeCorrespondEpilines
) where
import "base" Data.Int
import "base" Data.Word
import "base" Foreign.C.Types
import qualified "inline-c" Language.C.Inline as C
import qualified "inline-c-cpp" Language.C.Inline.Cpp as C
import "data-default" Data.Default
import "this" OpenCV.Internal.C.Inline ( openCvCtx )
import "this" OpenCV.Internal.C.Types
import "this" OpenCV.Internal.Calib3d.Constants
import "this" OpenCV.Core.Types
import "this" OpenCV.Internal.Core.Types
import "this" OpenCV.Internal.Core.Types.Mat
import "this" OpenCV.Internal.Exception
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.include "opencv2/calib3d.hpp"
C.using "namespace cv"
data FundamentalMatMethod
= FM_7Point
| FM_8Point
| FM_Ransac !(Maybe Double) !(Maybe Double)
| FM_Lmeds !(Maybe Double)
deriving (Show, Eq)
marshalFundamentalMatMethod :: FundamentalMatMethod -> (Int32, CDouble, CDouble)
marshalFundamentalMatMethod = \case
FM_7Point -> (c'CV_FM_7POINT, 0, 0)
FM_8Point -> (c'CV_FM_8POINT, 0, 0)
FM_Ransac p1 p2 -> (c'CV_FM_RANSAC, maybe 3 realToFrac p1, maybe 0.99 realToFrac p2)
FM_Lmeds p2 -> (c'CV_FM_LMEDS, 0, maybe 0.99 realToFrac p2)
data WhichImage = Image1 | Image2 deriving (Show, Eq)
marshalWhichImage :: WhichImage -> Int32
marshalWhichImage = \case
Image1 -> 1
Image2 -> 2
data FindHomographyMethod
= FindHomographyMethod_0
| FindHomographyMethod_RANSAC
| FindHomographyMethod_LMEDS
| FindHomographyMethod_RHO
deriving (Show)
marshalFindHomographyMethod :: FindHomographyMethod -> Int32
marshalFindHomographyMethod = \case
FindHomographyMethod_0 -> 0
FindHomographyMethod_RANSAC -> c'RANSAC
FindHomographyMethod_LMEDS -> c'LMEDS
FindHomographyMethod_RHO -> c'RHO
findFundamentalMat
:: (IsPoint2 point2 CDouble)
=> V.Vector (point2 CDouble)
-> V.Vector (point2 CDouble)
-> FundamentalMatMethod
-> CvExcept ( Maybe ( Mat ('S '[ 'D, 'S 3 ]) ('S 1) ('S Double)
, Mat ('S '[ 'D, 'D ]) ('S 1) ('S Word8 )
)
)
findFundamentalMat pts1 pts2 method = do
(fm, pointMask) <- c'findFundamentalMat
catchE (Just . (, unsafeCoerceMat pointMask) <$> coerceMat fm)
(\case CoerceMatError _msgs -> pure Nothing
otherError -> throwE otherError
)
where
c'findFundamentalMat = unsafeWrapException $ do
fm <- newEmptyMat
pointMask <- newEmptyMat
handleCvException (pure (fm, pointMask)) $
withPtr fm $ \fmPtr ->
withPtr pointMask $ \pointMaskPtr ->
withArrayPtr (V.map toPoint pts1) $ \pts1Ptr ->
withArrayPtr (V.map toPoint pts2) $ \pts2Ptr ->
[cvExcept|
cv::_InputArray pts1 = cv::_InputArray($(Point2d * pts1Ptr), $(int32_t c'numPts1));
cv::_InputArray pts2 = cv::_InputArray($(Point2d * pts2Ptr), $(int32_t c'numPts2));
*$(Mat * fmPtr) =
cv::findFundamentalMat
( pts1
, pts2
, $(int32_t c'method)
, $(double c'p1)
, $(double c'p2)
, *$(Mat * pointMaskPtr)
);
|]
c'numPts1 = fromIntegral $ V.length pts1
c'numPts2 = fromIntegral $ V.length pts2
(c'method, c'p1, c'p2) = marshalFundamentalMatMethod method
data FindHomographyParams
= FindHomographyParams
{ fhpMethod :: !FindHomographyMethod
, fhpRansacReprojThreshold :: !Double
, fhpMaxIters :: !Int
, fhpConfidence :: !Double
} deriving (Show)
instance Default FindHomographyParams where
def = FindHomographyParams
{ fhpMethod = FindHomographyMethod_0
, fhpRansacReprojThreshold = 3
, fhpMaxIters = 2000
, fhpConfidence = 0.995
}
findHomography
:: (IsPoint2 point2 CDouble)
=> V.Vector (point2 CDouble)
-> V.Vector (point2 CDouble)
-> FindHomographyParams
-> CvExcept ( Maybe ( Mat ('S '[ 'S 3, 'S 3 ]) ('S 1) ('S Double)
, Mat ('S '[ 'D, 'D ]) ('S 1) ('S Word8 )
)
)
findHomography srcPoints dstPoints fhp = do
(fm, pointMask) <- c'findHomography
catchE (Just . (, unsafeCoerceMat pointMask) <$> coerceMat fm)
(\case CoerceMatError _msgs -> pure Nothing
otherError -> throwE otherError
)
where
c'findHomography = unsafeWrapException $ do
fm <- newEmptyMat
pointMask <- newEmptyMat
handleCvException (pure (fm, pointMask)) $
withPtr fm $ \fmPtr ->
withPtr pointMask $ \pointMaskPtr ->
withArrayPtr (V.map toPoint srcPoints) $ \srcPtr ->
withArrayPtr (V.map toPoint dstPoints) $ \dstPtr ->
[cvExcept|
cv::_InputArray srcPts = cv::_InputArray($(Point2d * srcPtr), $(int32_t c'numSrcPts));
cv::_InputArray dstPts = cv::_InputArray($(Point2d * dstPtr), $(int32_t c'numDstPts));
*$(Mat * fmPtr) =
cv::findHomography
( srcPts
, dstPts
, $(int32_t c'method)
, $(double c'ransacReprojThreshold)
, *$(Mat * pointMaskPtr)
, $(int32_t c'maxIters)
, $(double c'confidence)
);
|]
c'numSrcPts = fromIntegral $ V.length srcPoints
c'numDstPts = fromIntegral $ V.length dstPoints
c'method = marshalFindHomographyMethod $ fhpMethod fhp
c'ransacReprojThreshold = realToFrac $ fhpRansacReprojThreshold fhp
c'maxIters = fromIntegral $ fhpMaxIters fhp
c'confidence = realToFrac $ fhpConfidence fhp
computeCorrespondEpilines
:: (IsPoint2 point2 CDouble)
=> V.Vector (point2 CDouble)
-> WhichImage
-> Mat (ShapeT [3, 3]) ('S 1) ('S Double)
-> CvExcept (Mat ('S ['D, 'S 1]) ('S 3) ('S Double))
computeCorrespondEpilines points whichImage fm = unsafeWrapException $ do
epilines <- newEmptyMat
handleCvException (pure $ unsafeCoerceMat epilines) $
withArrayPtr (V.map toPoint points) $ \pointsPtr ->
withPtr fm $ \fmPtr ->
withPtr epilines $ \epilinesPtr -> do
[cvExcept|
cv::_InputArray points =
cv::_InputArray( $(Point2d * pointsPtr)
, $(int32_t c'numPoints)
);
cv::computeCorrespondEpilines
( points
, $(int32_t c'whichImage)
, *$(Mat * fmPtr)
, *$(Mat * epilinesPtr)
);
|]
where
c'numPoints = fromIntegral $ V.length points
c'whichImage = marshalWhichImage whichImage