never executed always true always false
1 {-# language CPP #-}
2 {-# language MultiParamTypeClasses #-}
3 {-# language QuasiQuotes #-}
4 {-# language TemplateHaskell #-}
5
6 {-# OPTIONS_GHC -fno-warn-orphans #-}
7
8 #ifndef ENABLE_INTERNAL_DOCUMENTATION
9 {-# OPTIONS_HADDOCK hide #-}
10 #endif
11
12 module OpenCV.Internal.Core.Types
13 ( -- * Scalar
14 Scalar(..)
15 , newScalar
16 , ToScalar(..), FromScalar(..)
17 -- * RotatedRect
18 , RotatedRect(..)
19 , newRotatedRect
20 -- * TermCriteria
21 , TermCriteria(..)
22 , newTermCriteria
23 -- * Range
24 , Range(..)
25 , newRange
26 , newWholeRange
27 -- * Polygons
28 , withPolygons
29 , withArrayPtr
30 ) where
31
32 import "base" Control.Exception ( bracket_ )
33 import "base" Data.Bits ( (.|.) )
34 import "base" Data.Functor ( ($>) )
35 import "base" Data.Int ( Int32 )
36 import "base" Data.Proxy ( Proxy(..) )
37 import "base" Foreign.C.Types
38 import "base" Foreign.ForeignPtr ( ForeignPtr, withForeignPtr )
39 import "base" Foreign.Marshal.Alloc ( alloca, allocaBytes )
40 import "base" Foreign.Marshal.Array ( allocaArray )
41 import "base" Foreign.Ptr ( Ptr, plusPtr )
42 import "base" Foreign.Storable ( sizeOf, peek, poke )
43 import "base" System.IO.Unsafe ( unsafePerformIO )
44 import qualified "inline-c" Language.C.Inline as C
45 import qualified "inline-c" Language.C.Inline.Unsafe as CU
46 import qualified "inline-c-cpp" Language.C.Inline.Cpp as C
47 import "linear" Linear.V4 ( V4(..) )
48 import "this" OpenCV.Core.Types.Point
49 import "this" OpenCV.Core.Types.Size
50 import "this" OpenCV.Internal
51 import "this" OpenCV.Internal.C.Inline ( openCvCtx )
52 import "this" OpenCV.Internal.Core.Types.Constants
53 import "this" OpenCV.Internal.C.PlacementNew
54 import "this" OpenCV.Internal.C.PlacementNew.TH
55 import "this" OpenCV.Internal.C.Types
56 import qualified "vector" Data.Vector as V
57
58 --------------------------------------------------------------------------------
59
60 C.context openCvCtx
61
62 C.include "opencv2/core.hpp"
63 C.using "namespace cv"
64
65
66 --------------------------------------------------------------------------------
67 -- Types
68 --------------------------------------------------------------------------------
69
70 -- | A 4-element vector with 64 bit floating point elements
71 --
72 -- The type 'Scalar' is widely used in OpenCV to pass pixel values.
73 --
74 -- <http://docs.opencv.org/3.0-last-rst/modules/core/doc/basic_structures.html#scalar OpenCV Sphinx doc>
75 newtype Scalar = Scalar {unScalar :: ForeignPtr (C Scalar)}
76
77 -- | Rotated (i.e. not up-right) rectangles on a plane
78 --
79 -- Each rectangle is specified by the center point (mass center), length of each
80 -- side (represented by 'Size2f') and the rotation angle in degrees.
81 --
82 -- <http://docs.opencv.org/3.0-last-rst/modules/core/doc/basic_structures.html#rotatedrect OpenCV Sphinx doc>
83 newtype RotatedRect = RotatedRect {unRotatedRect :: ForeignPtr (C RotatedRect)}
84
85 -- | Termination criteria for iterative algorithms
86 --
87 -- <http://docs.opencv.org/3.0-last-rst/modules/core/doc/basic_structures.html#termcriteria OpenCV Sphinx doc>
88 newtype TermCriteria = TermCriteria {unTermCriteria :: ForeignPtr (C TermCriteria)}
89
90 -- | A continuous subsequence (slice) of a sequence
91 --
92 -- The type is used to specify a row or a column span in a matrix (`Mat`) and
93 -- for many other purposes. @'mkRange' a b@ is basically the same as @a:b@ in
94 -- Matlab or @a..b@ in Python. As in Python, start is an inclusive left boundary
95 -- of the range and end is an exclusive right boundary of the range. Such a
96 -- half-opened interval is usually denoted as @[start, end)@.
97 --
98 -- <http://docs.opencv.org/3.0-last-rst/modules/core/doc/basic_structures.html#range OpenCV Sphinx doc>
99 newtype Range = Range {unRange :: ForeignPtr (C Range)}
100
101
102 --------------------------------------------------------------------------------
103 -- Conversions
104 --------------------------------------------------------------------------------
105
106 class ToScalar a where toScalar :: a -> Scalar
107
108 instance ToScalar Scalar where toScalar = id
109
110 instance ToScalar (V4 CDouble) where toScalar = unsafePerformIO . newScalar
111
112 instance ToScalar (V4 Double ) where toScalar = toScalar . fmap (realToFrac :: Double -> CDouble)
113
114 class FromScalar a where fromScalar :: Scalar -> a
115
116 instance FromScalar Scalar where fromScalar = id
117
118 instance FromScalar (V4 CDouble) where
119 fromScalar s = unsafePerformIO $
120 alloca $ \xPtr ->
121 alloca $ \yPtr ->
122 alloca $ \zPtr ->
123 alloca $ \wPtr ->
124 withPtr s $ \sPtr -> do
125 [CU.block| void {
126 const Scalar & s = *$(Scalar * sPtr);
127 *$(double * xPtr) = s[0];
128 *$(double * yPtr) = s[1];
129 *$(double * zPtr) = s[2];
130 *$(double * wPtr) = s[3];
131 }|]
132 V4 <$> peek xPtr
133 <*> peek yPtr
134 <*> peek zPtr
135 <*> peek wPtr
136
137 instance FromScalar (V4 Double) where fromScalar = fmap (realToFrac :: CDouble -> Double) . fromScalar
138
139 --------------------------------------------------------------------------------
140 -- Constructing new values
141 --------------------------------------------------------------------------------
142
143 newScalar :: V4 CDouble -> IO Scalar
144 newScalar (V4 x y z w) = fromPtr $
145 [CU.exp|Scalar * { new cv::Scalar( $(double x)
146 , $(double y)
147 , $(double z)
148 , $(double w)
149 )
150 }|]
151
152 newRotatedRect
153 :: ( IsPoint2 point2 CFloat
154 , IsSize size CFloat
155 )
156 => point2 CFloat -- ^ Rectangle mass center
157 -> size CFloat -- ^ Width and height of the rectangle
158 -> CFloat
159 -- ^ The rotation angle (in degrees). When the angle is 0, 90,
160 -- 180, 270 etc., the rectangle becomes an up-right rectangle.
161 -> IO RotatedRect
162 newRotatedRect center size angle = fromPtr $
163 withPtr (toPoint center) $ \centerPtr ->
164 withPtr (toSize size) $ \sizePtr ->
165 [CU.exp| RotatedRect * {
166 new cv::RotatedRect( *$(Point2f * centerPtr)
167 , *$(Size2f * sizePtr)
168 , $(float angle)
169 )
170 }|]
171
172 newTermCriteria
173 :: Maybe Int -- ^ Optionally the maximum number of iterations/elements.
174 -> Maybe Double -- ^ Optionally the desired accuracy.
175 -> IO TermCriteria
176 newTermCriteria mbMaxCount mbEpsilon = fromPtr $
177 [CU.exp|TermCriteria * {
178 new cv::TermCriteria( $(int32_t c'type )
179 , $(int32_t c'maxCount)
180 , $(double c'epsilon )
181 )
182 }|]
183 where
184 c'type = maybe 0 (const c'TERMCRITERIA_COUNT) mbMaxCount
185 .|. maybe 0 (const c'TERMCRITERIA_EPS ) mbEpsilon
186 c'maxCount = maybe 0 fromIntegral mbMaxCount
187 c'epsilon = maybe 0 realToFrac mbEpsilon
188
189 newRange
190 :: Int32 -- ^ Inclusive start
191 -> Int32 -- ^ Exlusive end
192 -> IO Range
193 newRange start end = fromPtr $
194 [CU.exp|Range * { new cv::Range( $(int32_t start), $(int32_t end)) }|]
195
196 -- | Special 'Range' value which means "the whole sequence" or "the whole range"
197 newWholeRange :: IO Range
198 newWholeRange = fromPtr $
199 [CU.block|Range * {
200 cv::Range a = cv::Range::all();
201 return new cv::Range(a.start, a.end);
202 }|]
203
204
205 --------------------------------------------------------------------------------
206 -- Polygons
207 --------------------------------------------------------------------------------
208
209 withPolygons
210 :: forall a point2
211 . (IsPoint2 point2 Int32)
212 => V.Vector (V.Vector (point2 Int32))
213 -> (Ptr (Ptr (C Point2i)) -> IO a)
214 -> IO a
215 withPolygons polygons act =
216 allocaArray (V.length polygons) $ \polygonsPtr -> do
217 let go :: Ptr (Ptr (C Point2i)) -> Int -> IO a
218 go !acc !ix
219 | ix < V.length polygons =
220 let pts = V.map toPoint $ V.unsafeIndex polygons ix
221 in withArrayPtr pts $ \ptsPtr -> do
222 poke acc ptsPtr
223 go (acc `plusPtr` sizeOf (undefined :: Ptr (Ptr (C Point2i)))) (ix + 1)
224 | otherwise = act polygonsPtr
225 go polygonsPtr 0
226
227 -- | Perform an action with a temporary pointer to an array of values
228 --
229 -- The input values are placed consecutively in memory using the 'PlacementNew'
230 -- mechanism.
231 --
232 -- This function is intended for types which are not managed by the Haskell
233 -- runtime, but by a foreign system (such as C).
234 --
235 -- The pointer is not guaranteed to be usuable outside the scope of this
236 -- function. The same warnings apply as for 'withForeignPtr'.
237 withArrayPtr
238 :: forall a b
239 . (WithPtr a, CSizeOf (C a), PlacementNew (C a))
240 => V.Vector a
241 -> (Ptr (C a) -> IO b)
242 -> IO b
243 withArrayPtr arr act =
244 allocaBytes arraySize $ \arrPtr ->
245 bracket_
246 (V.foldM'_ copyNext arrPtr arr)
247 (deconstructArray arrPtr )
248 (act arrPtr)
249 where
250 elemSize = cSizeOf (Proxy :: Proxy (C a))
251 arraySize = elemSize * V.length arr
252
253 copyNext :: Ptr (C a) -> a -> IO (Ptr (C a))
254 copyNext !ptr obj = copyObj ptr obj $> plusPtr ptr elemSize
255
256 copyObj :: Ptr (C a) -> a -> IO ()
257 copyObj dstPtr src =
258 withPtr src $ \srcPtr ->
259 placementNew srcPtr dstPtr
260
261 deconstructArray :: Ptr (C a) -> IO ()
262 deconstructArray !begin = deconstructNext begin
263 where
264 deconstructNext !ptr
265 | ptr == end = pure ()
266 | otherwise = do placementDelete ptr
267 deconstructNext $ ptr `plusPtr` elemSize
268
269 end :: Ptr (C a)
270 end = begin `plusPtr` arraySize
271
272 --------------------------------------------------------------------------------
273
274 type instance C Scalar = C'Scalar
275 type instance C RotatedRect = C'RotatedRect
276 type instance C TermCriteria = C'TermCriteria
277 type instance C Range = C'Range
278
279 --------------------------------------------------------------------------------
280
281 instance WithPtr Scalar where withPtr = withForeignPtr . unScalar
282 instance WithPtr RotatedRect where withPtr = withForeignPtr . unRotatedRect
283 instance WithPtr TermCriteria where withPtr = withForeignPtr . unTermCriteria
284 instance WithPtr Range where withPtr = withForeignPtr . unRange
285
286 --------------------------------------------------------------------------------
287
288 mkPlacementNewInstance ''Scalar
289
290 --------------------------------------------------------------------------------
291
292 instance FromPtr Scalar where
293 fromPtr = objFromPtr Scalar $ \ptr ->
294 [CU.exp| void { delete $(Scalar * ptr) }|]
295
296 instance FromPtr RotatedRect where
297 fromPtr = objFromPtr RotatedRect $ \ptr ->
298 [CU.exp| void { delete $(RotatedRect * ptr) }|]
299
300 instance FromPtr TermCriteria where
301 fromPtr = objFromPtr TermCriteria $ \ptr ->
302 [CU.exp| void { delete $(TermCriteria * ptr) }|]
303
304 instance FromPtr Range where
305 fromPtr = objFromPtr Range $ \ptr ->
306 [CU.exp| void { delete $(Range * ptr) }|]