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