never executed always true always false
1 {-# LANGUAGE QuasiQuotes #-}
2 {-# LANGUAGE TemplateHaskell #-}
3 {-# LANGUAGE RecordWildCards #-}
4
5 {-# OPTIONS_GHC -fno-warn-orphans #-} -- For Show instances
6
7 module OpenCV.Core.Types
8 ( -- * Mutable values
9 Mut
10 , Mutable
11 , FreezeThaw(..)
12 -- * Point
13 , module OpenCV.Core.Types.Point
14 -- * Size
15 , module OpenCV.Core.Types.Size
16 -- * Scalar
17 , Scalar
18 , ToScalar(..), FromScalar(..)
19 -- * Rect
20 , module OpenCV.Core.Types.Rect
21 -- * RotatedRect
22 , RotatedRect
23 , mkRotatedRect
24 , rotatedRectCenter
25 , rotatedRectSize
26 , rotatedRectAngle
27 , rotatedRectBoundingRect
28 , rotatedRectPoints
29 -- * TermCriteria
30 , TermCriteria
31 , mkTermCriteria
32 -- * Range
33 , Range
34 , mkRange
35 , wholeRange
36 -- * KeyPoint
37 , KeyPoint
38 , KeyPointRec(..)
39 , mkKeyPoint
40 , keyPointAsRec
41 -- * DMatch
42 , DMatch
43 , DMatchRec(..)
44 , mkDMatch
45 , dmatchAsRec
46 -- * Matrix
47 , module OpenCV.Core.Types.Mat
48 , module OpenCV.Core.Types.Matx
49 -- * Vec
50 , module OpenCV.Core.Types.Vec
51 -- * Exception
52 , module OpenCV.Exception
53 -- * Algorithm
54 , Algorithm(..)
55 -- * Polymorphic stuff
56 , WithPtr
57 , FromPtr
58 , CSizeOf
59 , PlacementNew
60 ) where
61
62 import "base" Data.Int ( Int32 )
63 import "base" Foreign.C.Types
64 import "base" Foreign.ForeignPtr ( ForeignPtr, withForeignPtr )
65 import "base" Foreign.Marshal.Alloc ( alloca )
66 import "base" Foreign.Storable ( peek )
67 import "base" System.IO.Unsafe ( unsafePerformIO )
68 import qualified "inline-c" Language.C.Inline as C
69 import qualified "inline-c" Language.C.Inline.Unsafe as CU
70 import qualified "inline-c-cpp" Language.C.Inline.Cpp as C
71 import "linear" Linear.V2 ( V2(..) )
72 import "linear" Linear.Vector ( zero )
73 import "primitive" Control.Monad.Primitive ( PrimMonad, PrimState )
74 import "this" OpenCV.Core.Types.Mat
75 import "this" OpenCV.Core.Types.Matx
76 import "this" OpenCV.Core.Types.Point
77 import "this" OpenCV.Core.Types.Rect
78 import "this" OpenCV.Core.Types.Size
79 import "this" OpenCV.Core.Types.Vec
80 import "this" OpenCV.Exception
81 import "this" OpenCV.Internal
82 import "this" OpenCV.Internal.C.Inline ( openCvCtx )
83 import "this" OpenCV.Internal.C.PlacementNew
84 import "this" OpenCV.Internal.C.PlacementNew.TH ( mkPlacementNewInstance )
85 import "this" OpenCV.Internal.C.Types
86 import "this" OpenCV.Internal.Core.Types.Constants
87 import "this" OpenCV.Internal.Core.Types
88 import "this" OpenCV.Internal.Mutable
89
90 --------------------------------------------------------------------------------
91
92 C.context openCvCtx
93
94 C.include "opencv2/core.hpp"
95 C.using "namespace cv"
96
97 #include <bindings.dsl.h>
98 #include "opencv2/core.hpp"
99
100 #include "namespace.hpp"
101
102 --------------------------------------------------------------------------------
103 -- RotatedRect
104 --------------------------------------------------------------------------------
105
106 mkRotatedRect
107 :: ( IsPoint2 point2 CFloat
108 , IsSize size CFloat
109 )
110 => point2 CFloat -- ^ Rectangle mass center
111 -> size CFloat -- ^ Width and height of the rectangle
112 -> Float
113 -- ^ The rotation angle (in degrees). When the angle is 0, 90,
114 -- 180, 270 etc., the rectangle becomes an up-right rectangle.
115 -> RotatedRect
116 mkRotatedRect center size angle =
117 unsafePerformIO $ newRotatedRect center size (realToFrac angle)
118
119 -- | Rectangle mass center
120 rotatedRectCenter :: RotatedRect -> Point2f
121 rotatedRectCenter rotRect = unsafePerformIO $ fromPtr $
122 withPtr rotRect $ \rotRectPtr ->
123 [CU.exp| Point2f * { new Point2f($(RotatedRect * rotRectPtr)->center) }|]
124
125 -- | Width and height of the rectangle
126 rotatedRectSize :: RotatedRect -> Size2f
127 rotatedRectSize rotRect = unsafePerformIO $ fromPtr $
128 withPtr rotRect $ \rotRectPtr ->
129 [CU.exp| Size2f * { new Size2f($(RotatedRect * rotRectPtr)->size) }|]
130
131 -- | The rotation angle (in degrees)
132 --
133 -- When the angle is 0, 90, 180, 270 etc., the rectangle becomes an
134 -- up-right rectangle.
135 rotatedRectAngle :: RotatedRect -> Float
136 rotatedRectAngle rotRect = realToFrac $ unsafePerformIO $
137 withPtr rotRect $ \rotRectPtr ->
138 [CU.exp| float { $(RotatedRect * rotRectPtr)->angle }|]
139
140 -- | The minimal up-right rectangle containing the rotated rectangle
141 rotatedRectBoundingRect :: RotatedRect -> Rect2i
142 rotatedRectBoundingRect rotRect =
143 unsafePerformIO $ fromPtr $ withPtr rotRect $ \rotRectPtr ->
144 [CU.exp| Rect2i * { new Rect2i($(RotatedRect * rotRectPtr)->boundingRect()) }|]
145
146 rotatedRectPoints :: RotatedRect -> (Point2f, Point2f, Point2f, Point2f)
147 rotatedRectPoints rotRect = unsafePerformIO $ do
148 p1 <- toPointIO (zero :: V2 CFloat)
149 p2 <- toPointIO (zero :: V2 CFloat)
150 p3 <- toPointIO (zero :: V2 CFloat)
151 p4 <- toPointIO (zero :: V2 CFloat)
152 withPtr rotRect $ \rotRectPtr ->
153 withPtr p1 $ \p1Ptr ->
154 withPtr p2 $ \p2Ptr ->
155 withPtr p3 $ \p3Ptr ->
156 withPtr p4 $ \p4Ptr ->
157 [C.block| void {
158 Point2f vertices[4];
159 $(RotatedRect * rotRectPtr)->points(vertices);
160 *$(Point2f * p1Ptr) = vertices[0];
161 *$(Point2f * p2Ptr) = vertices[1];
162 *$(Point2f * p3Ptr) = vertices[2];
163 *$(Point2f * p4Ptr) = vertices[3];
164 }|]
165 pure (p1, p2, p3, p4)
166
167
168 --------------------------------------------------------------------------------
169 -- TermCriteria
170 --------------------------------------------------------------------------------
171
172 mkTermCriteria
173 :: Maybe Int -- ^ Optionally the maximum number of iterations/elements.
174 -> Maybe Double -- ^ Optionally the desired accuracy.
175 -> TermCriteria
176 mkTermCriteria mbMaxCount mbEpsilon =
177 unsafePerformIO $ newTermCriteria mbMaxCount mbEpsilon
178
179
180 --------------------------------------------------------------------------------
181 -- Range
182 --------------------------------------------------------------------------------
183
184 mkRange :: Int32 -> Int32 -> Range
185 mkRange start end = unsafePerformIO $ newRange start end
186
187 wholeRange :: Range
188 wholeRange = unsafePerformIO newWholeRange
189
190
191 --------------------------------------------------------------------------------
192 -- KeyPoint
193 --------------------------------------------------------------------------------
194
195 {- | Data structure for salient point detectors
196
197 <http://docs.opencv.org/3.0-last-rst/modules/core/doc/basic_structures.html#keypoint OpenCV Sphinx doc>
198 -}
199 newtype KeyPoint = KeyPoint {unKeyPoint :: ForeignPtr C'KeyPoint}
200
201 type instance C KeyPoint = C'KeyPoint
202
203 mkPlacementNewInstance ''KeyPoint
204
205 instance WithPtr KeyPoint where
206 withPtr = withForeignPtr . unKeyPoint
207
208 instance FromPtr KeyPoint where
209 fromPtr = objFromPtr KeyPoint $ \ptr ->
210 [CU.exp| void { delete $(KeyPoint * ptr) }|]
211
212 instance CSizeOf C'KeyPoint where
213 cSizeOf _proxy = c'sizeof_KeyPoint
214
215 data KeyPointRec
216 = KeyPointRec
217 { kptPoint :: !(V2 Float)
218 -- ^ Coordinates of the keypoints.
219 , kptSize :: !Float
220 -- ^ Diameter of the meaningful keypoint neighborhood.
221 , kptAngle :: !Float
222 -- ^ Computed orientation of the keypoint (-1 if not applicable); it's in
223 -- [0,360) degrees and measured relative to image coordinate system, ie
224 -- in clockwise.
225 , kptResponse :: !Float
226 -- ^ The response by which the most strong keypoints have been
227 -- selected. Can be used for the further sorting or subsampling.
228 , kptOctave :: !Int32
229 -- ^ Octave (pyramid layer) from which the keypoint has been extracted.
230 , kptClassId :: !Int32
231 -- ^ Object class (if the keypoints need to be clustered by an object
232 -- they belong to).
233 } deriving (Eq, Show)
234
235 newKeyPoint :: KeyPointRec -> IO KeyPoint
236 newKeyPoint KeyPointRec{..} = fromPtr $
237 [CU.exp|KeyPoint * {
238 new cv::KeyPoint
239 ( cv::Point2f($(float c'x), $(float c'y))
240 , $(float c'kptSize)
241 , $(float c'kptAngle)
242 , $(float c'kptResponse)
243 , $(int32_t kptOctave)
244 , $(int32_t kptClassId)
245 )
246 }|]
247 where
248 V2 c'x c'y = realToFrac <$> kptPoint
249 c'kptSize = realToFrac kptSize
250 c'kptAngle = realToFrac kptAngle
251 c'kptResponse = realToFrac kptResponse
252
253 mkKeyPoint :: KeyPointRec -> KeyPoint
254 mkKeyPoint = unsafePerformIO . newKeyPoint
255
256 keyPointAsRec :: KeyPoint -> KeyPointRec
257 keyPointAsRec kpt = unsafePerformIO $
258 withPtr kpt $ \kptPtr ->
259 alloca $ \xPtr ->
260 alloca $ \yPtr ->
261 alloca $ \sizePtr ->
262 alloca $ \anglePtr ->
263 alloca $ \responsePtr ->
264 alloca $ \octavePtr ->
265 alloca $ \classIdPtr -> do
266 [CU.block|void {
267 KeyPoint * kpt = $(KeyPoint * kptPtr);
268 *$(float * xPtr ) = kpt->pt.x ;
269 *$(float * yPtr ) = kpt->pt.y ;
270 *$(float * sizePtr ) = kpt->size ;
271 *$(float * anglePtr ) = kpt->angle ;
272 *$(float * responsePtr) = kpt->response;
273 *$(int32_t * octavePtr ) = kpt->octave ;
274 *$(int32_t * classIdPtr ) = kpt->class_id;
275 }|]
276 KeyPointRec
277 <$> ( V2 <$> (realToFrac <$> peek xPtr)
278 <*> (realToFrac <$> peek yPtr)
279 )
280 <*> (realToFrac <$> peek sizePtr )
281 <*> (realToFrac <$> peek anglePtr )
282 <*> (realToFrac <$> peek responsePtr)
283 <*> peek octavePtr
284 <*> peek classIdPtr
285
286 --------------------------------------------------------------------------------
287 -- DMatch
288 --------------------------------------------------------------------------------
289
290 {- | Class for matching keypoint descriptors: query descriptor index, train
291 descriptor index, train image index, and distance between descriptors
292
293 <http://docs.opencv.org/3.0-last-rst/modules/core/doc/basic_structures.html#dmatch OpenCV Sphinx Doc>
294 -}
295 newtype DMatch = DMatch {unDMatch :: ForeignPtr C'DMatch}
296
297 type instance C DMatch = C'DMatch
298
299 mkPlacementNewInstance ''DMatch
300
301 instance WithPtr DMatch where
302 withPtr = withForeignPtr . unDMatch
303
304 instance FromPtr DMatch where
305 fromPtr = objFromPtr DMatch $ \ptr ->
306 [CU.exp| void { delete $(DMatch * ptr) }|]
307
308 instance CSizeOf C'DMatch where
309 cSizeOf _proxy = c'sizeof_DMatch
310
311 data DMatchRec
312 = DMatchRec
313 { dmatchQueryIdx :: !Int32
314 -- ^ Query descriptor index.
315 , dmatchTrainIdx :: !Int32
316 -- ^ Train descriptor index.
317 , dmatchImgIdx :: !Int32
318 -- ^ Train image index.
319 , dmatchDistance :: !Float
320 } deriving (Eq, Show)
321
322 newDMatch :: DMatchRec -> IO DMatch
323 newDMatch DMatchRec{..} = fromPtr $
324 [CU.exp|DMatch * {
325 new cv::DMatch
326 ( $(int32_t dmatchQueryIdx)
327 , $(int32_t dmatchTrainIdx)
328 , $(int32_t dmatchImgIdx)
329 , $(float c'distance)
330 )
331 }|]
332 where
333 c'distance = realToFrac dmatchDistance
334
335 mkDMatch :: DMatchRec -> DMatch
336 mkDMatch = unsafePerformIO . newDMatch
337
338 dmatchAsRec :: DMatch -> DMatchRec
339 dmatchAsRec dmatch = unsafePerformIO $
340 withPtr dmatch $ \dmatchPtr ->
341 alloca $ \queryIdxPtr ->
342 alloca $ \trainIdxPtr ->
343 alloca $ \imgIdxPtr ->
344 alloca $ \distancePtr -> do
345 [CU.block|void {
346 DMatch * dmatch = $(DMatch * dmatchPtr);
347 *$(int32_t * queryIdxPtr) = dmatch->queryIdx;
348 *$(int32_t * trainIdxPtr) = dmatch->trainIdx;
349 *$(int32_t * imgIdxPtr ) = dmatch->imgIdx ;
350 *$(float * distancePtr) = dmatch->distance;
351 }|]
352 DMatchRec
353 <$> peek queryIdxPtr
354 <*> peek trainIdxPtr
355 <*> peek imgIdxPtr
356 <*> (realToFrac <$> peek distancePtr)
357
358 --------------------------------------------------------------------------------
359 -- Algorithm
360 --------------------------------------------------------------------------------
361
362 class Algorithm a where
363 algorithmClearState :: (PrimMonad m) => a (PrimState m) -> m ()
364 algorithmIsEmpty :: (PrimMonad m) => a (PrimState m) -> m Bool