module CV.ConnectedComponents
(
fillConnectedComponents
,maskConnectedComponent
,selectSizedComponents
,countBlobs
,spatialMoments
,centralMoments
,normalizedCentralMoments
,huMoments
,Contours
,getContours
,contourArea
,contourPerimeter
,contourPoints
,mapContours
,contourHuMoments)
where
import CV.Bindings.ImgProc
import CV.Bindings.Types
import Control.Monad ((>=>))
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Marshal.Utils (with)
import Foreign.Ptr
import Foreign.Storable
import System.IO.Unsafe
import CV.Image
import CV.ImageOp
fillConnectedComponents :: Image GrayScale D8 -> (Image GrayScale D8, Int)
fillConnectedComponents image = unsafePerformIO $ do
let
count :: CInt
count = 0
withCloneValue image $ \clone ->
withImage clone $ \pclone ->
with count $ \pcount -> do
c'fillConnectedComponents (castPtr pclone) pcount
c <- peek pcount
return (clone, fromIntegral c)
maskConnectedComponent :: Image GrayScale D8 -> Int -> Image GrayScale D8
maskConnectedComponent image index = unsafePerformIO $
withCloneValue image $ \clone ->
withImage image $ \pimage ->
withImage clone $ \pclone -> do
c'maskConnectedComponent (castPtr pimage) (castPtr pclone) (fromIntegral index)
return clone
countBlobs :: Image GrayScale D8 -> Int
countBlobs image = fromIntegral $unsafePerformIO $ do
withGenImage image $ \i ->
blobCount i
selectSizedComponents :: Double -> Double -> Image GrayScale D8 -> Image GrayScale D8
selectSizedComponents minSize maxSize image = unsafePerformIO $ do
withGenImage image $ \i ->
creatingImage (sizeFilter i (realToFrac minSize) (realToFrac maxSize))
getMoments :: (Ptr C'CvMoments -> CInt -> CInt -> IO (CDouble)) -> Image GrayScale D32 -> Bool -> [Double]
getMoments f image binary = unsafePerformIO $ do
withImage image $ \pimage -> do
let
moments :: C'CvMoments
moments = C'CvMoments 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
with moments $ \pmoments -> do
c'cvMoments (castPtr pimage) pmoments (if binary then 1 else 0)
ms <- sequence [ f pmoments i j
| i <- [0..3], j <- [0..3], i+j <= 3 ]
return (map realToFrac ms)
spatialMoments = getMoments c'cvGetSpatialMoment
centralMoments = getMoments c'cvGetCentralMoment
normalizedCentralMoments = getMoments c'cvGetNormalizedCentralMoment
huMoments :: Image GrayScale D32 -> Bool -> [Double]
huMoments image binary = unsafePerformIO $ do
withImage image $ \pimage -> do
let
moments = C'CvMoments 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
hu = C'CvHuMoments 0 0 0 0 0 0 0
with moments $ \pmoments -> do
with hu $ \phu -> do
c'cvMoments (castPtr pimage) pmoments (if binary then 1 else 0)
c'cvGetHuMoments pmoments phu
(C'CvHuMoments hu1 hu2 hu3 hu4 hu5 hu6 hu7) <- peek phu
return (map realToFrac [hu1,hu2,hu3,hu4,hu5,hu6,hu7])
readHu m = do
hu <- mallocArray 7
getHuMoments m hu
hu' <- peekArray 7 hu
free hu
return hu'
newtype Contours = Contours (ForeignPtr (Contours))
withContours (Contours fptr) = withForeignPtr fptr
foreign import ccall "& free_found_contours" releaseContours
:: FinalizerPtr Contours
mapContours :: ContourFunctionUS a -> Contours -> [a]
mapContours (CFUS op) contours = unsafePerformIO $ do
let loop acc cp = do
more <- withContours cp more_contours
if more < 1
then return acc
else do
x <- op cp
(i::CInt) <- withContours cp next_contour
loop (x:acc) cp
acc <- loop [] contours
withContours contours (reset_contour)
return acc
getContours :: Image GrayScale D8 -> Contours
getContours img = unsafePerformIO $ do
withImage img $ \i -> do
ptr <- get_contours i
fptr <- newForeignPtr releaseContours ptr
return $ Contours fptr
newtype ContourFunctionUS a = CFUS (Contours -> IO a)
newtype ContourFunctionIO a = CFIO (Contours -> IO a)
rawContourOpUS op = CFUS $ \c -> withContours c op
rawContourOp op = CFIO $ \c -> withContours c op
printContour = rawContourOp print_contour
contourArea :: ContourFunctionUS Double
contourArea = rawContourOpUS (contour_area >=> return.realToFrac)
contourPerimeter :: ContourFunctionUS Double
contourPerimeter = rawContourOpUS $ contour_perimeter >=> return.realToFrac
contourPoints :: ContourFunctionUS [(Double,Double)]
contourPoints = rawContourOpUS getContourPoints'
getContourPoints' f = do
count <- cur_contour_size f
let count' = fromIntegral count
xs <- mallocArray count'
ys <- mallocArray count'
contour_points f xs ys
xs' <- peekArray count' xs
ys' <- peekArray count' ys
free xs
free ys
return $ zip (map fromIntegral xs') (map fromIntegral ys')
contourHuMoments :: ContourFunctionUS [Double]
contourHuMoments = rawContourOpUS $ getContourHuMoments' >=> return.map realToFrac
getContourHuMoments' f = do
m <- contour_moments f
hu <- readHu m
freeCvMoments m
return hu
mapContoursIO :: ContourFunctionIO a -> Contours -> IO [a]
mapContoursIO (CFIO op) contours = do
let loop acc cp = do
more <- withContours cp more_contours
if more < 1
then return acc
else do
x <- op cp
(i::CInt) <- withContours cp next_contour
loop (x:acc) cp
acc <- loop [] contours
withContours contours (reset_contour)
return acc
newtype Moments = Moments (ForeignPtr (Moments))
withMoments (Moments fptr) = withForeignPtr fptr
foreign import ccall safe "CV/ConnectedComponents.chs.h blobCount"
blobCount :: ((Ptr (BareImage)) -> (IO CInt))
foreign import ccall safe "CV/ConnectedComponents.chs.h sizeFilter"
sizeFilter :: ((Ptr (BareImage)) -> (CDouble -> (CDouble -> (IO (Ptr (BareImage))))))
foreign import ccall safe "CV/ConnectedComponents.chs.h getHuMoments"
getHuMoments :: ((Ptr ()) -> ((Ptr CDouble) -> (IO ())))
foreign import ccall safe "CV/ConnectedComponents.chs.h more_contours"
more_contours :: ((Ptr (Contours)) -> (IO CInt))
foreign import ccall safe "CV/ConnectedComponents.chs.h next_contour"
next_contour :: ((Ptr (Contours)) -> (IO CInt))
foreign import ccall safe "CV/ConnectedComponents.chs.h reset_contour"
reset_contour :: ((Ptr (Contours)) -> (IO CInt))
foreign import ccall safe "CV/ConnectedComponents.chs.h get_contours"
get_contours :: ((Ptr (BareImage)) -> (IO (Ptr (Contours))))
foreign import ccall safe "CV/ConnectedComponents.chs.h print_contour"
print_contour :: ((Ptr (Contours)) -> (IO ()))
foreign import ccall safe "CV/ConnectedComponents.chs.h contour_area"
contour_area :: ((Ptr (Contours)) -> (IO CDouble))
foreign import ccall safe "CV/ConnectedComponents.chs.h contour_perimeter"
contour_perimeter :: ((Ptr (Contours)) -> (IO CDouble))
foreign import ccall safe "CV/ConnectedComponents.chs.h cur_contour_size"
cur_contour_size :: ((Ptr (Contours)) -> (IO CInt))
foreign import ccall safe "CV/ConnectedComponents.chs.h contour_points"
contour_points :: ((Ptr (Contours)) -> ((Ptr CInt) -> ((Ptr CInt) -> (IO ()))))
foreign import ccall safe "CV/ConnectedComponents.chs.h contour_moments"
contour_moments :: ((Ptr (Contours)) -> (IO (Ptr ())))
foreign import ccall safe "CV/ConnectedComponents.chs.h freeCvMoments"
freeCvMoments :: ((Ptr ()) -> (IO ()))