module CV.Features (SURFParams, defaultSURFParams, getSURF
#ifndef OpenCV24
,getMSER, MSERParams, mkMSERParams, defaultMSERParams
#endif
,moments,Moments,getSpatialMoment,getCentralMoment,getNormalizedCentralMoment) where
import CV.Image
import CV.Bindings.Types
import CV.Bindings.Features
import Foreign.Ptr
import Control.Monad
import Foreign.Storable
import Foreign.Marshal.Array
import Foreign.Marshal.Utils
import Utils.GeometryClass
import System.IO.Unsafe
#ifndef OpenCV24
newtype MSERParams = MP C'CvMSERParams deriving (Show)
mkMSERParams :: Int
-> Int
-> Int
-> Float
-> Float
-> Int
-> Double
-> Double
-> Int
-> MSERParams
mkMSERParams a b c d e f g h i= MP $ C'CvMSERParams a b c d e f g h i
defaultMSERParams = mkMSERParams 5 14400 60 0.25 0.2 200 1.01 0.003 5
getMSER :: (Point2D a, ELP a~Int)
=> Image GrayScale D8 -> Maybe (Image GrayScale D8) -> MSERParams -> [[a]]
getMSER image mask (MP params) = unsafePerformIO $
withMask mask $ \ptr_mask ->
with nullPtr $ \ptr_ptr_contours ->
withNewMemory $ \ptr_mem ->
with params $ \ptr_params ->
withImage image $ \ptr_image -> do
c'wrapExtractMSER (castPtr ptr_image) ptr_mask ptr_ptr_contours
ptr_mem ptr_params
ptr_contours <- peek ptr_ptr_contours
forM [0..10] $ \ix -> do
ptr_ctr <- c'cvGetSeqElem ptr_contours ix
ctr <- peek (castPtr ptr_ctr)
pts :: [C'CvPoint] <- cvSeqToList ctr
return (map convertPt pts)
#endif
withMask :: Maybe (Image GrayScale D8) -> (Ptr C'CvArr -> IO α) -> IO α
withMask m f = case m of
Just m -> withImage m (f.castPtr)
Nothing -> f nullPtr
newtype SURFParams = SP C'CvSURFParams deriving Show
mkSURFParams :: Double
-> Int
-> Int
-> Bool
-> SURFParams
mkSURFParams a b c d = SP $ C'CvSURFParams (fromBool d)
(realToFrac a)
(fromIntegral b)
(fromIntegral c)
defaultSURFParams :: SURFParams
defaultSURFParams = mkSURFParams 400 3 4 False
getSURF :: SURFParams
-> Image GrayScale D8
-> Maybe (Image GrayScale D8)
-> [(C'CvSURFPoint,[Float])]
getSURF (SP params) image mask = unsafePerformIO $
withNewMemory $ \ptr_mem ->
withMask mask $ \ptr_mask ->
with nullPtr $ \ptr_ptr_keypoints ->
with nullPtr $ \ptr_ptr_descriptors ->
with params $ \ptr_params ->
withImage image $ \ptr_image -> do
ptr_keypoints' <- peek ptr_ptr_keypoints
c'wrapExtractSURF (castPtr ptr_image) ptr_mask ptr_ptr_keypoints
ptr_ptr_descriptors ptr_mem ptr_params 0
ptr_keypoints <- peek ptr_ptr_keypoints
ptr_descriptors <- peek ptr_ptr_descriptors
a <- cvSeqToList ptr_keypoints
b <- if c'CvSURFParams'extended params == 1
then do
es :: [FloatBlock128] <- cvSeqToList ptr_descriptors
return (map (\(FP128 e) -> e) es)
else do
es :: [FloatBlock64] <- cvSeqToList ptr_descriptors
return (map (\(FP64 e) -> e) es)
return (zip a b)
newtype FloatBlock64 = FP64 [Float] deriving (Show)
newtype FloatBlock128 = FP128 [Float] deriving (Show)
instance Storable FloatBlock64 where
sizeOf _ = sizeOf (undefined :: Float) * 64
alignment _ = 4
peek ptr = FP64 `fmap` peekArray 64 (castPtr ptr)
poke ptr (FP64 e) = pokeArray (castPtr ptr) e
instance Storable FloatBlock128 where
sizeOf _ = sizeOf (undefined :: Float) * 128
alignment _ = 4
peek ptr = FP128 `fmap` peekArray 128 (castPtr ptr)
poke ptr (FP128 e) = pokeArray (castPtr ptr) e
type Moments = C'CvMoments
moments :: Image GrayScale D32 -> Moments
moments img = unsafePerformIO $
withGenImage img $ \c_img ->
with (C'CvMoments 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) $ \res -> do
c'cvMoments c_img res 0
peek res
getSpatialMoment :: (Int,Int) -> Moments -> Double
getSpatialMoment (x,y) m = realToFrac $
unsafePerformIO $
with m $ \c_m ->
c'cvGetSpatialMoment c_m (fromIntegral x) (fromIntegral y)
getCentralMoment :: (Int,Int) -> Moments -> Double
getCentralMoment (x,y) m = realToFrac $
unsafePerformIO $
with m $ \c_m ->
c'cvGetCentralMoment c_m (fromIntegral x) (fromIntegral y)
getNormalizedCentralMoment :: (Int,Int) -> Moments -> Double
getNormalizedCentralMoment (x,y) m = realToFrac $
unsafePerformIO $
with m $ \c_m ->
c'cvGetNormalizedCentralMoment c_m (fromIntegral x) (fromIntegral y)