content: {-# language TemplateHaskell #-}
  {-# language QuasiQuotes #-}
  
  module OpenCV.Video.MotionAnalysis
      ( -- * BackgroundSubtractor
        BackgroundSubtractor(..)
        -- * Background subtractors
      , BackgroundSubtractorMOG2
      , BackgroundSubtractorKNN
      , newBackgroundSubtractorKNN
      , newBackgroundSubtractorMOG2
      ) where
  
  import "base" Control.Exception ( mask_ )
  import "base" Data.Int
  import "base" Data.Maybe
  import "base" Data.Word
  import "base" Foreign.ForeignPtr ( ForeignPtr, withForeignPtr )
  import "base" Foreign.Marshal.Alloc ( alloca )
  import "base" Foreign.Marshal.Utils ( fromBool, toBool )
  import "base" Foreign.Storable ( peek )
  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 "primitive" Control.Monad.Primitive
  import "this" OpenCV.Core.Types
  import "this" OpenCV.Internal
  import "this" OpenCV.Internal.C.FinalizerTH
  import "this" OpenCV.Internal.C.Inline ( openCvCtx )
  import "this" OpenCV.Internal.Core.Types.Mat
  import "this" OpenCV.Internal.C.Types
  import "this" OpenCV.TypeLevel
  
  --------------------------------------------------------------------------------
  
  C.context openCvCtx
  
  C.include "opencv2/core.hpp"
  C.include "opencv2/video.hpp"
  C.include "video_motion_analysis.hpp"
  
  C.using "namespace cv"
  
  --------------------------------------------------------------------------------
  -- BackgroundSubtractor
  --------------------------------------------------------------------------------
  
  class BackgroundSubtractor a where
      bgSubApply
          :: (PrimMonad m)
          => a (PrimState m)
          -> Double
             -- ^ The value between 0 and 1 that indicates how fast the background
             -- model is learnt. Negative parameter value makes the algorithm to
             -- use some automatically chosen learning rate. 0 means that the
             -- background model is not updated at all, 1 means that the
             -- background model is completely reinitialized from the last frame.
          -> Mat ('S [h, w]) channels depth
             -- ^ Next video frame.
          -> m (Mat ('S [h, w]) ('S 1) ('S Word8))
             -- ^ The output foreground mask as an 8-bit binary image.
  
      getBackgroundImage
          :: (PrimMonad m)
          => a (PrimState m)
          -> m (Mat ('S [h, w]) channels depth)
             -- ^ The output background image.
  
  {- |
  
  Example:
  
  @
  carAnim :: Animation (ShapeT [240, 320]) ('S 3) ('S Word8)
  carAnim = carOverhead
  
  mog2Anim :: IO (Animation (ShapeT [240, 320]) ('S 3) ('S Word8))
  mog2Anim = exceptErrorIO $ do
      mog2 <- newBackgroundSubtractorMOG2 Nothing Nothing Nothing
      for carOverhead $ \(delay, img) -> do
        fg <- bgSubApply mog2 0.1 img
        fgBgr <- cvtColor gray bgr fg
        pure (delay, fgBgr)
  @
  
  Original:
  <<doc/generated/examples/car.gif carAnim>>
  
  Foreground:
  <<doc/generated/examples/mog2.gif mog2Anim>>
  -}
  
  --------------------------------------------------------------------------------
  -- Background subtractors
  --------------------------------------------------------------------------------
  
  newtype BackgroundSubtractorKNN s
        = BackgroundSubtractorKNN
          { unBackgroundSubtractorKNN :: ForeignPtr C'Ptr_BackgroundSubtractorKNN }
  
  newtype BackgroundSubtractorMOG2 s
        = BackgroundSubtractorMOG2
          { unBackgroundSubtractorMOG2 :: ForeignPtr C'Ptr_BackgroundSubtractorMOG2 }
  
  type instance C (BackgroundSubtractorKNN  s) = C'Ptr_BackgroundSubtractorKNN
  type instance C (BackgroundSubtractorMOG2 s) = C'Ptr_BackgroundSubtractorMOG2
  
  instance WithPtr (BackgroundSubtractorKNN s) where
      withPtr = withForeignPtr . unBackgroundSubtractorKNN
  
  instance WithPtr (BackgroundSubtractorMOG2 s) where
      withPtr = withForeignPtr . unBackgroundSubtractorMOG2
  
  mkFinalizer ReleaseDeletePtr
              "deleteBackgroundSubtractorKNN"
              "cv::Ptr<cv::BackgroundSubtractorKNN>"
              ''C'Ptr_BackgroundSubtractorKNN
  
  instance FromPtr (BackgroundSubtractorKNN s) where
      fromPtr = objFromPtr BackgroundSubtractorKNN deleteBackgroundSubtractorKNN
  
  mkFinalizer ReleaseDeletePtr
              "deleteBackgroundSubtractorMOG2"
              "cv::Ptr<cv::BackgroundSubtractorMOG2>"
              ''C'Ptr_BackgroundSubtractorMOG2
  
  instance FromPtr (BackgroundSubtractorMOG2 s) where
      fromPtr = objFromPtr BackgroundSubtractorMOG2 deleteBackgroundSubtractorMOG2
  
  --------------------------------------------------------------------------------
  
  newBackgroundSubtractorKNN
      :: (PrimMonad m)
      => Maybe Int32
         -- ^ Length of the history.
      -> Maybe Double
         -- ^ Threshold on the squared distance between the pixel and the sample
         -- to decide whether a pixel is close to that sample. This parameter does
         -- not affect the background update.
      -> Maybe Bool
         -- ^ If 'True', the algorithm will detect shadows and mark them. It
         -- decreases the speed a bit, so if you do not need this feature, set the
         -- parameter to 'False'.
      -> m (BackgroundSubtractorKNN (PrimState m))
  newBackgroundSubtractorKNN mbHistory mbDist2Threshold mbDetectShadows = unsafePrimToPrim $ fromPtr
      [CU.block|Ptr_BackgroundSubtractorKNN * {
        cv::Ptr<cv::BackgroundSubtractorKNN> knnPtr =
          cv::createBackgroundSubtractorKNN
          ( $(int32_t c'history       )
          , $(double  c'dist2Threshold)
          , $(bool    c'detectShadows )
          );
        return new cv::Ptr<cv::BackgroundSubtractorKNN>(knnPtr);
      }|]
    where
      c'history        = fromMaybe 500 mbHistory
      c'dist2Threshold = maybe 400 realToFrac mbDist2Threshold
      c'detectShadows  = fromBool $ fromMaybe True mbDetectShadows
  
  newBackgroundSubtractorMOG2
      :: (PrimMonad m)
      => Maybe Int32
         -- ^ Length of the history.
      -> Maybe Double
         -- ^ Threshold on the squared Mahalanobis distance between the pixel and
         -- the model to decide whether a pixel is well described by the
         -- background model. This parameter does not affect the background
         -- update.
      -> Maybe Bool
         -- ^ If 'True', the algorithm will detect shadows and mark them. It
         -- decreases the speed a bit, so if you do not need this feature, set the
         -- parameter to 'False'.
      -> m (BackgroundSubtractorMOG2 (PrimState m))
  newBackgroundSubtractorMOG2 mbHistory mbVarThreshold mbDetectShadows = unsafePrimToPrim $ fromPtr
      [CU.block|Ptr_BackgroundSubtractorMOG2 * {
        cv::Ptr<cv::BackgroundSubtractorMOG2> mog2Ptr =
          cv::createBackgroundSubtractorMOG2
          ( $(int32_t c'history      )
          , $(double  c'varThreshold )
          , $(bool    c'detectShadows)
          );
        return new cv::Ptr<cv::BackgroundSubtractorMOG2>(mog2Ptr);
      }|]
    where
      c'history       = fromMaybe 500 mbHistory
      c'varThreshold  = maybe 16 realToFrac mbVarThreshold
      c'detectShadows = fromBool $ fromMaybe True mbDetectShadows
  
  --------------------------------------------------------------------------------
  
  instance Algorithm BackgroundSubtractorKNN where
      algorithmClearState knn = unsafePrimToPrim $
          withPtr knn $ \knnPtr ->
            [C.block|void {
                cv::BackgroundSubtractorKNN * knn = *$(Ptr_BackgroundSubtractorKNN * knnPtr);
                knn->clear();
            }|]
  
      algorithmIsEmpty knn = unsafePrimToPrim $
          withPtr knn $ \knnPtr ->
          alloca $ \emptyPtr -> do
            [C.block|void {
                cv::BackgroundSubtractorKNN * knn = *$(Ptr_BackgroundSubtractorKNN * knnPtr);
                *$(bool * emptyPtr) = knn->empty();
            }|]
            toBool <$> peek emptyPtr
  
  instance Algorithm BackgroundSubtractorMOG2 where
      algorithmClearState mog2 = unsafePrimToPrim $
          withPtr mog2 $ \mog2Ptr ->
            [C.block|void {
                cv::BackgroundSubtractorMOG2 * mog2 = *$(Ptr_BackgroundSubtractorMOG2 * mog2Ptr);
                mog2->clear();
            }|]
  
      algorithmIsEmpty mog2 = unsafePrimToPrim $
          withPtr mog2 $ \mog2Ptr ->
          alloca $ \emptyPtr -> do
            [C.block|void {
                cv::BackgroundSubtractorMOG2 * mog2 = *$(Ptr_BackgroundSubtractorMOG2 * mog2Ptr);
                *$(bool * emptyPtr) = mog2->empty();
            }|]
            toBool <$> peek emptyPtr
  
  instance BackgroundSubtractor BackgroundSubtractorKNN where
      bgSubApply knn learningRate img = unsafePrimToPrim $ do
          fgMask <- newEmptyMat
          withPtr knn $ \knnPtr ->
            withPtr img $ \imgPtr ->
            withPtr fgMask $ \fgMaskPtr -> mask_ $ do
              [C.block| void {
                cv::BackgroundSubtractorKNN * knn = *$(Ptr_BackgroundSubtractorKNN * knnPtr);
                knn->apply
                ( *$(Mat * imgPtr)
                , *$(Mat * fgMaskPtr)
                , $(double c'learningRate)
                );
              }|]
          pure $ unsafeCoerceMat fgMask
        where
          c'learningRate = realToFrac learningRate
  
      getBackgroundImage knn = unsafePrimToPrim $ do
          img <- newEmptyMat
          withPtr knn $ \knnPtr ->
            withPtr img $ \imgPtr -> mask_ $ do
              [C.block| void {
                cv::BackgroundSubtractorKNN * knn = *$(Ptr_BackgroundSubtractorKNN * knnPtr);
                knn->getBackgroundImage(*$(Mat * imgPtr));
              }|]
              pure $ unsafeCoerceMat img
  
  instance BackgroundSubtractor BackgroundSubtractorMOG2 where
      bgSubApply mog2 learningRate img = unsafePrimToPrim $ do
          fgMask <- newEmptyMat
          withPtr mog2 $ \mog2Ptr ->
            withPtr img $ \imgPtr ->
            withPtr fgMask $ \fgMaskPtr -> mask_ $ do
              [C.block| void {
                cv::BackgroundSubtractorMOG2 * mog2 = *$(Ptr_BackgroundSubtractorMOG2 * mog2Ptr);
                mog2->apply
                ( *$(Mat * imgPtr)
                , *$(Mat * fgMaskPtr)
                , $(double c'learningRate)
                );
              }|]
          pure $ unsafeCoerceMat fgMask
        where
          c'learningRate = realToFrac learningRate
  
      getBackgroundImage mog2 = unsafePrimToPrim $ do
          img <- newEmptyMat
          withPtr mog2 $ \mog2Ptr ->
            withPtr img $ \imgPtr -> mask_ $ do
              [C.block| void {
                cv::BackgroundSubtractorMOG2 * mog2 = *$(Ptr_BackgroundSubtractorMOG2 * mog2Ptr);
                mog2->getBackgroundImage(*$(Mat * imgPtr));
              }|]
              pure $ unsafeCoerceMat img
  