never executed always true always false
    1 {-# LANGUAGE QuasiQuotes #-}
    2 {-# LANGUAGE TemplateHaskell #-}
    3 
    4 module OpenCV.VideoIO.VideoCapture
    5   ( VideoCapture
    6   , VideoCaptureSource(..)
    7 
    8   , newVideoCapture
    9   , videoCaptureOpen
   10   , videoCaptureRelease
   11   , videoCaptureIsOpened
   12   , videoCaptureGrab
   13   , videoCaptureRetrieve
   14   , videoCaptureGetD
   15   , videoCaptureGetI
   16   , videoCaptureSetD
   17   , videoCaptureSetI
   18   ) where
   19 
   20 import "base" Data.Int ( Int32 )
   21 import "base" Foreign.C.String ( withCString )
   22 import "base" Foreign.ForeignPtr ( ForeignPtr, withForeignPtr )
   23 import "base" Foreign.Marshal.Utils ( toBool )
   24 import qualified "inline-c" Language.C.Inline as C
   25 import qualified "inline-c" Language.C.Inline.Unsafe as CU
   26 import qualified "inline-c-cpp" Language.C.Inline.Cpp as C
   27 import "this" OpenCV.Core.Types.Mat
   28 import "this" OpenCV.Internal
   29 import "this" OpenCV.Internal.Exception
   30 import "this" OpenCV.Internal.C.Inline ( openCvCtx )
   31 import "this" OpenCV.Internal.C.Types
   32 import "this" OpenCV.Internal.Core.Types.Mat
   33 import "this" OpenCV.Internal.VideoIO.Types
   34 import "this" OpenCV.TypeLevel
   35 import "transformers" Control.Monad.Trans.Except ( ExceptT(ExceptT) )
   36 
   37 --------------------------------------------------------------------------------
   38 
   39 C.context openCvCtx
   40 
   41 C.include "opencv2/core.hpp"
   42 C.include "opencv2/videoio.hpp"
   43 C.using "namespace cv"
   44 
   45 --------------------------------------------------------------------------------
   46 
   47 newtype VideoCapture = VideoCapture {unVideoCapture :: ForeignPtr (C VideoCapture)}
   48 
   49 type instance C VideoCapture = C'VideoCapture
   50 
   51 instance WithPtr VideoCapture where withPtr = withForeignPtr . unVideoCapture
   52 
   53 instance FromPtr VideoCapture where
   54     fromPtr = objFromPtr VideoCapture $ \ptr ->
   55                 [CU.exp| void { delete $(VideoCapture * ptr) }|]
   56 
   57 data VideoCaptureSource
   58    = VideoFileSource      !FilePath !(Maybe VideoCaptureAPI)
   59         -- ^ VideoFile and backend
   60    | VideoDeviceSource    !Int32    !(Maybe VideoCaptureAPI)
   61         -- ^ VideoDevice and backend
   62 
   63 newVideoCapture :: IO VideoCapture
   64 newVideoCapture = fromPtr $
   65     [CU.exp|VideoCapture * {
   66       new cv::VideoCapture()
   67     }|]
   68 
   69 videoCaptureOpen :: VideoCapture -> VideoCaptureSource -> CvExceptT IO ()
   70 videoCaptureOpen videoCapture src =
   71     ExceptT $
   72     handleCvException (pure ()) $
   73     withPtr videoCapture $ \videoCapturePtr ->
   74       case src of
   75         VideoFileSource filePath api ->
   76           withCString filePath $ \c'filePath ->
   77             [cvExcept|
   78               $(VideoCapture * videoCapturePtr)->open(cv::String($(const char * c'filePath)), $(int32_t c'api));
   79             |]
   80            where
   81              c'api = maybe 0 marshalVideoCaptureAPI api
   82         VideoDeviceSource device api ->
   83           [cvExcept|
   84             $(VideoCapture * videoCapturePtr)->open($(int32_t c'device ));
   85           |]
   86             where
   87               c'device = device + maybe 0 marshalVideoCaptureAPI api
   88 
   89 videoCaptureRelease :: VideoCapture -> CvExceptT IO ()
   90 videoCaptureRelease videoCapture =
   91     ExceptT $
   92     handleCvException (pure ()) $
   93     withPtr videoCapture $ \videoCapturePtr ->
   94       [cvExcept|
   95         $(VideoCapture * videoCapturePtr)->release();
   96       |]
   97 
   98 videoCaptureIsOpened :: VideoCapture -> IO Bool
   99 videoCaptureIsOpened videoCapture =
  100     fmap toBool $
  101     withPtr videoCapture $ \videoCapturePtr ->
  102       [CU.exp| bool {
  103         $(VideoCapture * videoCapturePtr)->isOpened()
  104       }|]
  105 
  106 videoCaptureGrab :: VideoCapture -> IO Bool
  107 videoCaptureGrab videoCapture =
  108     fmap toBool $
  109     withPtr videoCapture $ \videoCapturePtr ->
  110       [C.exp| bool {
  111         $(VideoCapture * videoCapturePtr)->grab()
  112       }|]
  113 
  114 videoCaptureRetrieve :: VideoCapture -> IO (Maybe (Mat ('S ['D, 'D]) 'D 'D))
  115 videoCaptureRetrieve videoCapture = do
  116     frame <- newEmptyMat
  117     ok <- withPtr frame $ \framePtr ->
  118       withPtr videoCapture $ \videoCapturePtr ->
  119         [C.exp| bool {
  120           $(VideoCapture * videoCapturePtr)->retrieve(*$(Mat * framePtr), 0)
  121         }|]
  122     pure $ case toBool ok of
  123       False -> Nothing
  124       True  -> Just $ unsafeCoerceMat frame
  125 
  126 videoCaptureGetD :: VideoCapture -> VideoCaptureProperties -> IO Double
  127 videoCaptureGetD videoCapture prop =
  128     fmap realToFrac $
  129     withPtr videoCapture $ \videoCapturePtr ->
  130       [CU.exp| double {
  131         $(VideoCapture * videoCapturePtr)->get( $(int32_t c'prop) )
  132       }|]
  133    where
  134      c'prop = marshalCaptureProperties prop
  135 
  136 videoCaptureGetI :: VideoCapture -> VideoCaptureProperties -> IO Int32
  137 videoCaptureGetI videoCapture prop =
  138     withPtr videoCapture $ \videoCapturePtr ->
  139       [CU.exp| int32_t {
  140         $(VideoCapture * videoCapturePtr)->get( $(int32_t c'prop) )
  141       }|]
  142    where
  143      c'prop = marshalCaptureProperties prop
  144 
  145 videoCaptureSetD :: VideoCapture -> VideoCaptureProperties -> Double -> IO Bool
  146 videoCaptureSetD videoCapture prop val =
  147     fmap toBool $
  148     withPtr videoCapture $ \videoCapturePtr ->
  149       [CU.exp| bool {
  150         $(VideoCapture * videoCapturePtr)->set( $(int32_t c'prop)
  151                                               , $(double c'val)
  152                                               )
  153       }|]
  154    where
  155      c'prop = marshalCaptureProperties prop
  156      c'val = realToFrac val
  157 
  158 
  159 videoCaptureSetI :: VideoCapture -> VideoCaptureProperties -> Int32 -> IO Bool
  160 videoCaptureSetI videoCapture prop val =
  161     fmap toBool $
  162     withPtr videoCapture $ \videoCapturePtr ->
  163       [CU.exp| bool {
  164         $(VideoCapture * videoCapturePtr)->set( $(int32_t c'prop)
  165                                               , $(int32_t val)
  166                                               )
  167       }|]
  168    where
  169      c'prop = marshalCaptureProperties prop