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       }|]