never executed always true always false
    1 {-# LANGUAGE QuasiQuotes #-}
    2 {-# LANGUAGE TemplateHaskell #-}
    3 {-# LANGUAGE RecordWildCards #-}
    4 
    5 {-# OPTIONS_GHC -fno-warn-orphans #-} -- For Show instances
    6 
    7 module OpenCV.Core.Types
    8     ( -- * Mutable values
    9       Mut
   10     , Mutable
   11     , FreezeThaw(..)
   12       -- * Point
   13     , module OpenCV.Core.Types.Point
   14       -- * Size
   15     , module OpenCV.Core.Types.Size
   16       -- * Scalar
   17     , Scalar
   18     , ToScalar(..), FromScalar(..)
   19       -- * Rect
   20     , module OpenCV.Core.Types.Rect
   21       -- * RotatedRect
   22     , RotatedRect
   23     , mkRotatedRect
   24     , rotatedRectCenter
   25     , rotatedRectSize
   26     , rotatedRectAngle
   27     , rotatedRectBoundingRect
   28     , rotatedRectPoints
   29       -- * TermCriteria
   30     , TermCriteria
   31     , mkTermCriteria
   32       -- * Range
   33     , Range
   34     , mkRange
   35     , wholeRange
   36       -- * KeyPoint
   37     , KeyPoint
   38     , KeyPointRec(..)
   39     , mkKeyPoint
   40     , keyPointAsRec
   41       -- * DMatch
   42     , DMatch
   43     , DMatchRec(..)
   44     , mkDMatch
   45     , dmatchAsRec
   46       -- * Matrix
   47     , module OpenCV.Core.Types.Mat
   48     , module OpenCV.Core.Types.Matx
   49       -- * Vec
   50     , module OpenCV.Core.Types.Vec
   51       -- * Exception
   52     , module OpenCV.Exception
   53      -- * Algorithm
   54     , Algorithm(..)
   55       -- * Polymorphic stuff
   56     , WithPtr
   57     , FromPtr
   58     , CSizeOf
   59     , PlacementNew
   60     ) where
   61 
   62 import "base" Data.Int ( Int32 )
   63 import "base" Foreign.C.Types
   64 import "base" Foreign.ForeignPtr ( ForeignPtr, withForeignPtr )
   65 import "base" Foreign.Marshal.Alloc ( alloca )
   66 import "base" Foreign.Storable ( peek )
   67 import "base" System.IO.Unsafe ( unsafePerformIO )
   68 import qualified "inline-c" Language.C.Inline as C
   69 import qualified "inline-c" Language.C.Inline.Unsafe as CU
   70 import qualified "inline-c-cpp" Language.C.Inline.Cpp as C
   71 import "linear" Linear.V2 ( V2(..) )
   72 import "linear" Linear.Vector ( zero )
   73 import "primitive" Control.Monad.Primitive ( PrimMonad, PrimState )
   74 import "this" OpenCV.Core.Types.Mat
   75 import "this" OpenCV.Core.Types.Matx
   76 import "this" OpenCV.Core.Types.Point
   77 import "this" OpenCV.Core.Types.Rect
   78 import "this" OpenCV.Core.Types.Size
   79 import "this" OpenCV.Core.Types.Vec
   80 import "this" OpenCV.Exception
   81 import "this" OpenCV.Internal
   82 import "this" OpenCV.Internal.C.Inline ( openCvCtx )
   83 import "this" OpenCV.Internal.C.PlacementNew
   84 import "this" OpenCV.Internal.C.PlacementNew.TH ( mkPlacementNewInstance )
   85 import "this" OpenCV.Internal.C.Types
   86 import "this" OpenCV.Internal.Core.Types.Constants
   87 import "this" OpenCV.Internal.Core.Types
   88 import "this" OpenCV.Internal.Mutable
   89 
   90 --------------------------------------------------------------------------------
   91 
   92 C.context openCvCtx
   93 
   94 C.include "opencv2/core.hpp"
   95 C.using "namespace cv"
   96 
   97 #include <bindings.dsl.h>
   98 #include "opencv2/core.hpp"
   99 
  100 #include "namespace.hpp"
  101 
  102 --------------------------------------------------------------------------------
  103 --  RotatedRect
  104 --------------------------------------------------------------------------------
  105 
  106 mkRotatedRect
  107     :: ( IsPoint2 point2 CFloat
  108        , IsSize   size   CFloat
  109        )
  110     => point2 CFloat -- ^ Rectangle mass center
  111     -> size   CFloat -- ^ Width and height of the rectangle
  112     -> Float
  113        -- ^ The rotation angle (in degrees). When the angle is 0, 90,
  114        -- 180, 270 etc., the rectangle becomes an up-right rectangle.
  115     -> RotatedRect
  116 mkRotatedRect center size angle =
  117     unsafePerformIO $ newRotatedRect center size (realToFrac angle)
  118 
  119 -- | Rectangle mass center
  120 rotatedRectCenter :: RotatedRect -> Point2f
  121 rotatedRectCenter rotRect = unsafePerformIO $ fromPtr $
  122       withPtr rotRect $ \rotRectPtr ->
  123         [CU.exp| Point2f * { new Point2f($(RotatedRect * rotRectPtr)->center) }|]
  124 
  125 -- | Width and height of the rectangle
  126 rotatedRectSize :: RotatedRect -> Size2f
  127 rotatedRectSize rotRect = unsafePerformIO $ fromPtr $
  128       withPtr rotRect $ \rotRectPtr ->
  129         [CU.exp| Size2f * { new Size2f($(RotatedRect * rotRectPtr)->size) }|]
  130 
  131 -- | The rotation angle (in degrees)
  132 --
  133 -- When the angle is 0, 90, 180, 270 etc., the rectangle becomes an
  134 -- up-right rectangle.
  135 rotatedRectAngle :: RotatedRect -> Float
  136 rotatedRectAngle rotRect = realToFrac $ unsafePerformIO $
  137     withPtr rotRect $ \rotRectPtr ->
  138       [CU.exp| float { $(RotatedRect * rotRectPtr)->angle }|]
  139 
  140 -- | The minimal up-right rectangle containing the rotated rectangle
  141 rotatedRectBoundingRect :: RotatedRect -> Rect2i
  142 rotatedRectBoundingRect rotRect =
  143     unsafePerformIO $ fromPtr $ withPtr rotRect $ \rotRectPtr ->
  144       [CU.exp| Rect2i * { new Rect2i($(RotatedRect * rotRectPtr)->boundingRect()) }|]
  145 
  146 rotatedRectPoints :: RotatedRect -> (Point2f, Point2f, Point2f, Point2f)
  147 rotatedRectPoints rotRect = unsafePerformIO $ do
  148     p1 <- toPointIO (zero :: V2 CFloat)
  149     p2 <- toPointIO (zero :: V2 CFloat)
  150     p3 <- toPointIO (zero :: V2 CFloat)
  151     p4 <- toPointIO (zero :: V2 CFloat)
  152     withPtr rotRect $ \rotRectPtr ->
  153       withPtr p1 $ \p1Ptr ->
  154       withPtr p2 $ \p2Ptr ->
  155       withPtr p3 $ \p3Ptr ->
  156       withPtr p4 $ \p4Ptr ->
  157         [C.block| void {
  158           Point2f vertices[4];
  159           $(RotatedRect * rotRectPtr)->points(vertices);
  160           *$(Point2f * p1Ptr) = vertices[0];
  161           *$(Point2f * p2Ptr) = vertices[1];
  162           *$(Point2f * p3Ptr) = vertices[2];
  163           *$(Point2f * p4Ptr) = vertices[3];
  164         }|]
  165     pure (p1, p2, p3, p4)
  166 
  167 
  168 --------------------------------------------------------------------------------
  169 --  TermCriteria
  170 --------------------------------------------------------------------------------
  171 
  172 mkTermCriteria
  173     :: Maybe Int    -- ^ Optionally the maximum number of iterations/elements.
  174     -> Maybe Double -- ^ Optionally the desired accuracy.
  175     -> TermCriteria
  176 mkTermCriteria mbMaxCount mbEpsilon =
  177     unsafePerformIO $ newTermCriteria mbMaxCount mbEpsilon
  178 
  179 
  180 --------------------------------------------------------------------------------
  181 -- Range
  182 --------------------------------------------------------------------------------
  183 
  184 mkRange :: Int32 -> Int32 -> Range
  185 mkRange start end = unsafePerformIO $ newRange start end
  186 
  187 wholeRange :: Range
  188 wholeRange = unsafePerformIO newWholeRange
  189 
  190 
  191 --------------------------------------------------------------------------------
  192 -- KeyPoint
  193 --------------------------------------------------------------------------------
  194 
  195 {- | Data structure for salient point detectors
  196 
  197 <http://docs.opencv.org/3.0-last-rst/modules/core/doc/basic_structures.html#keypoint OpenCV Sphinx doc>
  198 -}
  199 newtype KeyPoint = KeyPoint {unKeyPoint :: ForeignPtr C'KeyPoint}
  200 
  201 type instance C KeyPoint = C'KeyPoint
  202 
  203 mkPlacementNewInstance ''KeyPoint
  204 
  205 instance WithPtr KeyPoint where
  206     withPtr = withForeignPtr . unKeyPoint
  207 
  208 instance FromPtr KeyPoint where
  209     fromPtr = objFromPtr KeyPoint $ \ptr ->
  210                 [CU.exp| void { delete $(KeyPoint * ptr) }|]
  211 
  212 instance CSizeOf C'KeyPoint where
  213     cSizeOf _proxy = c'sizeof_KeyPoint
  214 
  215 data KeyPointRec
  216    = KeyPointRec
  217      { kptPoint :: !(V2 Float)
  218        -- ^ Coordinates of the keypoints.
  219      , kptSize :: !Float
  220        -- ^ Diameter of the meaningful keypoint neighborhood.
  221      , kptAngle :: !Float
  222        -- ^ Computed orientation of the keypoint (-1 if not applicable); it's in
  223        -- [0,360) degrees and measured relative to image coordinate system, ie
  224        -- in clockwise.
  225      , kptResponse :: !Float
  226        -- ^ The response by which the most strong keypoints have been
  227        -- selected. Can be used for the further sorting or subsampling.
  228      , kptOctave :: !Int32
  229        -- ^ Octave (pyramid layer) from which the keypoint has been extracted.
  230      , kptClassId :: !Int32
  231        -- ^ Object class (if the keypoints need to be clustered by an object
  232        -- they belong to).
  233      } deriving (Eq, Show)
  234 
  235 newKeyPoint :: KeyPointRec -> IO KeyPoint
  236 newKeyPoint KeyPointRec{..} = fromPtr $
  237     [CU.exp|KeyPoint * {
  238       new cv::KeyPoint
  239           ( cv::Point2f($(float c'x), $(float c'y))
  240           , $(float c'kptSize)
  241           , $(float c'kptAngle)
  242           , $(float c'kptResponse)
  243           , $(int32_t kptOctave)
  244           , $(int32_t kptClassId)
  245           )
  246     }|]
  247   where
  248     V2 c'x c'y = realToFrac <$> kptPoint
  249     c'kptSize     = realToFrac kptSize
  250     c'kptAngle    = realToFrac kptAngle
  251     c'kptResponse = realToFrac kptResponse
  252 
  253 mkKeyPoint :: KeyPointRec -> KeyPoint
  254 mkKeyPoint = unsafePerformIO . newKeyPoint
  255 
  256 keyPointAsRec :: KeyPoint -> KeyPointRec
  257 keyPointAsRec kpt = unsafePerformIO $
  258     withPtr kpt $ \kptPtr ->
  259     alloca $ \xPtr        ->
  260     alloca $ \yPtr        ->
  261     alloca $ \sizePtr     ->
  262     alloca $ \anglePtr    ->
  263     alloca $ \responsePtr ->
  264     alloca $ \octavePtr   ->
  265     alloca $ \classIdPtr  -> do
  266       [CU.block|void {
  267         KeyPoint * kpt = $(KeyPoint * kptPtr);
  268         *$(float   * xPtr       ) = kpt->pt.x    ;
  269         *$(float   * yPtr       ) = kpt->pt.y    ;
  270         *$(float   * sizePtr    ) = kpt->size    ;
  271         *$(float   * anglePtr   ) = kpt->angle   ;
  272         *$(float   * responsePtr) = kpt->response;
  273         *$(int32_t * octavePtr  ) = kpt->octave  ;
  274         *$(int32_t * classIdPtr ) = kpt->class_id;
  275       }|]
  276       KeyPointRec
  277         <$> ( V2 <$> (realToFrac <$> peek xPtr)
  278                  <*> (realToFrac <$> peek yPtr)
  279             )
  280         <*> (realToFrac <$> peek sizePtr    )
  281         <*> (realToFrac <$> peek anglePtr   )
  282         <*> (realToFrac <$> peek responsePtr)
  283         <*> peek octavePtr
  284         <*> peek classIdPtr
  285 
  286 --------------------------------------------------------------------------------
  287 -- DMatch
  288 --------------------------------------------------------------------------------
  289 
  290 {- | Class for matching keypoint descriptors: query descriptor index, train
  291 descriptor index, train image index, and distance between descriptors
  292 
  293 <http://docs.opencv.org/3.0-last-rst/modules/core/doc/basic_structures.html#dmatch OpenCV Sphinx Doc>
  294 -}
  295 newtype DMatch = DMatch {unDMatch :: ForeignPtr C'DMatch}
  296 
  297 type instance C DMatch = C'DMatch
  298 
  299 mkPlacementNewInstance ''DMatch
  300 
  301 instance WithPtr DMatch where
  302     withPtr = withForeignPtr . unDMatch
  303 
  304 instance FromPtr DMatch where
  305     fromPtr = objFromPtr DMatch $ \ptr ->
  306                 [CU.exp| void { delete $(DMatch * ptr) }|]
  307 
  308 instance CSizeOf C'DMatch where
  309     cSizeOf _proxy = c'sizeof_DMatch
  310 
  311 data DMatchRec
  312    = DMatchRec
  313      { dmatchQueryIdx :: !Int32
  314        -- ^ Query descriptor index.
  315      , dmatchTrainIdx :: !Int32
  316        -- ^ Train descriptor index.
  317      , dmatchImgIdx   :: !Int32
  318        -- ^ Train image index.
  319      , dmatchDistance :: !Float
  320      } deriving (Eq, Show)
  321 
  322 newDMatch :: DMatchRec -> IO DMatch
  323 newDMatch DMatchRec{..} = fromPtr $
  324     [CU.exp|DMatch * {
  325       new cv::DMatch
  326           ( $(int32_t dmatchQueryIdx)
  327           , $(int32_t dmatchTrainIdx)
  328           , $(int32_t dmatchImgIdx)
  329           , $(float c'distance)
  330           )
  331     }|]
  332   where
  333     c'distance = realToFrac dmatchDistance
  334 
  335 mkDMatch :: DMatchRec -> DMatch
  336 mkDMatch = unsafePerformIO . newDMatch
  337 
  338 dmatchAsRec :: DMatch -> DMatchRec
  339 dmatchAsRec dmatch = unsafePerformIO $
  340     withPtr dmatch $ \dmatchPtr ->
  341     alloca $ \queryIdxPtr ->
  342     alloca $ \trainIdxPtr ->
  343     alloca $ \imgIdxPtr ->
  344     alloca $ \distancePtr -> do
  345       [CU.block|void {
  346         DMatch * dmatch = $(DMatch * dmatchPtr);
  347         *$(int32_t * queryIdxPtr) = dmatch->queryIdx;
  348         *$(int32_t * trainIdxPtr) = dmatch->trainIdx;
  349         *$(int32_t * imgIdxPtr  ) = dmatch->imgIdx  ;
  350         *$(float   * distancePtr) = dmatch->distance;
  351       }|]
  352       DMatchRec
  353         <$> peek queryIdxPtr
  354         <*> peek trainIdxPtr
  355         <*> peek imgIdxPtr
  356         <*> (realToFrac <$> peek distancePtr)
  357 
  358 --------------------------------------------------------------------------------
  359 -- Algorithm
  360 --------------------------------------------------------------------------------
  361 
  362 class Algorithm a where
  363     algorithmClearState :: (PrimMonad m) => a (PrimState m) -> m ()
  364     algorithmIsEmpty    :: (PrimMonad m) => a (PrimState m) -> m Bool