module OpenCV.Extra.Tracking
( Tracker(..)
, MultiTracker (..)
, MultiTrackerAlt (..)
, TrackerType (..)
, TrackerFeature (..)
, TrackerFeatureType (..)
, newTracker
, initTracker
, updateTracker
, newMultiTracker
, newTrackerFeature
) where
import "base" Data.Word
import "base" Foreign.ForeignPtr ( ForeignPtr, withForeignPtr )
import "base" Foreign.C.String ( withCString )
import "base" Foreign.Marshal.Utils ( toBool )
import qualified "inline-c" Language.C.Inline as C
import qualified "inline-c" Language.C.Inline.Unsafe as CU
import qualified "inline-c-cpp" Language.C.Inline.Cpp as C
import "opencv" OpenCV.Core.Types
import "opencv" OpenCV.Internal
import "opencv" OpenCV.TypeLevel
import "opencv" OpenCV.Internal.C.Types
import "primitive" Control.Monad.Primitive
import "this" OpenCV.Extra.Internal.C.Inline ( openCvExtraCtx )
import "this" OpenCV.Extra.Internal.C.Types
C.context openCvExtraCtx
C.include "opencv2/core.hpp"
C.include "opencv2/tracking.hpp"
C.include "tracking.hpp"
C.using "namespace cv"
data TrackerType
= BOOSTING
| MIL
| KCF
| MEDIANFLOW
| TLD
deriving (Eq, Show, Enum, Bounded)
data TrackerFeatureType
= HAAR
| HOG
| LBP
| FEATURE2D
deriving (Eq, Show, Enum, Bounded)
newtype Tracker s = Tracker { unTracker :: ForeignPtr C'Ptr_Tracker }
type instance C (Tracker s) = C'Ptr_Tracker
instance WithPtr (Tracker s) where
withPtr = withForeignPtr . unTracker
instance FromPtr (Tracker s) where
fromPtr = objFromPtr Tracker $ \ptr ->
[CU.block| void {
delete $(Ptr_Tracker * ptr);
}|]
newTracker
:: (PrimMonad m)
=> TrackerType
-> m (Tracker (PrimState m))
newTracker trackerType =
unsafePrimToPrim $ fromPtr $
withCString (show trackerType) $ \c'trackerType ->
[CU.block|Ptr_Tracker * {
cv::Ptr<cv::Tracker> tacker =
cv::Tracker::create ( cv::String($(const char * c'trackerType)));
return new cv::Ptr<cv::Tracker>(tacker);
}|]
initTracker
:: (PrimMonad m, IsRect rect C.CDouble)
=> Tracker (PrimState m)
-> Mat ('S '[ 'D, 'D]) ('D) ('D)
-> rect C.CDouble
-> m Bool
initTracker trk srcImg boundingBox = unsafePrimToPrim $
withPtr trk $ \trkPtr ->
withPtr srcImg $ \srcPtr ->
withPtr (toRect boundingBox) $ \rectPtr -> toBool <$>
[C.block| bool {
return (*$(Ptr_Tracker * trkPtr))->init
( *$(Mat * srcPtr)
, *$(Rect2d * rectPtr)
);
}
|]
updateTracker
:: (PrimMonad m)
=> Tracker (PrimState m)
-> Mat ('D) ('D) ('S Word8)
-> m (Maybe (Rect C.CDouble))
updateTracker trk srcImg = unsafePrimToPrim $
withPtr trk $ \trkPtr ->
withPtr srcImg $ \srcPtr ->
withPtr rect $ \rectPtr -> do
ok <- toBool <$> [C.block| bool {
return (*$(Ptr_Tracker * trkPtr))->update
( *$(Mat * srcPtr)
, *$(Rect2d * rectPtr)
);
}
|]
return $ if ok
then
Just rect
else
Nothing
where
rect :: Rect2d
rect = toRect HRect{ hRectTopLeft = pure 0
, hRectSize = pure 0
}
newtype TrackerFeature s = TrackerFeature { unTrackerFeature :: ForeignPtr C'Ptr_TrackerFeature }
type instance C (TrackerFeature s) = C'Ptr_TrackerFeature
instance WithPtr (TrackerFeature s) where
withPtr = withForeignPtr . unTrackerFeature
instance FromPtr (TrackerFeature s) where
fromPtr = objFromPtr TrackerFeature $ \ptr ->
[CU.block| void {
delete $(Ptr_TrackerFeature * ptr);
}|]
newtype MultiTracker s = MultiTracker { unMultiTracker :: ForeignPtr C'Ptr_MultiTracker }
type instance C (MultiTracker s) = C'Ptr_MultiTracker
instance WithPtr (MultiTracker s) where
withPtr = withForeignPtr . unMultiTracker
instance FromPtr (MultiTracker s) where
fromPtr = objFromPtr MultiTracker $ \ptr ->
[CU.block| void {
delete $(Ptr_MultiTracker * ptr);
}|]
newtype MultiTrackerAlt s = MultiTrackerAlt { unMultiTrackerAlt :: ForeignPtr C'Ptr_MultiTrackerAlt }
type instance C (MultiTrackerAlt s) = C'Ptr_MultiTrackerAlt
instance WithPtr (MultiTrackerAlt s) where
withPtr = withForeignPtr . unMultiTrackerAlt
instance FromPtr (MultiTrackerAlt s) where
fromPtr = objFromPtr MultiTrackerAlt $ \ptr ->
[CU.block| void {
delete $(Ptr_MultiTrackerAlt * ptr);
}|]
newMultiTracker
:: (PrimMonad m)
=> TrackerType
-> m (MultiTracker (PrimState m))
newMultiTracker trackerType =
unsafePrimToPrim $ fromPtr $
withCString (show trackerType) $ \c'trackerType ->
[CU.block|Ptr_MultiTracker * {
cv::Ptr<cv::MultiTracker> mtracker =
new cv::MultiTracker ( cv::String($(const char * c'trackerType)));
return new cv::Ptr<cv::MultiTracker>(mtracker);
}|]
newTrackerFeature
:: (PrimMonad m)
=> TrackerFeatureType
-> m (TrackerFeature (PrimState m))
newTrackerFeature trackerFeatureType =
unsafePrimToPrim $ fromPtr $
withCString (show trackerFeatureType) $ \c'trackerFeatureType ->
[CU.block|Ptr_TrackerFeature * {
cv::Ptr<cv::TrackerFeature> ftracker =
cv::TrackerFeature::create ( cv::String($(const char * c'trackerFeatureType)));
return new cv::Ptr<cv::TrackerFeature>(ftracker);
}|]