never executed always true always false
1 {-# language QuasiQuotes #-}
2 {-# language TemplateHaskell #-}
3
4 {- |
5
6 The functions in this section perform various geometrical transformations of 2D
7 images. They do not change the image content but deform the pixel grid and map
8 this deformed grid to the destination image. In fact, to avoid sampling
9 artifacts, the mapping is done in the reverse order, from destination to the
10 source. That is, for each pixel @(x,y)@ of the destination image, the functions
11 compute coordinates of the corresponding "donor" pixel in the source image and
12 copy the pixel value:
13
14 @dst(x,y) = src(fx(x,y), fy(x,y))@
15
16 In case when you specify the forward mapping @\<gx,gy> : src -> dst@, the OpenCV
17 functions first compute the corresponding inverse mapping @\<fx,fy>:dst->src@
18 and then use the above formula.
19
20 The actual implementations of the geometrical transformations, from the most
21 generic remap and to the simplest and the fastest resize, need to solve two main
22 problems with the above formula:
23
24 * Extrapolation of non-existing pixels.
25 Similarly to the filtering functions described in the previous section, for some
26 @(x,y)@, either one of @fx(x,y)@, or @fy(x,y)@, or both of them may fall outside
27 of the image. In this case, an extrapolation method needs to be used. OpenCV
28 provides the same selection of extrapolation methods as in the filtering
29 functions. In addition, it provides the method 'BorderTransparent'. This means
30 that the corresponding pixels in the destination image will not be modified at
31 all.
32
33 * Interpolation of pixel values.
34 Usually @fx(x,y)@ and @fy(x,y)@ are floating-point numbers. This means that
35 @\<fx,fy>@ can be either an affine or perspective transformation, or radial lens
36 distortion correction, and so on. So, a pixel value at fractional coordinates
37 needs to be retrieved. In the simplest case, the coordinates can be just rounded
38 to the nearest integer coordinates and the corresponding pixel can be used. This
39 is called a nearest-neighbor interpolation. However, a better result can be
40 achieved by using more sophisticated interpolation methods , where a polynomial
41 function is fit into some neighborhood of the computed pixel
42 @(fx(x,y),fy(x,y))@, and then the value of the polynomial at @(fx(x,y),fy(x,y))@
43 is taken as the interpolated pixel value. In OpenCV, you can choose between
44 several interpolation methods. See resize for details.
45 -}
46 module OpenCV.ImgProc.GeometricImgTransform
47 ( ResizeAbsRel(..)
48 , resize
49 , warpAffine
50 , warpPerspective
51 , invertAffineTransform
52 , getPerspectiveTransform
53 , getRotationMatrix2D
54 , remap
55 , undistort
56 ) where
57
58 import "base" Data.Int ( Int32 )
59 import "base" Foreign.C.Types ( CFloat, CDouble )
60 import "base" System.IO.Unsafe ( unsafePerformIO )
61 import qualified Data.Vector as V
62 import qualified "inline-c" Language.C.Inline as C
63 import qualified "inline-c" Language.C.Inline.Unsafe as CU
64 import qualified "inline-c-cpp" Language.C.Inline.Cpp as C
65 import "linear" Linear.V2 ( V2(..) )
66 import "linear" Linear.Vector ( zero )
67 import "this" OpenCV.Core.Types
68 import "this" OpenCV.ImgProc.Types
69 import "this" OpenCV.Internal.C.Inline ( openCvCtx )
70 import "this" OpenCV.Internal.C.Types
71 import "this" OpenCV.Internal.Core.Types
72 import "this" OpenCV.Internal.Core.Types.Mat
73 import "this" OpenCV.Internal.Exception
74 import "this" OpenCV.Internal.ImgProc.Types
75 import "this" OpenCV.TypeLevel
76
77 --------------------------------------------------------------------------------
78
79 C.context openCvCtx
80
81 C.include "opencv2/core.hpp"
82 C.include "opencv2/imgproc.hpp"
83 C.using "namespace cv"
84
85 #include <bindings.dsl.h>
86 #include "opencv2/core.hpp"
87 #include "opencv2/imgproc.hpp"
88
89 #include "namespace.hpp"
90
91 --------------------------------------------------------------------------------
92
93 data ResizeAbsRel
94 = ResizeAbs Size2i -- ^ Resize to an absolute size.
95 | ResizeRel (V2 Double)
96 -- ^ Resize with relative factors for both the width and the height.
97 deriving Show
98
99 marshalResizeAbsRel
100 :: ResizeAbsRel
101 -> (Size2i, CDouble, CDouble)
102 marshalResizeAbsRel (ResizeAbs s) = (s, 0 , 0 )
103 marshalResizeAbsRel (ResizeRel f) = (s, c'fx, c'fy)
104 where
105 s :: Size2i
106 s = toSize (zero :: V2 Int32)
107
108 (V2 c'fx c'fy) = realToFrac <$> f
109
110 {- | Resizes an image
111
112 To shrink an image, it will generally look best with 'InterArea' interpolation,
113 whereas to enlarge an image, it will generally look best with 'InterCubic'
114 (slow) or 'InterLinear' (faster but still looks OK).
115
116 Example:
117
118 @
119 resizeInterAreaImg :: Mat ('S ['D, 'D]) ('S 3) ('S Word8)
120 resizeInterAreaImg = exceptError $
121 withMatM (h ::: w + (w \`div` 2) ::: Z)
122 (Proxy :: Proxy 3)
123 (Proxy :: Proxy Word8)
124 transparent $ \\imgM -> do
125 birds_resized <-
126 pureExcept $ resize (ResizeRel $ pure 0.5) InterArea birds_768x512
127 matCopyToM imgM (V2 0 0) birds_768x512 Nothing
128 matCopyToM imgM (V2 w 0) birds_resized Nothing
129 lift $ arrowedLine imgM (V2 startX y) (V2 pointX y) red 4 LineType_8 0 0.15
130 where
131 [h, w] = miShape $ matInfo birds_768x512
132 startX = round $ fromIntegral w * (0.95 :: Double)
133 pointX = round $ fromIntegral w * (1.05 :: Double)
134 y = h \`div` 4
135 @
136
137 <<doc/generated/examples/resizeInterAreaImg.png resizeInterAreaImg>>
138
139 <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/geometric_transformations.html#resize OpenCV Sphinx doc>
140 -}
141 resize
142 :: ResizeAbsRel
143 -> InterpolationMethod
144 -> Mat ('S [height, width]) channels depth
145 -> CvExcept (Mat ('S ['D, 'D]) channels depth)
146 resize factor interpolationMethod src = unsafeWrapException $ do
147 dst <- newEmptyMat
148 handleCvException (pure $ unsafeCoerceMat dst) $
149 withPtr src $ \srcPtr ->
150 withPtr dst $ \dstPtr ->
151 withPtr dsize $ \dsizePtr ->
152 [cvExcept|
153 cv::resize
154 ( *$(Mat * srcPtr)
155 , *$(Mat * dstPtr)
156 , *$(Size2i * dsizePtr)
157 , $(double fx)
158 , $(double fy)
159 , $(int32_t c'interpolation)
160 );
161 |]
162 where
163 (dsize, fx, fy) = marshalResizeAbsRel factor
164 c'interpolation = marshalInterpolationMethod interpolationMethod
165
166 #num WARP_FILL_OUTLIERS
167 #num WARP_INVERSE_MAP
168
169 {- | Applies an affine transformation to an image
170
171 Example:
172
173 @
174 rotateBirds :: Mat (ShapeT [2, 3]) ('S 1) ('S Double)
175 rotateBirds = getRotationMatrix2D (V2 256 170 :: V2 CFloat) 45 0.75
176
177 warpAffineImg :: Kodak_512x341
178 warpAffineImg = exceptError $
179 warpAffine birds_512x341 rotateBirds InterArea False False (BorderConstant black)
180
181 warpAffineInvImg :: Kodak_512x341
182 warpAffineInvImg = exceptError $
183 warpAffine warpAffineImg rotateBirds InterCubic True False (BorderConstant black)
184 @
185
186 <<doc/generated/birds_512x341.png original >>
187 <<doc/generated/examples/warpAffineImg.png warpAffineImg >>
188 <<doc/generated/examples/warpAffineInvImg.png warpAffineInvImg>>
189
190 <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/geometric_transformations.html#warpaffine OpenCV Sphinx doc>
191 -}
192 warpAffine
193 :: Mat ('S [height, width]) channels depth -- ^ Source image.
194 -> Mat (ShapeT [2, 3]) ('S 1) ('S Double) -- ^ Affine transformation matrix.
195 -> InterpolationMethod
196 -> Bool -- ^ Perform the inverse transformation.
197 -> Bool -- ^ Fill outliers.
198 -> BorderMode -- ^ Pixel extrapolation method.
199 -> CvExcept (Mat ('S [height, width]) channels depth) -- ^ Transformed source image.
200 warpAffine src transform interpolationMethod inverse fillOutliers borderMode =
201 unsafeWrapException $ do
202 dst <- newEmptyMat
203 handleCvException (pure $ unsafeCoerceMat dst) $
204 withPtr src $ \srcPtr ->
205 withPtr dst $ \dstPtr ->
206 withPtr transform $ \transformPtr ->
207 withPtr borderValue $ \borderValuePtr ->
208 [cvExcept|
209 Mat * src = $(Mat * srcPtr);
210 cv::warpAffine
211 ( *src
212 , *$(Mat * dstPtr)
213 , *$(Mat * transformPtr)
214 , src->size()
215 , $(int32_t c'interpolationMethod) | $(int32_t c'inverse) | $(int32_t c'fillOutliers)
216 , $(int32_t c'borderMode)
217 , *$(Scalar * borderValuePtr)
218 );
219 |]
220 where
221 c'interpolationMethod = marshalInterpolationMethod interpolationMethod
222 c'inverse = if inverse then c'WARP_INVERSE_MAP else 0
223 c'fillOutliers = if fillOutliers then c'WARP_FILL_OUTLIERS else 0
224 (c'borderMode, borderValue) = marshalBorderMode borderMode
225
226 -- | Applies a perspective transformation to an image
227 --
228 -- <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/geometric_transformations.html#warpperspective OpenCV Sphinx doc>
229 warpPerspective
230 :: Mat ('S [height, width]) channels depth -- ^ Source image.
231 -> Mat (ShapeT [3, 3]) ('S 1) ('S Double) -- ^ Perspective transformation matrix.
232 -> InterpolationMethod
233 -> Bool -- ^ Perform the inverse transformation.
234 -> Bool -- ^ Fill outliers.
235 -> BorderMode -- ^ Pixel extrapolation method.
236 -> CvExcept (Mat ('S [height, width]) channels depth) -- ^ Transformed source image.
237 warpPerspective src transform interpolationMethod inverse fillOutliers borderMode =
238 unsafeWrapException $ do
239 dst <- newEmptyMat
240 handleCvException (pure $ unsafeCoerceMat dst) $
241 withPtr src $ \srcPtr ->
242 withPtr dst $ \dstPtr ->
243 withPtr transform $ \transformPtr ->
244 withPtr borderValue $ \borderValuePtr ->
245 [cvExcept|
246 Mat * src = $(Mat * srcPtr);
247 cv::warpPerspective
248 ( *src
249 , *$(Mat * dstPtr)
250 , *$(Mat * transformPtr)
251 , src->size()
252 , $(int32_t c'interpolationMethod) | $(int32_t c'inverse) | $(int32_t c'fillOutliers)
253 , $(int32_t c'borderMode)
254 , *$(Scalar * borderValuePtr)
255 );
256 |]
257 where
258 c'interpolationMethod = marshalInterpolationMethod interpolationMethod
259 c'inverse = if inverse then c'WARP_INVERSE_MAP else 0
260 c'fillOutliers = if fillOutliers then c'WARP_FILL_OUTLIERS else 0
261 (c'borderMode, borderValue) = marshalBorderMode borderMode
262
263 -- | Inverts an affine transformation
264 --
265 -- <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/geometric_transformations.html#invertaffinetransform OpenCV Sphinx doc>
266 invertAffineTransform
267 :: Mat (ShapeT [2, 3]) ('S 1) depth -- ^
268 -> CvExcept (Mat (ShapeT [2, 3]) ('S 1) depth)
269 invertAffineTransform matIn = unsafeWrapException $ do
270 matOut <- newEmptyMat
271 handleCvException (pure $ unsafeCoerceMat matOut) $
272 withPtr matIn $ \matInPtr ->
273 withPtr matOut $ \matOutPtr ->
274 [cvExcept|
275 cv::invertAffineTransform(*$(Mat * matInPtr), *$(Mat * matOutPtr));
276 |]
277
278 {- | Calculates a perspective transformation matrix for 2D perspective transform
279
280 <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/geometric_transformations.html#getperspectivetransform OpenCV Sphinx doc>
281 -}
282 getPerspectiveTransform
283 :: (IsPoint2 point2 CFloat)
284 => V.Vector (point2 CFloat) -- ^ Array of 4 floating-point Points representing 4 vertices in source image
285 -> V.Vector (point2 CFloat) -- ^ Array of 4 floating-point Points representing 4 vertices in destination image
286 -> Mat (ShapeT [3,3]) ('S 1) ('S Double) -- ^ The output perspective transformation, 3x3 floating-point-matrix.
287 getPerspectiveTransform srcPts dstPts = unsafeCoerceMat $ unsafePerformIO $
288 withArrayPtr (V.map toPoint srcPts) $ \srcPtsPtr ->
289 withArrayPtr (V.map toPoint dstPts) $ \dstPtsPtr ->
290 fromPtr
291 [CU.block| Mat * {
292 return new cv::Mat
293 ( cv::getPerspectiveTransform($(Point2f * srcPtsPtr), $(Point2f * dstPtsPtr))
294 );
295 }|]
296
297 {- | Calculates an affine matrix of 2D rotation
298
299 <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/geometric_transformations.html#getrotationmatrix2d OpenCV Sphinx doc>
300 -}
301 getRotationMatrix2D
302 :: (IsPoint2 point2 CFloat)
303 => point2 CFloat -- ^ Center of the rotation in the source image.
304 -> Double
305 -- ^ Rotation angle in degrees. Positive values mean counter-clockwise
306 -- rotation (the coordinate origin is assumed to be the top-left corner).
307 -> Double -- ^ Isotropic scale factor.
308 -> Mat (ShapeT [2, 3]) ('S 1) ('S Double) -- ^ The output affine transformation, 2x3 floating-point matrix.
309 getRotationMatrix2D center angle scale = unsafeCoerceMat $ unsafePerformIO $
310 withPtr (toPoint center) $ \centerPtr ->
311 fromPtr
312 [CU.block| Mat * {
313 return new cv::Mat
314 ( cv::getRotationMatrix2D
315 ( *$(Point2f * centerPtr)
316 , $(double c'angle)
317 , $(double c'scale)
318 )
319 );
320 }|]
321 where
322 c'angle = realToFrac angle
323 c'scale = realToFrac scale
324
325 {- | Applies a generic geometrical transformation to an image.
326
327 The function remap transforms the source image using the specified map:
328
329 @dst(x,y) = src(map(x,y))@
330
331 Example:
332
333 @
334 remapImg
335 :: forall (width :: Nat)
336 (height :: Nat)
337 (channels :: Nat)
338 (depth :: * )
339 . (Mat ('S ['S height, 'S width]) ('S channels) ('S depth) ~ Kodak_512x341)
340 => Mat ('S ['S height, 'S width]) ('S channels) ('S depth)
341 remapImg = exceptError $ remap birds_512x341 transform InterLinear (BorderConstant black)
342 where
343 transform = exceptError $
344 matFromFunc (Proxy :: Proxy [height, width])
345 (Proxy :: Proxy 2)
346 (Proxy :: Proxy Float)
347 exampleFunc
348
349 exampleFunc [_y, x] 0 = wobble x w
350 exampleFunc [ y, _x] 1 = wobble y h
351 exampleFunc _pos _channel = error "impossible"
352
353 wobble :: Int -> Float -> Float
354 wobble v s = let v' = fromIntegral v
355 n = v' / s
356 in v' + (s * 0.05 * sin (n * 2 * pi * 5))
357
358 w = fromInteger $ natVal (Proxy :: Proxy width)
359 h = fromInteger $ natVal (Proxy :: Proxy height)
360 @
361
362 <<doc/generated/birds_512x341.png original>>
363 <<doc/generated/examples/remapImg.png remapImg>>
364
365 <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/geometric_transformations.html#remap OpenCV documentation>
366 -}
367 remap
368 :: Mat ('S [inputHeight, inputWidth]) inputChannels inputDepth
369 -- ^ Source image.
370 -> Mat ('S [outputHeight, outputWidth]) ('S 2) ('S Float)
371 -- ^ A map of @(x, y)@ points.
372 -> InterpolationMethod
373 -- ^ Interpolation method to use. Note that 'InterArea' is not
374 -- supported by this function.
375 -> BorderMode
376 -> CvExcept (Mat ('S [outputHeight, outputWidth]) inputChannels inputDepth)
377 remap src mapping interpolationMethod borderMode = unsafeWrapException $ do
378 dst <- newEmptyMat
379 handleCvException (pure $ unsafeCoerceMat dst) $
380 withPtr src $ \srcPtr ->
381 withPtr dst $ \dstPtr ->
382 withPtr mapping $ \mappingPtr ->
383 withPtr borderValue $ \borderValuePtr ->
384 [cvExcept|
385 cv::remap
386 ( *$(Mat * srcPtr)
387 , *$(Mat * dstPtr)
388 , *$(Mat * mappingPtr)
389 , {}
390 , $(int32_t c'interpolation)
391 , $(int32_t c'borderMode)
392 , *$(Scalar * borderValuePtr)
393 );
394 |]
395 where
396 c'interpolation = marshalInterpolationMethod interpolationMethod
397 (c'borderMode, borderValue) = marshalBorderMode borderMode
398
399
400 {-|
401
402 The function transforms an image to compensate radial and tangential lens
403 distortion.
404
405 Those pixels in the destination image, for which there is no correspondent
406 pixels in the source image, are filled with zeros (black color).
407
408 The camera matrix and the distortion parameters can be determined using
409 @calibrateCamera@ . If the resolution of images is different from the resolution
410 used at the calibration stage, f_x, f_y, c_x and c_y need to be scaled accordingly,
411 while the distortion coefficients remain the same.
412
413 Example:
414
415 @
416 undistortImg
417 :: forall (width :: Nat)
418 (height :: Nat)
419 (channels :: Nat)
420 (depth :: * )
421 . (Mat ('S ['S height, 'S width]) ('S channels) ('S depth) ~ Kodak_512x341)
422 => Mat ('S ['S height, 'S width]) ('S channels) ('S depth)
423 undistortImg = undistort birds_512x341 intrinsics coefficients
424 where intrinsics :: M33 Float
425 intrinsics =
426 V3 (V3 15840.8 0 2049)
427 (V3 0 15830.3 1097)
428 (V3 0 0 1)
429
430 coefficients :: Matx51d
431 coefficients = unsafePerformIO $
432 newMatx51d
433 (-2.239145913492247)
434 13.674526561736648
435 3.650187848850095e-2
436 (-2.0042015752853796e-2)
437 (-0.44790921357620456)
438 @
439
440 <<doc/generated/birds_512x341.png original>>
441 <<doc/generated/examples/undistortImg.png undistortImg>>
442
443 -}
444 undistort
445 :: ( ToMat m33d, MatShape m33d ~ 'S '[ 'S 3, 'S 3 ]
446 , ToMat distCoeffs, MatShape distCoeffs `In` '[ 'S '[ 'S 4, 'S 1 ]
447 , 'S '[ 'S 5, 'S 1 ]
448 , 'S '[ 'S 8, 'S 1 ]
449 , 'S '[ 'S 12, 'S 1 ]
450 , 'S '[ 'S 14, 'S 1 ]
451 ]
452 )
453 => Mat ('S '[ h, w]) c d
454 -- ^ The source image to undistort.
455 -> m33d
456 -- ^ The 3x3 matrix of intrinsic parameters.
457 -> distCoeffs
458 -- ^ The distortion coefficients
459 -- (k1,k2,p1,p2[,k3[,k4,k5,k6[,s1,s2,s3,s4[,τx,τy]]]]) of 4, 5, 8, 12 or 14 elements.
460 -> Mat ('S '[ h, w]) c d
461 undistort img camera distCoeffs = unsafePerformIO $ do
462 dst <- newEmptyMat
463 withPtr img $ \imgPtr ->
464 withPtr dst $ \dstPtr ->
465 withPtr (toMat camera) $ \cameraPtr ->
466 withPtr (toMat distCoeffs) $ \distCoeffsPtr ->
467 [C.block| void {
468 undistort(*$(Mat * imgPtr),
469 *$(Mat * dstPtr),
470 *$(Mat * cameraPtr),
471 *$(Mat * distCoeffsPtr));
472 }|]
473 return (unsafeCoerceMat dst)