never executed always true always false
1 {-# language CPP #-}
2 {-# language QuasiQuotes #-}
3 {-# language TemplateHaskell #-}
4
5 #if __GLASGOW_HASKELL__ >= 800
6 {-# options_ghc -Wno-redundant-constraints #-}
7 #endif
8
9 {- |
10
11 Functions and classes described in this section are used to perform various
12 linear or non-linear filtering operations on 2D images (represented as
13 @'Mat'@\'s). It means that for each pixel location @(x,y)@ in the source image
14 (normally, rectangular), its neighborhood is considered and used to compute the
15 response. In case of a linear filter, it is a weighted sum of pixel values. In
16 case of morphological operations, it is the minimum or maximum values, and so
17 on. The computed response is stored in the destination image at the same
18 location @(x,y)@. It means that the output image will be of the same size as the
19 input image. Normally, the functions support multi-channel arrays, in which case
20 every channel is processed independently. Therefore, the output image will also
21 have the same number of channels as the input one.
22
23 Another common feature of the functions and classes described in this section is
24 that, unlike simple arithmetic functions, they need to extrapolate values of
25 some non-existing pixels. For example, if you want to smooth an image using a
26 Gaussian @3x3@ filter, then, when processing the left-most pixels in each
27 row, you need pixels to the left of them, that is, outside of the image. You can
28 let these pixels be the same as the left-most image pixels ("replicated border"
29 extrapolation method), or assume that all the non-existing pixels are zeros
30 ("constant border" extrapolation method), and so on. OpenCV enables you to
31 specify the extrapolation method.
32 -}
33 module OpenCV.ImgProc.ImgFiltering
34 ( MorphShape(..)
35 , MorphOperation(..)
36
37 , bilateralFilter
38 , laplacian
39 , medianBlur
40 , erode
41 , dilate
42 , filter2D
43 , morphologyEx
44 , getStructuringElement
45 , blur
46 , gaussianBlur
47 ) where
48
49 import "base" Data.Int
50 import "base" Data.Maybe
51 import "base" Data.Proxy
52 import "base" Data.Word
53 import qualified "inline-c" Language.C.Inline as C
54 import qualified "inline-c-cpp" Language.C.Inline.Cpp as C
55 import "linear" Linear.V2 ( V2(..) )
56 import "this" OpenCV.Core.Types
57 import "this" OpenCV.ImgProc.Types
58 import "this" OpenCV.Internal.C.Inline ( openCvCtx )
59 import "this" OpenCV.Internal.C.Types
60 import "this" OpenCV.Internal.Core.Types.Mat
61 import "this" OpenCV.Internal.Exception
62 import "this" OpenCV.Internal.ImgProc.Types ( marshalBorderMode )
63 import "this" OpenCV.TypeLevel
64
65 --------------------------------------------------------------------------------
66
67 C.context openCvCtx
68
69 C.include "opencv2/core.hpp"
70 C.include "opencv2/imgproc.hpp"
71 C.using "namespace cv"
72
73 #include <bindings.dsl.h>
74 #include "opencv2/core.hpp"
75 #include "opencv2/imgproc.hpp"
76
77 #include "namespace.hpp"
78 #include "hsc_macros.hpp"
79
80
81 --------------------------------------------------------------------------------
82 -- Constants
83 --------------------------------------------------------------------------------
84
85 defaultAnchor :: Point2i
86 defaultAnchor = toPoint (pure (-1) :: V2 Int32)
87
88
89 --------------------------------------------------------------------------------
90 -- Types
91 --------------------------------------------------------------------------------
92
93 data MorphShape
94 = MorphRect -- ^ A rectangular structuring element.
95 | MorphEllipse
96 -- ^ An elliptic structuring element, that is, a filled ellipse inscribed
97 -- into the rectangle Rect(0, 0, esize.width, 0.esize.height).
98 | MorphCross !Point2i -- ^ A cross-shaped structuring element.
99
100 #num MORPH_RECT
101 #num MORPH_ELLIPSE
102 #num MORPH_CROSS
103
104 marshalMorphShape :: MorphShape -> (Int32, Point2i)
105 marshalMorphShape = \case
106 MorphRect -> (c'MORPH_RECT , defaultAnchor)
107 MorphEllipse -> (c'MORPH_ELLIPSE, defaultAnchor)
108 MorphCross anchor -> (c'MORPH_CROSS , anchor)
109
110 data MorphOperation
111 = MorphOpen -- ^ An opening operation: dilate . erode
112 | MorphClose -- ^ A closing operation: erode . dilate
113 | MorphGradient -- ^ A morphological gradient: dilate - erode
114 | MorphTopHat -- ^ "top hat": src - open
115 | MorphBlackHat -- ^ "black hat": close - src
116
117 #num MORPH_OPEN
118 #num MORPH_CLOSE
119 #num MORPH_GRADIENT
120 #num MORPH_TOPHAT
121 #num MORPH_BLACKHAT
122
123 marshalMorphOperation :: MorphOperation -> Int32
124 marshalMorphOperation = \case
125 MorphOpen -> c'MORPH_OPEN
126 MorphClose -> c'MORPH_CLOSE
127 MorphGradient -> c'MORPH_GRADIENT
128 MorphTopHat -> c'MORPH_TOPHAT
129 MorphBlackHat -> c'MORPH_BLACKHAT
130
131
132 --------------------------------------------------------------------------------
133 -- Image Filtering
134 --------------------------------------------------------------------------------
135
136 {- | Calculates the bilateralFilter of an image
137
138 The function applies bilateral filtering to the input image, as described in
139 <http://www.dai.ed.ac.uk/CVonline/LOCAL_COPIES/MANDUCHI1/Bilateral_Filtering.html Bilateral_Filtering>
140 bilateralFilter can reduce unwanted noise very well while keeping edges fairly sharp. However, it is very slow compared to most filters.
141 Example:
142
143 @
144 bilateralFilterImg
145 :: forall (width :: Nat)
146 (width2 :: Nat)
147 (height :: Nat)
148 (channels :: Nat)
149 (depth :: *)
150 . ( Mat (ShapeT [height, width]) ('S channels) ('S depth) ~ Kodak_512x341
151 , width2 ~ ((*) width 2) -- TODO (RvD): HSE parse error with infix type operator
152 )
153 => Mat (ShapeT [height, width2]) ('S channels) ('S depth)
154 bilateralFilterImg = exceptError $
155 withMatM (Proxy :: Proxy [height, width2])
156 (Proxy :: Proxy channels)
157 (Proxy :: Proxy depth)
158 white $ \imgM -> do
159 birdsFiltered <- pureExcept $ bilateralFilter (Just 9) Nothing Nothing Nothing birds_512x341
160 matCopyToM imgM (V2 0 0) birds_512x341 Nothing
161 matCopyToM imgM (V2 w 0) birdsFiltered Nothing
162 where
163 w = fromInteger $ natVal (Proxy :: Proxy width)
164 @
165
166 <<doc/generated/examples/bilateralFilterImg.png bilateralFilterImg>>
167
168 <https://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/filtering.html#bilateralfilter OpenCV Sphinx doc>
169 -}
170 bilateralFilter
171 :: ( depth `In` '[Word8, Float, Double]
172 , channels `In` '[1, 3]
173 -- , Length shape <= 2
174 )
175 => Maybe Int32
176 -- ^ Diameter of each pixel neighborhood that is used during filtering.
177 -- If it is non-positive, it is computed from sigmaSpace. Default value is 5.
178 -> Maybe Double
179 -- ^ Filter sigma in the color space. A larger value of the parameter means that farther colors within
180 -- the pixel neighborhood (see sigmaSpace) will be mixed together, resulting in larger areas of semi-equal color.
181 -- Default value is 50
182 -> Maybe Double
183 -- ^ Filter sigma in the coordinate space. A larger value of the parameter means that farther pixels will
184 -- influence each other as long as their colors are close enough (see sigmaColor ). When d>0, it specifies
185 -- the neighborhood size regardless of sigmaSpace. Otherwise, d is proportional to sigmaSpace.
186 -- Default value is 50
187 -> Maybe BorderMode
188 -- ^ Pixel extrapolation method. Default value is BorderReflect101
189 -> Mat shape ('S channels) ('S depth)
190 -> CvExcept (Mat shape ('S channels) ('S depth))
191 bilateralFilter d sigmaColor sigmaSpace borderType src = unsafeWrapException $ do
192 dst <- newEmptyMat
193 handleCvException (pure $ unsafeCoerceMat dst) $
194 withPtr src $ \srcPtr ->
195 withPtr dst $ \dstPtr ->
196 [cvExcept|
197 cv::bilateralFilter
198 ( *$(Mat * srcPtr )
199 , *$(Mat * dstPtr )
200 , $(int32_t c'd )
201 , $(double c'sigmaColor)
202 , $(double c'sigmaSpace)
203 , $(int32_t c'borderType)
204 );
205 |]
206 where
207 c'd = fromMaybe 5 d
208 c'sigmaColor = maybe 50 realToFrac sigmaColor
209 c'sigmaSpace = maybe 50 realToFrac sigmaSpace
210 c'borderType = fst $ marshalBorderMode $ fromMaybe BorderReflect101 borderType
211
212
213
214 {- | Calculates the Laplacian of an image
215
216 The function calculates the Laplacian of the source image by adding up
217 the second x and y derivatives calculated using the Sobel operator.
218
219 Example:
220
221 @
222 laplacianImg
223 :: forall shape channels depth
224 . (Mat shape channels depth ~ Kodak_512x341)
225 => Mat shape ('S 1) ('S Double)
226 laplacianImg = exceptError $ do
227 imgG <- cvtColor bgr gray birds_512x341
228 laplacian Nothing Nothing Nothing Nothing imgG
229 @
230
231 <<doc/generated/examples/laplacianImg.png laplacianImg>>
232
233 <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/filtering.html#laplacian OpenCV Sphinx doc>
234 -}
235 laplacian
236 :: forall shape channels srcDepth dstDepth
237 . (ToDepth (Proxy dstDepth))
238 => Maybe Int32
239 -- ^ Aperture size used to compute the second-derivative filters. The
240 -- size must be positive and odd. Default value is 1.
241 -> Maybe Double
242 -- ^ Optional scale factor for the computed Laplacian values. Default
243 -- value is 1.
244 -> Maybe Double
245 -- ^ Optional delta value that is added to the results. Default value is
246 -- 0.
247 -> Maybe BorderMode
248 -- ^ Pixel extrapolation method.
249 -> Mat shape channels srcDepth
250 -> CvExcept (Mat shape channels ('S dstDepth))
251 laplacian ksize scale delta borderType src = unsafeWrapException $ do
252 dst <- newEmptyMat
253 handleCvException (pure $ unsafeCoerceMat dst) $
254 withPtr src $ \srcPtr ->
255 withPtr dst $ \dstPtr ->
256 [cvExcept|
257 cv::Laplacian
258 ( *$(Mat * srcPtr )
259 , *$(Mat * dstPtr )
260 , $(int32_t c'ddepth )
261 , $(int32_t c'ksize )
262 , $(double c'scale )
263 , $(double c'delta )
264 , $(int32_t c'borderType)
265 );
266 |]
267 where
268 c'ksize = fromMaybe 1 ksize
269 c'scale = maybe 1 realToFrac scale
270 c'delta = maybe 0 realToFrac delta
271 c'ddepth = marshalDepth $ toDepth (Proxy :: Proxy dstDepth)
272 c'borderType = fst $ marshalBorderMode $ fromMaybe BorderReflect101 borderType
273
274 {- | Blurs an image using the median filter
275
276 Example:
277
278 @
279 medianBlurImg
280 :: forall (width :: Nat)
281 (width2 :: Nat)
282 (height :: Nat)
283 (channels :: Nat)
284 (depth :: *)
285 . ( Mat (ShapeT [height, width]) ('S channels) ('S depth) ~ Kodak_512x341
286 , width2 ~ ((*) width 2) -- TODO (RvD): HSE parse error with infix type operator
287 )
288 => Mat (ShapeT [height, width2]) ('S channels) ('S depth)
289 medianBlurImg = exceptError $
290 withMatM (Proxy :: Proxy [height, width2])
291 (Proxy :: Proxy channels)
292 (Proxy :: Proxy depth)
293 white $ \\imgM -> do
294 birdsBlurred <- pureExcept $ medianBlur birds_512x341 13
295 matCopyToM imgM (V2 0 0) birds_512x341 Nothing
296 matCopyToM imgM (V2 w 0) birdsBlurred Nothing
297 where
298 w = fromInteger $ natVal (Proxy :: Proxy width)
299 @
300
301 <<doc/generated/examples/medianBlurImg.png medianBlurImg>>
302
303 <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/filtering.html#medianblur OpenCV Sphinx doc>
304 -}
305 -- TODO (Rvd): make ksize a type level argument
306 -- if ksize in [3, 5] then depth in [Word8, Int16, Float) else depth ~ Word8
307 medianBlur
308 :: ( depth `In` '[Word8, Word16, Float]
309 , channels `In` '[1, 3, 4]
310 -- , Length shape <= 2
311 )
312 => Mat shape ('S channels) ('S depth)
313 -- ^ Input 1-, 3-, or 4-channel image; when ksize is 3 or 5, the image
314 -- depth should be 'Word8', 'Word16', or 'Float', for
315 -- larger aperture sizes, it can only be 'Word8'.
316 -> Int32
317 -- ^ Aperture linear size; it must be odd and greater than 1, for
318 -- example: 3, 5, 7...
319 -> CvExcept (Mat shape ('S channels) ('S depth))
320 medianBlur matIn ksize = unsafeWrapException $ do
321 matOut <- newEmptyMat
322 handleCvException (pure $ unsafeCoerceMat matOut) $
323 withPtr matOut $ \matOutPtr ->
324 withPtr matIn $ \matInPtr ->
325 [cvExcept| cv::medianBlur(*$(Mat * matInPtr), *$(Mat * matOutPtr), $(int32_t ksize)); |]
326
327 {- | Blurs an image using a box filter.
328
329 Example:
330
331 @
332 boxBlurImg
333 :: forall (width :: Nat)
334 (width2 :: Nat)
335 (height :: Nat)
336 (channels :: Nat)
337 (depth :: *)
338 . ( Mat (ShapeT [height, width]) ('S channels) ('S depth) ~ Kodak_512x341
339 , width2 ~ ((*) width 2) -- TODO (RvD): HSE parse error with infix type operator
340 )
341 => Mat (ShapeT [height, width2]) ('S channels) ('S depth)
342 boxBlurImg = exceptError $
343 withMatM (Proxy :: Proxy [height, width2])
344 (Proxy :: Proxy channels)
345 (Proxy :: Proxy depth)
346 white $ \\imgM -> do
347 birdsBlurred <- pureExcept $ blur (V2 13 13 :: V2 Int32) birds_512x341
348 matCopyToM imgM (V2 0 0) birds_512x341 Nothing
349 matCopyToM imgM (V2 w 0) birdsBlurred Nothing
350 where
351 w = fromInteger $ natVal (Proxy :: Proxy width)
352 @
353
354 <<doc/generated/examples/boxBlurImg.png boxBlurImg>>
355
356 <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/filtering.html#blur OpenCV Sphinx doc>
357 -}
358 blur
359 :: ( depth `In` '[Word8, Word16, Int16, Float, Double]
360 , IsSize size Int32
361 )
362 => size Int32 -- ^ Blurring kernel size.
363 -> Mat shape ('S channels) ('S depth)
364 -> CvExcept (Mat shape ('S channels) ('S depth))
365 blur size matIn =
366 unsafeWrapException $
367 do matOut <- newEmptyMat
368 handleCvException (pure $ unsafeCoerceMat matOut) $
369 withPtr ksize $ \ksizePtr ->
370 withPtr matIn $ \matInPtr ->
371 withPtr matOut $ \matOutPtr ->
372 [cvExcept|
373 cv::blur
374 ( *$(Mat * matInPtr)
375 , *$(Mat * matOutPtr)
376 , *$(Size2i * ksizePtr)
377 );
378 |]
379 where ksize :: Size2i
380 ksize = toSize size
381
382 gaussianBlur
383 :: ( depth `In` '[Word8, Word16, Float, Double]
384 , IsSize size Int32
385 )
386 => size Int32 -- ^ Blurring kernel size.
387 -> Double -- ^ sigmaX
388 -> Double -- ^ sigmaY
389 -> Mat shape ('S channels) ('S depth)
390 -> CvExcept (Mat shape ('S channels) ('S depth))
391 gaussianBlur size sigmaX sigmaY matIn =
392 unsafeWrapException $
393 do matOut <- newEmptyMat
394 handleCvException (pure $ unsafeCoerceMat matOut) $
395 withPtr ksize $ \ksizePtr ->
396 withPtr matIn $ \matInPtr ->
397 withPtr matOut $ \matOutPtr ->
398 [cvExcept|
399 cv::GaussianBlur
400 ( *$(Mat * matInPtr)
401 , *$(Mat * matOutPtr)
402 , *$(Size2i * ksizePtr)
403 , $(double c'sigmaX)
404 , $(double c'sigmaY)
405 );
406 |]
407 where
408 ksize :: Size2i
409 ksize = toSize size
410
411 c'sigmaX = realToFrac sigmaX
412 c'sigmaY = realToFrac sigmaY
413
414 {- | Erodes an image by using a specific structuring element
415
416 Example:
417
418 @
419 erodeImg
420 :: forall (width :: Nat)
421 (width2 :: Nat)
422 (height :: Nat)
423 (channels :: Nat)
424 (depth :: *)
425 . ( Mat (ShapeT [height, width]) ('S channels) ('S depth) ~ Lambda
426 , width2 ~ ((*) width 2) -- TODO (RvD): HSE parse error with infix type operator
427 )
428 => Mat (ShapeT [height, width2]) ('S channels) ('S depth)
429 erodeImg = exceptError $
430 withMatM (Proxy :: Proxy [height, width2])
431 (Proxy :: Proxy channels)
432 (Proxy :: Proxy depth)
433 white $ \\imgM -> do
434 erodedLambda <-
435 pureExcept $ erode lambda Nothing (Nothing :: Maybe Point2i) 5 BorderReplicate
436 matCopyToM imgM (V2 0 0) lambda Nothing
437 matCopyToM imgM (V2 w 0) erodedLambda Nothing
438 where
439 w = fromInteger $ natVal (Proxy :: Proxy width)
440 @
441
442 <<doc/generated/examples/erodeImg.png erodeImg>>
443
444 <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/filtering.html#erode OpenCV Sphinx doc>
445 -}
446 erode
447 :: ( IsPoint2 point2 Int32
448 , depth `In` [Word8, Word16, Int16, Float, Double]
449 )
450 => Mat shape channels ('S depth) -- ^ Input image.
451 -> Maybe (Mat ('S [sh, sw]) ('S 1) ('S Word8))
452 -- ^ Structuring element used for erosion. If `emptyMat` is
453 -- used a @3x3@ rectangular structuring element is used. Kernel
454 -- can be created using `getStructuringElement`.
455 -> Maybe (point2 Int32) -- ^ anchor
456 -> Int -- ^ iterations
457 -> BorderMode
458 -> CvExcept (Mat shape channels ('S depth))
459 erode src mbKernel mbAnchor iterations borderMode = unsafeWrapException $ do
460 dst <- newEmptyMat
461 handleCvException (pure $ unsafeCoerceMat dst) $
462 withPtr src $ \srcPtr ->
463 withPtr dst $ \dstPtr ->
464 withPtr kernel $ \kernelPtr ->
465 withPtr anchor $ \anchorPtr ->
466 withPtr borderValue $ \borderValuePtr ->
467 [cvExcept|
468 cv::erode
469 ( *$(Mat * srcPtr )
470 , *$(Mat * dstPtr )
471 , *$(Mat * kernelPtr )
472 , *$(Point2i * anchorPtr )
473 , $(int32_t c'iterations )
474 , $(int32_t c'borderType )
475 , *$(Scalar * borderValuePtr)
476 );
477 |]
478 where
479 kernel :: Mat 'D 'D 'D
480 kernel = maybe (relaxMat emptyMat) unsafeCoerceMat mbKernel
481
482 anchor :: Point2i
483 anchor = maybe defaultAnchor toPoint mbAnchor
484
485 c'iterations = fromIntegral iterations
486 (c'borderType, borderValue) = marshalBorderMode borderMode
487
488 {- | Convolves an image with the kernel.
489
490 Example:
491
492 @
493 filter2DImg
494 :: forall (width :: Nat)
495 (width2 :: Nat)
496 (height :: Nat)
497 (channels :: Nat)
498 (depth :: *)
499 . ( Mat (ShapeT [height, width]) ('S channels) ('S depth) ~ Kodak_512x341
500 , width2 ~ ((*) width 2) -- TODO (RvD): HSE parse error with infix type operator
501 )
502 => Mat (ShapeT [height, width2]) ('S channels) ('S depth)
503 filter2DImg = exceptError $
504 withMatM (Proxy :: Proxy [height, width2])
505 (Proxy :: Proxy channels)
506 (Proxy :: Proxy depth)
507 white $ \\imgM -> do
508 filteredBird <-
509 pureExcept $ filter2D birds_512x341 kernel (Nothing :: Maybe Point2i) 0 BorderReplicate
510 matCopyToM imgM (V2 0 0) birds_512x341 Nothing
511 matCopyToM imgM (V2 w 0) filteredBird Nothing
512 where
513 w = fromInteger $ natVal (Proxy :: Proxy width)
514 kernel =
515 exceptError $
516 withMatM (Proxy :: Proxy [3, 3])
517 (Proxy :: Proxy 1)
518 (Proxy :: Proxy Double)
519 black $ \\imgM -> do
520 lift $ line imgM (V2 0 0 :: V2 Int32) (V2 0 0 :: V2 Int32) (V4 (-2) (-2) (-2) 1 :: V4 Double) 0 LineType_8 0
521 lift $ line imgM (V2 1 0 :: V2 Int32) (V2 0 1 :: V2 Int32) (V4 (-1) (-1) (-1) 1 :: V4 Double) 0 LineType_8 0
522 lift $ line imgM (V2 1 1 :: V2 Int32) (V2 1 1 :: V2 Int32) (V4 1 1 1 1 :: V4 Double) 0 LineType_8 0
523 lift $ line imgM (V2 1 2 :: V2 Int32) (V2 2 1 :: V2 Int32) (V4 1 1 1 1 :: V4 Double) 0 LineType_8 0
524 lift $ line imgM (V2 2 2 :: V2 Int32) (V2 2 2 :: V2 Int32) (V4 2 2 2 1 :: V4 Double) 0 LineType_8 0
525 @
526
527 <<doc/generated/examples/filter2DImg.png filter2DImg>>
528
529
530 <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/filtering.html#filter2d OpenCV Sphinx doc>
531 -}
532 filter2D
533 :: ( IsPoint2 point2 Int32
534 , depth `In` [Word8, Word16, Int16, Float, Double]
535 )
536 => Mat shape channels ('S depth) -- ^ Input image.
537 -> Mat ('S [sh, sw]) ('S 1) ('S Double)
538 -- ^ convolution kernel (or rather a correlation kernel),
539 -- a single-channel floating point matrix; if you want to
540 -- apply different kernels to different channels, split the
541 -- image into separate color planes using split and process
542 -- them individually.
543 -> Maybe (point2 Int32) -- ^ anchor
544 -> Double -- ^ delta
545 -> BorderMode
546 -> CvExcept (Mat shape channels ('S depth))
547 filter2D src kernel mbAnchor delta borderMode = unsafeWrapException $ do
548 dst <- newEmptyMat
549 handleCvException (pure $ unsafeCoerceMat dst) $
550 withPtr src $ \srcPtr ->
551 withPtr dst $ \dstPtr ->
552 withPtr kernel $ \kernelPtr ->
553 withPtr anchor $ \anchorPtr ->
554 [cvExcept|
555 cv::filter2D
556 ( *$(Mat * srcPtr )
557 , *$(Mat * dstPtr )
558 , -1
559 , *$(Mat * kernelPtr )
560 , *$(Point2i * anchorPtr )
561 , $(double c'delta )
562 , $(int32_t c'borderType )
563 );
564 |]
565 where
566 anchor :: Point2i
567 anchor = maybe defaultAnchor toPoint mbAnchor
568
569 c'delta = realToFrac delta
570 (c'borderType, _) = marshalBorderMode borderMode
571
572 {- | Dilates an image by using a specific structuring element
573
574 Example:
575
576 @
577 dilateImg
578 :: forall (width :: Nat)
579 (width2 :: Nat)
580 (height :: Nat)
581 (channels :: Nat)
582 (depth :: *)
583 . ( Mat (ShapeT [height, width]) ('S channels) ('S depth) ~ Lambda
584 , width2 ~ ((*) width 2) -- TODO (RvD): HSE parse error with infix type operator
585 )
586 => Mat (ShapeT [height, width2]) ('S channels) ('S depth)
587 dilateImg = exceptError $
588 withMatM (Proxy :: Proxy [height, width2])
589 (Proxy :: Proxy channels)
590 (Proxy :: Proxy depth)
591 white $ \\imgM -> do
592 dilatedLambda <-
593 pureExcept $ dilate lambda Nothing (Nothing :: Maybe Point2i) 3 BorderReplicate
594 matCopyToM imgM (V2 0 0) lambda Nothing
595 matCopyToM imgM (V2 w 0) dilatedLambda Nothing
596 where
597 w = fromInteger $ natVal (Proxy :: Proxy width)
598 @
599
600 <<doc/generated/examples/dilateImg.png dilateImg>>
601
602
603 <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/filtering.html#dilate OpenCV Sphinx doc>
604 -}
605 dilate
606 :: ( IsPoint2 point2 Int32
607 , depth `In` [Word8, Word16, Int16, Float, Double]
608 )
609 => Mat shape channels ('S depth) -- ^ Input image.
610 -> Maybe (Mat ('S [sh, sw]) ('S 1) ('S Word8))
611 -- ^ Structuring element used for dilation. If `emptyMat` is
612 -- used a @3x3@ rectangular structuring element is used. Kernel
613 -- can be created using `getStructuringElement`.
614 -> Maybe (point2 Int32) -- ^ anchor
615 -> Int -- ^ iterations
616 -> BorderMode
617 -> CvExcept (Mat shape channels ('S depth))
618 dilate src mbKernel mbAnchor iterations borderMode = unsafeWrapException $ do
619 dst <- newEmptyMat
620 handleCvException (pure $ unsafeCoerceMat dst) $
621 withPtr src $ \srcPtr ->
622 withPtr dst $ \dstPtr ->
623 withPtr kernel $ \kernelPtr ->
624 withPtr anchor $ \anchorPtr ->
625 withPtr borderValue $ \borderValuePtr ->
626 [cvExcept|
627 cv::dilate
628 ( *$(Mat * srcPtr )
629 , *$(Mat * dstPtr )
630 , *$(Mat * kernelPtr )
631 , *$(Point2i * anchorPtr )
632 , $(int32_t c'iterations )
633 , $(int32_t c'borderType )
634 , *$(Scalar * borderValuePtr)
635 );
636 |]
637 where
638 kernel :: Mat 'D 'D 'D
639 kernel = maybe (relaxMat emptyMat) unsafeCoerceMat mbKernel
640
641 anchor :: Point2i
642 anchor = maybe defaultAnchor toPoint mbAnchor
643
644 c'iterations = fromIntegral iterations
645 (c'borderType, borderValue) = marshalBorderMode borderMode
646
647 {- | Performs advanced morphological transformations
648
649 <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/filtering.html#morphologyex OpenCV Sphinx doc>
650 -}
651 morphologyEx
652 :: ( IsPoint2 point2 Int32
653 , depth `In` [Word8, Word16, Int16, Float, Double]
654 )
655 => Mat shape channels ('S depth) -- ^ Source image.
656 -> MorphOperation -- ^ Type of a morphological operation.
657 -> Mat 'D 'D 'D -- ^ Structuring element.
658 -> Maybe (point2 Int32) -- ^ Anchor position with the kernel.
659 -> Int -- ^ Number of times erosion and dilation are applied.
660 -> BorderMode
661 -> CvExcept (Mat shape channels ('S depth))
662 morphologyEx src op kernel mbAnchor iterations borderMode = unsafeWrapException $ do
663 dst <- newEmptyMat
664 handleCvException (pure $ unsafeCoerceMat dst) $
665 withPtr src $ \srcPtr ->
666 withPtr dst $ \dstPtr ->
667 withPtr kernel $ \kernelPtr ->
668 withPtr anchor $ \anchorPtr ->
669 withPtr borderValue $ \borderValuePtr ->
670 [cvExcept|
671 cv::morphologyEx
672 ( *$(Mat * srcPtr )
673 , *$(Mat * dstPtr )
674 , $(int32_t c'op )
675 , *$(Mat * kernelPtr )
676 , *$(Point2i * anchorPtr )
677 , $(int32_t c'iterations )
678 , $(int32_t c'borderType )
679 , *$(Scalar * borderValuePtr)
680 );
681 |]
682
683 where
684 c'op = marshalMorphOperation op
685
686 anchor :: Point2i
687 anchor = maybe defaultAnchor toPoint mbAnchor
688
689 c'iterations = fromIntegral iterations
690 (c'borderType, borderValue) = marshalBorderMode borderMode
691
692
693 {- | Returns a structuring element of the specified size and shape for
694 morphological operations
695
696 Example:
697
698 @
699 type StructureImg = Mat (ShapeT [128, 128]) ('S 1) ('S Word8)
700
701 structureImg :: MorphShape -> StructureImg
702 structureImg shape = exceptError $ do
703 mat <- getStructuringElement shape (Proxy :: Proxy 128) (Proxy :: Proxy 128)
704 img <- matConvertTo (Just 255) Nothing mat
705 bitwiseNot img
706
707 morphRectImg :: StructureImg
708 morphRectImg = structureImg MorphRect
709
710 morphEllipseImg :: StructureImg
711 morphEllipseImg = structureImg MorphEllipse
712
713 morphCrossImg :: StructureImg
714 morphCrossImg = structureImg $ MorphCross $ toPoint (pure (-1) :: V2 Int32)
715 @
716
717 <<doc/generated/examples/morphRectImg.png morphRectImg>>
718 <<doc/generated/examples/morphEllipseImg.png morphEllipseImg>>
719 <<doc/generated/examples/morphCrossImg.png morphCrossImg>>
720
721 <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/filtering.html#getstructuringelement OpenCV Sphinx doc>
722 -}
723 getStructuringElement
724 :: (ToInt32 height, ToInt32 width)
725 => MorphShape -- ^
726 -> height
727 -> width
728 -> CvExcept (Mat (ShapeT (height ::: width ::: Z)) ('S 1) ('S Word8))
729 getStructuringElement morphShape height width = unsafeWrapException $ do
730 element <- newEmptyMat
731 handleCvException (pure $ unsafeCoerceMat element) $
732 withPtr ksize $ \ksizePtr ->
733 withPtr anchor $ \anchorPtr ->
734 withPtr element $ \elementPtr ->
735 [cvExcept|
736 *$(Mat * elementPtr) =
737 cv::getStructuringElement
738 ( $(int32_t c'morphShape)
739 , *$(Size2i * ksizePtr)
740 , *$(Point2i * anchorPtr)
741 );
742 |]
743 where
744 ksize :: Size2i
745 ksize = toSize $ V2 (toInt32 width) (toInt32 height)
746 (c'morphShape, anchor) = marshalMorphShape morphShape