never executed always true always false
1 {-# LANGUAGE QuasiQuotes #-}
2 {-# LANGUAGE TemplateHaskell #-}
3
4 module OpenCV.ImgProc.Drawing
5 ( LineType(..)
6 , Font(..)
7 , FontFace(..)
8 , FontSlant(..)
9 , ContourDrawMode(..)
10 , arrowedLine
11 , circle
12 , ellipse
13 , fillConvexPoly
14 , fillPoly
15 , polylines
16 , line
17 , getTextSize
18 , putText
19 , rectangle
20 , drawContours
21 , marker
22 ) where
23
24 import "base" Data.Int
25 import qualified "vector" Data.Vector as V
26 import qualified "vector" Data.Vector.Storable as VS
27 import "base" Foreign.Marshal.Alloc ( alloca )
28 import "base" Foreign.Marshal.Array ( withArray )
29 import "base" Foreign.Marshal.Utils ( fromBool )
30 import "base" Foreign.Ptr ( Ptr )
31 import "base" Foreign.Storable ( peek )
32 import qualified "inline-c" Language.C.Inline as C
33 import qualified "inline-c-cpp" Language.C.Inline.Cpp as C
34 import "primitive" Control.Monad.Primitive ( PrimMonad, PrimState, unsafePrimToPrim )
35 import "text" Data.Text ( Text )
36 import qualified "text" Data.Text as T ( append )
37 import qualified "text" Data.Text.Foreign as T ( withCStringLen )
38 import "this" OpenCV.Core.Types
39 import "this" OpenCV.Internal.C.Inline ( openCvCtx )
40 import "this" OpenCV.Internal.Core.Types
41 import "this" OpenCV.Internal.C.Types
42 import "this" OpenCV.TypeLevel
43 import "base" System.IO.Unsafe ( unsafePerformIO )
44
45 --------------------------------------------------------------------------------
46
47 C.context openCvCtx
48
49 C.include "opencv2/core.hpp"
50 C.include "opencv2/imgproc.hpp"
51 C.using "namespace cv"
52
53 #include <bindings.dsl.h>
54 #include "opencv2/core.hpp"
55 #include "opencv2/imgproc.hpp"
56
57 #include "namespace.hpp"
58
59 --------------------------------------------------------------------------------
60
61 data LineType
62 = LineType_8
63 -- ^ 8-connected line.
64 --
65 -- <<doc/generated/LineType_8.png 8-connected line>>
66 | LineType_4
67 -- ^ 4-connected line.
68 --
69 -- <<doc/generated/LineType_4.png 4-connected line>>
70 | LineType_AA
71 -- ^ Antialiased line.
72 --
73 -- <<doc/generated/LineType_AA.png Antialised line>>
74 deriving (Show, Enum, Bounded)
75
76 #num LINE_8
77 #num LINE_4
78 #num LINE_AA
79
80 marshalLineType :: LineType -> Int32
81 marshalLineType = \case
82 LineType_8 -> c'LINE_8
83 LineType_4 -> c'LINE_4
84 LineType_AA -> c'LINE_AA
85
86 data Font
87 = Font
88 { _fontFace :: !FontFace
89 , _fontSlant :: !FontSlant
90 , _fontScale :: !Double
91 } deriving (Show)
92
93 data FontFace
94 = FontHersheySimplex
95 -- ^ Normal size sans-serif font. Does not have a 'Slanted' variant.
96 --
97 -- <<doc/generated/FontHersheySimplex.png FontHersheySimplex>>
98 | FontHersheyPlain
99 -- ^ Small size sans-serif font.
100 --
101 -- <<doc/generated/FontHersheyPlain.png FontHersheyPlain>>
102 --
103 -- <<doc/generated/FontHersheyPlain_slanted.png FontHersheyPlain>>
104 | FontHersheyDuplex
105 -- ^ Normal size sans-serif font (more complex than
106 -- 'FontHersheySimplex'). Does not have a 'Slanted' variant.
107 --
108 -- <<doc/generated/FontHersheyDuplex.png FontHersheyDuplex>>
109 | FontHersheyComplex
110 -- ^ Normal size serif font.
111 --
112 -- <<doc/generated/FontHersheyComplex.png FontHersheyComplex>>
113 --
114 -- <<doc/generated/FontHersheyComplex_slanted.png FontHersheyComplex>>
115 | FontHersheyTriplex
116 -- ^ Normal size serif font (more complex than 'FontHersheyComplex').
117 --
118 -- <<doc/generated/FontHersheyTriplex.png FontHersheyTriplex>>
119 --
120 -- <<doc/generated/FontHersheyTriplex_slanted.png FontHersheyTriplex>>
121 | FontHersheyComplexSmall
122 -- ^ Smaller version of 'FontHersheyComplex'.
123 --
124 -- <<doc/generated/FontHersheyComplexSmall.png FontHersheyComplexSmall>>
125 --
126 -- <<doc/generated/FontHersheyComplexSmall_slanted.png FontHersheyComplexSmall>>
127 | FontHersheyScriptSimplex
128 -- ^ Hand-writing style font. Does not have a 'Slanted' variant.
129 --
130 -- <<doc/generated/FontHersheyScriptSimplex.png FontHersheyScriptSimplex>>
131 | FontHersheyScriptComplex
132 -- ^ More complex variant of 'FontHersheyScriptSimplex'. Does not have a
133 -- 'Slanted' variant.
134 --
135 -- <<doc/generated/FontHersheyScriptComplex.png FontHersheyScriptComplex>>
136 deriving (Show, Enum, Bounded)
137
138 data FontSlant
139 = NotSlanted
140 | Slanted
141 deriving (Show)
142
143 marshalFont :: Font -> (Int32, C.CDouble)
144 marshalFont (Font face slant scale) =
145 ( marshalFontFace face + marshalFontSlant slant
146 , realToFrac scale
147 )
148
149 #num FONT_ITALIC
150
151 marshalFontSlant :: FontSlant -> Int32
152 marshalFontSlant = \case
153 NotSlanted -> 0
154 Slanted -> c'FONT_ITALIC
155
156 #num FONT_HERSHEY_SIMPLEX
157 #num FONT_HERSHEY_PLAIN
158 #num FONT_HERSHEY_DUPLEX
159 #num FONT_HERSHEY_COMPLEX
160 #num FONT_HERSHEY_TRIPLEX
161 #num FONT_HERSHEY_COMPLEX_SMALL
162 #num FONT_HERSHEY_SCRIPT_SIMPLEX
163 #num FONT_HERSHEY_SCRIPT_COMPLEX
164
165 marshalFontFace :: FontFace -> Int32
166 marshalFontFace = \case
167 FontHersheySimplex -> c'FONT_HERSHEY_SIMPLEX
168 FontHersheyPlain -> c'FONT_HERSHEY_PLAIN
169 FontHersheyDuplex -> c'FONT_HERSHEY_DUPLEX
170 FontHersheyComplex -> c'FONT_HERSHEY_COMPLEX
171 FontHersheyTriplex -> c'FONT_HERSHEY_TRIPLEX
172 FontHersheyComplexSmall -> c'FONT_HERSHEY_COMPLEX_SMALL
173 FontHersheyScriptSimplex -> c'FONT_HERSHEY_SCRIPT_SIMPLEX
174 FontHersheyScriptComplex -> c'FONT_HERSHEY_SCRIPT_COMPLEX
175
176
177 {- | Draws a arrow segment pointing from the first point to the second one
178
179 Example:
180
181 @
182 arrowedLineImg :: Mat (ShapeT [200, 300]) ('S 4) ('S Word8)
183 arrowedLineImg = exceptError $
184 withMatM
185 (Proxy :: Proxy [200, 300])
186 (Proxy :: Proxy 4)
187 (Proxy :: Proxy Word8)
188 transparent $ \\imgM -> do
189 arrowedLine imgM (V2 10 130 :: V2 Int32) (V2 190 40 :: V2 Int32) blue 5 LineType_AA 0 0.15
190 arrowedLine imgM (V2 210 50 :: V2 Int32) (V2 250 180 :: V2 Int32) red 8 LineType_AA 0 0.4
191 @
192
193 <<doc/generated/examples/arrowedLineImg.png arrowedLineImg>>
194
195 <http://docs.opencv.org/3.0.0/d6/d6e/group__imgproc__draw.html#ga0a165a3ca093fd488ac709fdf10c05b2 OpenCV Doxygen doc>
196 <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/drawing_functions.html#arrowedline OpenCV Sphinx doc>
197 -}
198 arrowedLine
199 :: ( IsPoint2 fromPoint2 Int32
200 , IsPoint2 toPoint2 Int32
201 , ToScalar color
202 , PrimMonad m
203 )
204 => Mut (Mat ('S [height, width]) channels depth) (PrimState m) -- ^ Image.
205 -> fromPoint2 Int32 -- ^ The point the arrow starts from.
206 -> toPoint2 Int32 -- ^ The point the arrow points to.
207 -> color -- ^ Line color.
208 -> Int32 -- ^ Line thickness.
209 -> LineType
210 -> Int32 -- ^ Number of fractional bits in the point coordinates.
211 -> Double -- ^ The length of the arrow tip in relation to the arrow length.
212 -> m ()
213 arrowedLine img pt1 pt2 color thickness lineType shift tipLength =
214 unsafePrimToPrim $
215 withPtr img $ \matPtr ->
216 withPtr (toPoint pt1) $ \pt1Ptr ->
217 withPtr (toPoint pt2) $ \pt2Ptr ->
218 withPtr (toScalar color) $ \colorPtr ->
219 [C.exp|void {
220 cv::arrowedLine( *$(Mat * matPtr)
221 , *$(Point2i * pt1Ptr)
222 , *$(Point2i * pt2Ptr)
223 , *$(Scalar * colorPtr)
224 , $(int32_t thickness)
225 , $(int32_t c'lineType)
226 , $(int32_t shift)
227 , $(double c'tipLength)
228 )
229 }|]
230 where
231 c'lineType = marshalLineType lineType
232 c'tipLength = realToFrac tipLength
233
234 {- | Draws a circle.
235
236 Example:
237
238 @
239 circleImg :: Mat (ShapeT [200, 400]) ('S 4) ('S Word8)
240 circleImg = exceptError $
241 withMatM
242 (Proxy :: Proxy [200, 400])
243 (Proxy :: Proxy 4)
244 (Proxy :: Proxy Word8)
245 transparent $ \\imgM -> do
246 lift $ circle imgM (V2 100 100 :: V2 Int32) 90 blue 5 LineType_AA 0
247 lift $ circle imgM (V2 300 100 :: V2 Int32) 45 red (-1) LineType_AA 0
248 @
249
250 <<doc/generated/examples/circleImg.png circleImg>>
251
252 <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/drawing_functions.html#circle OpenCV Sphinx doc>
253 -}
254 circle
255 :: ( PrimMonad m
256 , IsPoint2 point2 Int32
257 , ToScalar color
258 )
259 => Mut (Mat ('S [height, width]) channels depth) (PrimState m) -- ^ Image where the circle is drawn.
260 -> point2 Int32 -- ^ Center of the circle.
261 -> Int32 -- ^ Radius of the circle.
262 -> color -- ^ Circle color.
263 -> Int32 -- ^ Thickness of the circle outline, if positive. Negative thickness means that a filled circle is to be drawn.
264 -> LineType -- ^ Type of the circle boundary.
265 -> Int32 -- ^ Number of fractional bits in the coordinates of the center and in the radius value.
266 -> m ()
267 circle img center radius color thickness lineType shift =
268 unsafePrimToPrim $
269 withPtr img $ \matPtr ->
270 withPtr (toPoint center) $ \centerPtr ->
271 withPtr (toScalar color) $ \colorPtr ->
272 [C.exp|void {
273 cv::circle( *$(Mat * matPtr)
274 , *$(Point2i * centerPtr)
275 , $(int32_t radius)
276 , *$(Scalar * colorPtr)
277 , $(int32_t thickness)
278 , $(int32_t c'lineType)
279 , $(int32_t shift)
280 )
281 }|]
282 where
283 c'lineType = marshalLineType lineType
284
285 {- | Draws a simple or thick elliptic arc or fills an ellipse sector
286
287 Example:
288
289 @
290 ellipseImg :: Mat (ShapeT [200, 400]) ('S 4) ('S Word8)
291 ellipseImg = exceptError $
292 withMatM
293 (Proxy :: Proxy [200, 400])
294 (Proxy :: Proxy 4)
295 (Proxy :: Proxy Word8)
296 transparent $ \\imgM -> do
297 lift $ ellipse imgM (V2 100 100 :: V2 Int32) (V2 90 60 :: V2 Int32) 30 0 360 blue 5 LineType_AA 0
298 lift $ ellipse imgM (V2 300 100 :: V2 Int32) (V2 80 40 :: V2 Int32) 160 40 290 red (-1) LineType_AA 0
299 @
300
301 <<doc/generated/examples/ellipseImg.png ellipseImg>>
302
303 <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/drawing_functions.html#ellipse OpenCV Sphinx doc>
304 -}
305 ellipse
306 :: ( PrimMonad m
307 , IsPoint2 point2 Int32
308 , IsSize size Int32
309 , ToScalar color
310 )
311 => Mut (Mat ('S [height, width]) channels depth) (PrimState m) -- ^ Image.
312 -> point2 Int32 -- ^ Center of the ellipse.
313 -> size Int32 -- ^ Half of the size of the ellipse main axes.
314 -> Double -- ^ Ellipse rotation angle in degrees.
315 -> Double -- ^ Starting angle of the elliptic arc in degrees.
316 -> Double -- ^ Ending angle of the elliptic arc in degrees.
317 -> color -- ^ Ellipse color.
318 -> Int32
319 -- ^ Thickness of the ellipse arc outline, if
320 -- positive. Otherwise, this indicates that a filled ellipse
321 -- sector is to be drawn.
322 -> LineType -- ^ Type of the ellipse boundary.
323 -> Int32 -- ^ Number of fractional bits in the coordinates of the center and values of axes.
324 -> m ()
325 ellipse img center axes angle startAngle endAngle color thickness lineType shift =
326 unsafePrimToPrim $
327 withPtr img $ \matPtr ->
328 withPtr (toPoint center) $ \centerPtr ->
329 withPtr (toSize axes ) $ \axesPtr ->
330 withPtr (toScalar color ) $ \colorPtr ->
331 [C.exp|void {
332 cv::ellipse( *$(Mat * matPtr)
333 , *$(Point2i * centerPtr)
334 , *$(Size2i * axesPtr)
335 , $(double c'angle)
336 , $(double c'startAngle)
337 , $(double c'endAngle)
338 , *$(Scalar * colorPtr)
339 , $(int32_t thickness)
340 , $(int32_t c'lineType)
341 , $(int32_t shift)
342 )
343 }|]
344 where
345 c'angle = realToFrac angle
346 c'startAngle = realToFrac startAngle
347 c'endAngle = realToFrac endAngle
348 c'lineType = marshalLineType lineType
349
350 {- | Fills a convex polygon.
351
352 The function 'fillConvexPoly' draws a filled convex polygon. This
353 function is much faster than the function 'fillPoly' . It can fill
354 not only convex polygons but any monotonic polygon without
355 self-intersections, that is, a polygon whose contour intersects
356 every horizontal line (scan line) twice at the most (though, its
357 top-most and/or the bottom edge could be horizontal).
358
359 Example:
360
361 @
362 fillConvexPolyImg
363 :: forall (h :: Nat) (w :: Nat)
364 . (h ~ 300, w ~ 300)
365 => Mat (ShapeT [h, w]) ('S 4) ('S Word8)
366 fillConvexPolyImg = exceptError $
367 withMatM (Proxy :: Proxy [h, w])
368 (Proxy :: Proxy 4)
369 (Proxy :: Proxy Word8)
370 transparent $ \\imgM -> do
371 lift $ fillConvexPoly imgM pentagon blue LineType_AA 0
372 where
373 pentagon :: V.Vector (V2 Int32)
374 pentagon = V.fromList
375 [ V2 150 0
376 , V2 7 104
377 , V2 62 271
378 , V2 238 271
379 , V2 293 104
380 ]
381 @
382
383 <<doc/generated/examples/fillConvexPolyImg.png fillConvexPolyImg>>
384
385 <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/drawing_functions.html#fillconvexpoly OpenCV Sphinx doc>
386 -}
387 fillConvexPoly
388 :: ( PrimMonad m
389 , IsPoint2 point2 Int32
390 , ToScalar color
391 )
392 => Mut (Mat ('S [height, width]) channels depth) (PrimState m) -- ^ Image.
393 -> V.Vector (point2 Int32) -- ^ Polygon vertices.
394 -> color -- ^ Polygon color.
395 -> LineType
396 -> Int32 -- ^ Number of fractional bits in the vertex coordinates.
397 -> m ()
398 fillConvexPoly img points color lineType shift =
399 unsafePrimToPrim $
400 withPtr img $ \matPtr ->
401 withArrayPtr (V.map toPoint points) $ \pointsPtr ->
402 withPtr (toScalar color) $ \colorPtr ->
403 [C.exp|void {
404 cv::fillConvexPoly( *$(Mat * matPtr)
405 , $(Point2i * pointsPtr)
406 , $(int32_t c'numPoints)
407 , *$(Scalar * colorPtr)
408 , $(int32_t c'lineType)
409 , $(int32_t shift)
410 )
411 }|]
412 where
413 c'numPoints = fromIntegral $ V.length points
414 c'lineType = marshalLineType lineType
415
416 {- | Fills the area bounded by one or more polygons.
417
418 Example:
419
420 @
421 rookPts :: Int32 -> Int32 -> V.Vector (V.Vector (V2 Int32))
422 rookPts w h = V.singleton $ V.fromList
423 [ V2 ( w \`div` 4) ( 7*h \`div` 8)
424 , V2 ( 3*w \`div` 4) ( 7*h \`div` 8)
425 , V2 ( 3*w \`div` 4) (13*h \`div` 16)
426 , V2 ( 11*w \`div` 16) (13*h \`div` 16)
427 , V2 ( 19*w \`div` 32) ( 3*h \`div` 8)
428 , V2 ( 3*w \`div` 4) ( 3*h \`div` 8)
429 , V2 ( 3*w \`div` 4) ( h \`div` 8)
430 , V2 ( 26*w \`div` 40) ( h \`div` 8)
431 , V2 ( 26*w \`div` 40) ( h \`div` 4)
432 , V2 ( 22*w \`div` 40) ( h \`div` 4)
433 , V2 ( 22*w \`div` 40) ( h \`div` 8)
434 , V2 ( 18*w \`div` 40) ( h \`div` 8)
435 , V2 ( 18*w \`div` 40) ( h \`div` 4)
436 , V2 ( 14*w \`div` 40) ( h \`div` 4)
437 , V2 ( 14*w \`div` 40) ( h \`div` 8)
438 , V2 ( w \`div` 4) ( h \`div` 8)
439 , V2 ( w \`div` 4) ( 3*h \`div` 8)
440 , V2 ( 13*w \`div` 32) ( 3*h \`div` 8)
441 , V2 ( 5*w \`div` 16) (13*h \`div` 16)
442 , V2 ( w \`div` 4) (13*h \`div` 16)
443 ]
444
445 fillPolyImg
446 :: forall (h :: Nat) (w :: Nat)
447 . (h ~ 300, w ~ 300)
448 => Mat (ShapeT [h, w]) ('S 4) ('S Word8)
449 fillPolyImg = exceptError $
450 withMatM (Proxy :: Proxy [h, w])
451 (Proxy :: Proxy 4)
452 (Proxy :: Proxy Word8)
453 transparent $ \\imgM -> do
454 lift $ fillPoly imgM (rookPts w h) blue LineType_AA 0
455 where
456 h = fromInteger $ natVal (Proxy :: Proxy h)
457 w = fromInteger $ natVal (Proxy :: Proxy w)
458 @
459
460 <<doc/generated/examples/fillPolyImg.png fillPolyImg>>
461
462 <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/drawing_functions.html#fillpoly OpenCV Sphinx doc>
463 -}
464 fillPoly
465 :: ( PrimMonad m
466 , IsPoint2 point2 Int32
467 , ToScalar color
468 )
469 => Mut (Mat ('S [height, width]) channels depth) (PrimState m) -- ^ Image.
470 -> V.Vector (V.Vector (point2 Int32)) -- ^ Polygons.
471 -> color -- ^ Polygon color.
472 -> LineType
473 -> Int32 -- ^ Number of fractional bits in the vertex coordinates.
474 -> m ()
475 fillPoly img polygons color lineType shift =
476 unsafePrimToPrim $
477 withPtr img $ \matPtr ->
478 withPolygons polygons $ \polygonsPtr ->
479 VS.unsafeWith npts $ \nptsPtr ->
480 withPtr (toScalar color) $ \colorPtr ->
481 [C.exp|void {
482 cv::fillPoly( *$(Mat * matPtr)
483 , $(const Point2i * * polygonsPtr)
484 , $(int32_t * nptsPtr)
485 , $(int32_t c'numPolygons)
486 , *$(Scalar * colorPtr)
487 , $(int32_t c'lineType)
488 , $(int32_t shift)
489 )
490 }|]
491 where
492 c'numPolygons = fromIntegral $ V.length polygons
493 c'lineType = marshalLineType lineType
494
495 npts :: VS.Vector Int32
496 npts = VS.convert $ V.map (fromIntegral . V.length) polygons
497
498 {- | Draws several polygonal curves
499
500 Example:
501
502 @
503 polylinesImg
504 :: forall (h :: Nat) (w :: Nat)
505 . (h ~ 300, w ~ 300)
506 => Mat (ShapeT [h, w]) ('S 4) ('S Word8)
507 polylinesImg = exceptError $
508 withMatM (Proxy :: Proxy [h, w])
509 (Proxy :: Proxy 4)
510 (Proxy :: Proxy Word8)
511 transparent $ \\imgM -> do
512 lift $ polylines imgM (rookPts w h) True blue 2 LineType_AA 0
513 where
514 h = fromInteger $ natVal (Proxy :: Proxy h)
515 w = fromInteger $ natVal (Proxy :: Proxy w)
516 @
517
518 <<doc/generated/examples/polylinesImg.png polylinesImg>>
519
520 <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/drawing_functions.html#polylines OpenCV Sphinx doc>
521 -}
522 polylines
523 :: ( PrimMonad m
524 , IsPoint2 point2 Int32
525 , ToScalar color
526 )
527 => Mut (Mat ('S [height, width]) channels depth) (PrimState m) -- ^ Image.
528 -> V.Vector (V.Vector (point2 Int32)) -- ^ Vertices.
529 -> Bool
530 -- ^ Flag indicating whether the drawn polylines are closed or not. If
531 -- they are closed, the function draws a line from the last vertex of
532 -- each curve to its first vertex.
533 -> color
534 -> Int32 -- ^ Thickness of the polyline edges.
535 -> LineType
536 -> Int32 -- ^ Number of fractional bits in the vertex coordinates.
537 -> m ()
538 polylines img curves isClosed color thickness lineType shift =
539 unsafePrimToPrim $
540 withPtr img $ \matPtr ->
541 withPolygons curves $ \curvesPtr ->
542 VS.unsafeWith npts $ \nptsPtr ->
543 withPtr (toScalar color) $ \colorPtr ->
544 [C.exp|void {
545 cv::polylines
546 ( *$(Mat * matPtr)
547 , $(const Point2i * * curvesPtr)
548 , $(int32_t * nptsPtr)
549 , $(int32_t c'numCurves)
550 , $(bool c'isClosed)
551 , *$(Scalar * colorPtr)
552 , $(int32_t thickness)
553 , $(int32_t c'lineType)
554 , $(int32_t shift)
555 );
556 }|]
557 where
558 c'numCurves = fromIntegral $ V.length curves
559 c'isClosed = fromBool isClosed
560 c'lineType = marshalLineType lineType
561
562 npts :: VS.Vector Int32
563 npts = VS.convert $ V.map (fromIntegral . V.length) curves
564
565 {- | Draws a line segment connecting two points.
566
567 Example:
568
569 @
570 lineImg :: Mat (ShapeT [200, 300]) ('S 4) ('S Word8)
571 lineImg = exceptError $
572 withMatM (Proxy :: Proxy [200, 300])
573 (Proxy :: Proxy 4)
574 (Proxy :: Proxy Word8)
575 transparent $ \\imgM -> do
576 lift $ line imgM (V2 10 130 :: V2 Int32) (V2 190 40 :: V2 Int32) blue 5 LineType_AA 0
577 lift $ line imgM (V2 210 50 :: V2 Int32) (V2 250 180 :: V2 Int32) red 8 LineType_AA 0
578 @
579
580 <<doc/generated/examples/lineImg.png lineImg>>
581
582 <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/drawing_functions.html#line OpenCV Sphinx doc>
583 -}
584 line
585 :: ( PrimMonad m
586 , IsPoint2 fromPoint2 Int32
587 , IsPoint2 toPoint2 Int32
588 , ToScalar color
589 )
590 => Mut (Mat ('S [height, width]) channels depth) (PrimState m) -- ^ Image.
591 -> fromPoint2 Int32 -- ^ First point of the line segment.
592 -> toPoint2 Int32 -- ^ Scond point of the line segment.
593 -> color -- ^ Line color.
594 -> Int32 -- ^ Line thickness.
595 -> LineType
596 -> Int32 -- ^ Number of fractional bits in the point coordinates.
597 -> m ()
598 line img pt1 pt2 color thickness lineType shift =
599 unsafePrimToPrim $
600 withPtr img $ \matPtr ->
601 withPtr (toPoint pt1) $ \pt1Ptr ->
602 withPtr (toPoint pt2) $ \pt2Ptr ->
603 withPtr (toScalar color) $ \colorPtr ->
604 [C.exp|void {
605 cv::line( *$(Mat * matPtr)
606 , *$(Point2i * pt1Ptr)
607 , *$(Point2i * pt2Ptr)
608 , *$(Scalar * colorPtr)
609 , $(int32_t thickness)
610 , $(int32_t c'lineType)
611 , $(int32_t shift)
612 )
613 }|]
614 where
615 c'lineType = marshalLineType lineType
616
617 {- | Calculates the size of a box that contains the specified text
618
619 <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/drawing_functions.html#gettextsize OpenCV Sphinx doc>
620 -}
621 getTextSize
622 :: Text
623 -> Font
624 -> Int32 -- ^ Thickness of lines used to render the text.
625 -> (Size2i, Int32)
626 -- ^ (size, baseLine) =
627 -- (The size of a box that contains the specified text.
628 -- , y-coordinate of the baseline relative to the bottom-most text point)
629 getTextSize text font thickness = unsafePerformIO $
630 T.withCStringLen (T.append text "\0") $ \(c'text, _textLength) ->
631 alloca $ \(c'baseLinePtr :: Ptr Int32) -> do
632 size <- fromPtr $
633 [C.block|Size2i * {
634 Size size = cv::getTextSize( $(char * c'text)
635 , $(int32_t c'fontFace)
636 , $(double c'fontScale)
637 , $(int32_t thickness)
638 , $(int32_t * c'baseLinePtr)
639 );
640 return new Size(size);
641 }|]
642 baseLine <- peek c'baseLinePtr
643 pure (size, baseLine)
644 where
645 (c'fontFace, c'fontScale) = marshalFont font
646
647 {- | Draws a text string.
648
649 The function putText renders the specified text string in the
650 image. Symbols that cannot be rendered using the specified font are
651 replaced by question marks.
652
653 Example:
654
655 @
656 putTextImg :: Mat ('S ['D, 'S 400]) ('S 4) ('S Word8)
657 putTextImg = exceptError $
658 withMatM (height ::: (Proxy :: Proxy 400) ::: Z)
659 (Proxy :: Proxy 4)
660 (Proxy :: Proxy Word8)
661 transparent $ \\imgM -> do
662 forM_ (zip [0..] [minBound .. maxBound]) $ \\(n, fontFace) ->
663 lift $ putText imgM
664 (T.pack $ show fontFace)
665 (V2 10 (35 + n * 30) :: V2 Int32)
666 (Font fontFace NotSlanted 1.0)
667 black
668 1
669 LineType_AA
670 False
671 where
672 height :: Int32
673 height = 50 + fromIntegral (30 * fromEnum (maxBound :: FontFace))
674 @
675
676 <<doc/generated/examples/putTextImg.png putTextImg>>
677
678 <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/drawing_functions.html#puttext OpenCV Sphinx doc>
679 -}
680 putText
681 :: ( PrimMonad m
682 , IsPoint2 point2 Int32
683 , ToScalar color
684 )
685 => Mut (Mat ('S [height, width]) channels depth) (PrimState m) -- ^ Image.
686 -> Text -- ^ Text string to be drawn.
687 -> point2 Int32 -- ^ Bottom-left corner of the text string in the image.
688 -> Font
689 -> color -- ^ Text color.
690 -> Int32 -- ^ Thickness of the lines used to draw a text.
691 -> LineType
692 -> Bool -- ^ When 'True', the image data origin is at the bottom-left corner. Otherwise, it is at the top-left corner.
693 -> m ()
694 putText img text org font color thickness lineType bottomLeftOrigin =
695 unsafePrimToPrim $
696 withPtr img $ \matPtr ->
697 T.withCStringLen (T.append text "\0") $ \(c'text, _textLength) ->
698 withPtr (toPoint org) $ \orgPtr ->
699 withPtr (toScalar color) $ \colorPtr ->
700 [C.exp|void {
701 cv::putText( *$(Mat * matPtr)
702 , $(char * c'text)
703 , *$(Point2i * orgPtr)
704 , $(int32_t c'fontFace)
705 , $(double c'fontScale)
706 , *$(Scalar * colorPtr)
707 , $(int32_t thickness)
708 , $(int32_t c'lineType)
709 , $(bool c'bottomLeftOrigin)
710 )
711 }|]
712 where
713 (c'fontFace, c'fontScale) = marshalFont font
714 c'lineType = marshalLineType lineType
715 c'bottomLeftOrigin = fromBool bottomLeftOrigin
716
717 {- | Draws a simple, thick, or filled up-right rectangle
718
719 Example:
720
721 @
722 rectangleImg :: Mat (ShapeT [200, 400]) ('S 4) ('S Word8)
723 rectangleImg = exceptError $
724 withMatM (Proxy :: Proxy [200, 400])
725 (Proxy :: Proxy 4)
726 (Proxy :: Proxy Word8)
727 transparent $ \\imgM -> do
728 lift $ rectangle imgM (toRect $ HRect (V2 10 10) (V2 180 180)) blue 5 LineType_8 0
729 lift $ rectangle imgM (toRect $ HRect (V2 260 30) (V2 80 140)) red (-1) LineType_8 0
730 @
731
732 <<doc/generated/examples/rectangleImg.png rectangleImg>>
733
734 <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/drawing_functions.html#rectangle OpenCV Sphinx doc>
735 -}
736 rectangle
737 :: (PrimMonad m, ToScalar color, IsRect rect Int32)
738 => Mut (Mat ('S [height, width]) channels depth) (PrimState m) -- ^ Image.
739 -> rect Int32
740 -> color -- ^ Rectangle color or brightness (grayscale image).
741 -> Int32 -- ^ Line thickness.
742 -> LineType
743 -> Int32 -- ^ Number of fractional bits in the point coordinates.
744 -> m ()
745 rectangle img rect color thickness lineType shift =
746 unsafePrimToPrim $
747 withPtr img $ \matPtr ->
748 withPtr (toRect rect) $ \rectPtr ->
749 withPtr (toScalar color) $ \colorPtr ->
750 [C.exp|void {
751 cv::rectangle( *$(Mat * matPtr)
752 , *$(Rect2i * rectPtr)
753 , *$(Scalar * colorPtr)
754 , $(int32_t thickness)
755 , $(int32_t c'lineType)
756 , $(int32_t shift)
757 )
758 }|]
759 where
760 c'lineType = marshalLineType lineType
761
762
763 data ContourDrawMode
764 = OutlineContour LineType
765 Int32 -- ^ Thickness of lines the contours are drawn with.
766 | FillContours -- ^ Draw the contour, filling in the area.
767
768 marshalContourDrawMode
769 :: ContourDrawMode -> (Int32, Int32)
770 marshalContourDrawMode = \case
771 OutlineContour lineType thickness -> (marshalLineType lineType, thickness)
772 FillContours -> (marshalLineType LineType_4, -1)
773
774 {-|
775
776 Draw contours onto a black image.
777
778 Example:
779
780 @
781 flowerContours :: Mat ('S ['S 512, 'S 768]) ('S 3) ('S Word8)
782 flowerContours = exceptError $
783 withMatM (Proxy :: Proxy [512,768])
784 (Proxy :: Proxy 3)
785 (Proxy :: Proxy Word8)
786 black $ \\imgM -> do
787 edges <- thaw $ exceptError $
788 cvtColor bgr gray flower_768x512 >>=
789 canny 30 20 Nothing CannyNormL1
790 contours <- findContours ContourRetrievalList
791 ContourApproximationSimple edges
792 lift $ drawContours (V.map contourPoints contours)
793 red
794 (OutlineContour LineType_AA 1)
795 imgM
796 @
797
798 <<doc/generated/examples/flowerContours.png flowerContours>>
799
800 -}
801 drawContours :: (ToScalar color, PrimMonad m)
802 => V.Vector (V.Vector Point2i)
803 -> color -- ^ Color of the contours.
804 -> ContourDrawMode
805 -> Mut (Mat ('S [h, w]) channels depth) (PrimState m) -- ^ Image.
806 -> m ()
807 drawContours contours color drawMode img = unsafePrimToPrim $
808 withArrayPtr (V.concat (V.toList contours)) $ \contoursPtrPtr ->
809 withArray (V.toList (V.map (fromIntegral . V.length) contours)) $ \(contourLengthsPtr :: Ptr Int32) ->
810 withPtr (toScalar color) $ \colorPtr ->
811 withPtr img $ \dstPtr ->
812 [C.exp|void {
813 int32_t *contourLengths = $(int32_t * contourLengthsPtr);
814 Point2i * contoursPtr = $(Point2i * contoursPtrPtr);
815 std::vector< std::vector<cv::Point> > contours;
816 int32_t numContours = $(int32_t numContours);
817
818 int k = 0;
819 for(int i = 0; i < numContours; i++) {
820 std::vector<cv::Point> contour;
821 for(int j = 0; j < contourLengths[i]; j++) {
822 contour.push_back( contoursPtr[k] );
823 k++;
824 }
825 contours.push_back(contour);
826 }
827
828 cv::drawContours(
829 *$(Mat * dstPtr),
830 contours,
831 -1,
832 *$(Scalar * colorPtr),
833 $(int32_t c'thickness),
834 $(int32_t c'lineType)
835 );
836 }|]
837 where
838 numContours = fromIntegral (V.length contours)
839 (c'lineType, c'thickness) = marshalContourDrawMode drawMode
840
841 {-| Draws a marker on a predefined position in an image.
842
843 The marker will be drawn as as a 20-pixel cross.
844
845 Example:
846
847 @
848 markerImg :: Mat (ShapeT [100, 100]) ('S 4) ('S Word8)
849 markerImg = exceptError $
850 withMatM (Proxy :: Proxy [100, 100])
851 (Proxy :: Proxy 4)
852 (Proxy :: Proxy Word8)
853 transparent $ \\imgM -> do
854 lift $ marker imgM (50 :: V2 Int32) blue
855 @
856
857 <<doc/generated/examples/markerImg.png markerImg>>
858 -}
859 marker
860 :: (PrimMonad m, IsPoint2 point2 Int32, ToScalar color)
861 => Mut (Mat ('S '[ height, width]) channels depth) (PrimState m)
862 -- ^ The image to draw the marker on.
863 -> point2 Int32
864 -- ^ The point where the crosshair is positioned.
865 -> color
866 -- ^ Line color.
867 -> m ()
868 marker img center color =
869 unsafePrimToPrim $
870 withPtr img $ \matPtr ->
871 withPtr (toPoint center) $ \centerPtr ->
872 withPtr (toScalar color) $ \colorPtr ->
873 [C.exp|void {
874 cv::drawMarker( *$(Mat * matPtr)
875 , *$(Point2i * centerPtr)
876 , *$(Scalar * colorPtr))
877 }|]