content: {-# LANGUAGE QuasiQuotes #-}
  {-# LANGUAGE TemplateHaskell #-}
  
  module OpenCV.VideoIO.VideoCapture
    ( VideoCapture
    , VideoCaptureSource(..)
  
    , newVideoCapture
    , videoCaptureOpen
    , videoCaptureRelease
    , videoCaptureIsOpened
    , videoCaptureGrab
    , videoCaptureRetrieve
    , videoCaptureGetD
    , videoCaptureGetI
    , videoCaptureSetD
    , videoCaptureSetI
    ) where
  
  import "base" Control.Monad.IO.Class ( MonadIO, liftIO )
  import "base" Data.Int ( Int32 )
  import "base" Foreign.C.String ( withCString )
  import "base" Foreign.ForeignPtr ( ForeignPtr, withForeignPtr )
  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 "mtl" Control.Monad.Error.Class ( MonadError )
  import "this" OpenCV.Core.Types.Mat
  import "this" OpenCV.Internal
  import "this" OpenCV.Internal.Exception
  import "this" OpenCV.Internal.C.FinalizerTH
  import "this" OpenCV.Internal.C.Inline ( openCvCtx )
  import "this" OpenCV.Internal.C.Types
  import "this" OpenCV.Internal.Core.Types.Mat
  import "this" OpenCV.Internal.VideoIO.Types
  import "this" OpenCV.TypeLevel
  
  --------------------------------------------------------------------------------
  
  C.context openCvCtx
  
  C.include "opencv2/core.hpp"
  C.include "opencv2/videoio.hpp"
  C.using "namespace cv"
  
  --------------------------------------------------------------------------------
  
  newtype VideoCapture = VideoCapture {unVideoCapture :: ForeignPtr (C VideoCapture)}
  
  type instance C VideoCapture = C'VideoCapture
  
  instance WithPtr VideoCapture where withPtr = withForeignPtr . unVideoCapture
  
  mkFinalizer DeletePtr "deleteVideoCapture" "cv::VideoCapture" ''C'VideoCapture
  
  instance FromPtr VideoCapture where
      fromPtr = objFromPtr VideoCapture deleteVideoCapture
  
  data VideoCaptureSource
     = VideoFileSource   !FilePath !(Maybe VideoCaptureAPI)
       -- ^ VideoFile and backend
     | VideoDeviceSource !Int32    !(Maybe VideoCaptureAPI)
       -- ^ VideoDevice and backend
  
  newVideoCapture :: IO VideoCapture
  newVideoCapture = fromPtr $
      [CU.exp|VideoCapture * {
        new cv::VideoCapture()
      }|]
  
  videoCaptureOpen :: ( MonadIO m, MonadError CvException m ) => VideoCapture -> VideoCaptureSource -> m ()
  videoCaptureOpen videoCapture src =
      wrapException $
      liftIO $
      handleCvException (pure ()) $
      withPtr videoCapture $ \videoCapturePtr ->
        case src of
          VideoFileSource filePath api ->
            withCString filePath $ \c'filePath ->
              [cvExcept|
                $(VideoCapture * videoCapturePtr)->open(cv::String($(const char * c'filePath)), $(int32_t c'api));
              |]
             where
               c'api = maybe 0 marshalVideoCaptureAPI api
          VideoDeviceSource device api ->
            [cvExcept|
              $(VideoCapture * videoCapturePtr)->open($(int32_t c'device ));
            |]
              where
                c'device = device + maybe 0 marshalVideoCaptureAPI api
  
  videoCaptureRelease :: (MonadIO m, MonadError CvException m) => VideoCapture -> m ()
  videoCaptureRelease videoCapture =
      wrapException $
      liftIO $
      handleCvException (pure ()) $
      withPtr videoCapture $ \videoCapturePtr ->
        [cvExcept|
          $(VideoCapture * videoCapturePtr)->release();
        |]
  
  videoCaptureIsOpened :: VideoCapture -> IO Bool
  videoCaptureIsOpened videoCapture =
      fmap toBool $
      withPtr videoCapture $ \videoCapturePtr ->
        [CU.exp| bool {
          $(VideoCapture * videoCapturePtr)->isOpened()
        }|]
  
  videoCaptureGrab :: VideoCapture -> IO Bool
  videoCaptureGrab videoCapture =
      fmap toBool $
      withPtr videoCapture $ \videoCapturePtr ->
        [C.exp| bool {
          $(VideoCapture * videoCapturePtr)->grab()
        }|]
  
  videoCaptureRetrieve :: VideoCapture -> IO (Maybe (Mat ('S ['D, 'D]) 'D 'D))
  videoCaptureRetrieve videoCapture = do
      frame <- newEmptyMat
      ok <- withPtr frame $ \framePtr ->
        withPtr videoCapture $ \videoCapturePtr ->
          [C.exp| bool {
            $(VideoCapture * videoCapturePtr)->retrieve(*$(Mat * framePtr), 0)
          }|]
      pure $ case toBool ok of
        False -> Nothing
        True  -> Just $ unsafeCoerceMat frame
  
  videoCaptureGetD :: VideoCapture -> VideoCaptureProperties -> IO Double
  videoCaptureGetD videoCapture prop =
      fmap realToFrac $
      withPtr videoCapture $ \videoCapturePtr ->
        [CU.exp| double {
          $(VideoCapture * videoCapturePtr)->get( $(int32_t c'prop) )
        }|]
     where
       c'prop = marshalCaptureProperties prop
  
  videoCaptureGetI :: VideoCapture -> VideoCaptureProperties -> IO Int32
  videoCaptureGetI videoCapture prop =
      withPtr videoCapture $ \videoCapturePtr ->
        [CU.exp| int32_t {
          $(VideoCapture * videoCapturePtr)->get( $(int32_t c'prop) )
        }|]
     where
       c'prop = marshalCaptureProperties prop
  
  videoCaptureSetD :: VideoCapture -> VideoCaptureProperties -> Double -> IO Bool
  videoCaptureSetD videoCapture prop val =
      fmap toBool $
      withPtr videoCapture $ \videoCapturePtr ->
        [CU.exp| bool {
          $(VideoCapture * videoCapturePtr)->set( $(int32_t c'prop)
                                                , $(double c'val)
                                                )
        }|]
     where
       c'prop = marshalCaptureProperties prop
       c'val = realToFrac val
  
  
  videoCaptureSetI :: VideoCapture -> VideoCaptureProperties -> Int32 -> IO Bool
  videoCaptureSetI videoCapture prop val =
      fmap toBool $
      withPtr videoCapture $ \videoCapturePtr ->
        [CU.exp| bool {
          $(VideoCapture * videoCapturePtr)->set( $(int32_t c'prop)
                                                , $(int32_t val)
                                                )
        }|]
     where
       c'prop = marshalCaptureProperties prop
  