From eccecaebeb86a847367b0bc8df8f2847cde598c7 Mon Sep 17 00:00:00 2001 From: Adam Vogt Date: Thu, 1 May 2014 00:51:22 -0400 Subject: [PATCH] working contouring --- HOpenCV.cabal | 4 + src/OpenCV/Contours.hsc | 207 ++++++++++++++++++++++++++------- src/OpenCV/Core/HOpenCV_wrap.c | 37 ++++++ src/OpenCV/Core/HOpenCV_wrap.h | 11 ++ src/OpenCV/Core/Image.hsc | 3 +- src/OpenCV/Drawing.hsc | 5 +- 6 files changed, 223 insertions(+), 44 deletions(-) diff --git a/HOpenCV.cabal b/HOpenCV.cabal index e6ba6c0..3a2de63 100644 --- a/HOpenCV.cabal +++ b/HOpenCV.cabal @@ -80,6 +80,10 @@ library extra-libraries: cv highgui else extra-libraries: opencv_core,opencv_imgproc,opencv_highgui,opencv_video + + -- needed to load in ghci-7.8 + cc-options: -fPIC + build-depends: base >= 4.6 && <5, template-haskell, vector-space >= 0.7.2, diff --git a/src/OpenCV/Contours.hsc b/src/OpenCV/Contours.hsc index 9ea6346..0ad9f62 100644 --- a/src/OpenCV/Contours.hsc +++ b/src/OpenCV/Contours.hsc @@ -1,18 +1,140 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-} -- |Incomplete support for cvFindContours. -module OpenCV.Contours (ContourMode(..), ContourMethod(..), - cvFindContours, followContourList) where +module OpenCV.Contours ( + + -- * contour + Contour(..), + withContourList, + -- ** functions to use with 'withContourList' + cvContourArea, + cvContourPerimeter, + followPoints, + + cvDrawContours, + -- * moments + cvMoments, + CvMoments(..), + + cvGetSpatialMoment, + cvGetCentralMoment, + cvGetNormalizedCentralMoment, + cvGetHuMoments, + CvHuMoments(..), + + -- * unused + ContourMode(..), ContourMethod(..), + ) where import OpenCV.Core.CxCore -import Foreign.C.Types (CInt) -import Foreign.Ptr (Ptr, castPtr, nullPtr) +import OpenCV.Core.ImageUtil +import Foreign.C.Types (CInt(..)) +import Foreign.Ptr -- (Ptr, castPtr, nullPtr) import Foreign.Storable -import Foreign.Marshal.Alloc (alloca) +import Foreign.Marshal.Alloc -- (alloca) +import Foreign.ForeignPtr.Safe +import Foreign.Marshal + +import Control.Monad #include +#include foreign import ccall "HOpenCV_wrap.h c_cvFindContours" - c_cvFindContours :: Ptr CvArr -> Ptr CvMemStorage -> Ptr (Ptr (CvSeq a)) -> - Int -> Int -> Int -> Int -> Int -> IO Int + c_cvFindContours :: Ptr CvArr -> Ptr CvMemStorage -> Ptr (Ptr (CvSeq a)) -> + CInt -> CInt -> CInt -> CInt -> CInt -> IO CInt + +foreign import ccall "HOpenCV_wrap.h c_cvGetSeqPoint" + c_cvGetSeqPoint :: Ptr (CvSeq a) -> CInt -> Ptr CInt -> Ptr CInt -> IO () + +foreign import ccall "HOpenCV_wrap.h c_cvContourArea" + cvContourArea :: Contour -> IO Double + +foreign import ccall "HOpenCV_wrap.h c_cvContourPerimeter" + cvContourPerimeter :: Contour -> IO Double + +foreign import ccall "HOpenCV_wrap.h c_cvMoments" + c_cvMoments :: Ptr CvArr -> Ptr CvMoments -> IO () + +cvMoments :: IplArrayType a => Ptr a -> IO CvMoments +cvMoments img = do + p <- mallocForeignPtrBytes (# size CvMoments ) + withForeignPtr p (c_cvMoments (castPtr img)) + return (CvMoments p) + +foreign import ccall "cvGetSpatialMoment" + c_cvGetSpatialMoment :: Ptr CvMoments -> CInt -> CInt -> IO Double + +cvGetSpatialMoment, cvGetCentralMoment, cvGetNormalizedCentralMoment + :: CvMoments + -> CInt -- ^ x + -> CInt -- ^ y + -> IO Double +cvGetSpatialMoment (CvMoments p) xord yord = + withForeignPtr p (\ p' -> c_cvGetSpatialMoment p' xord yord ) + +foreign import ccall "cvGetCentralMoment" + c_cvGetCentralMoment :: Ptr CvMoments -> CInt -> CInt -> IO Double + +cvGetCentralMoment (CvMoments p) xord yord = + withForeignPtr p (\ p' -> c_cvGetCentralMoment p' xord yord ) + +foreign import ccall "cvGetNormalizedCentralMoment" + c_cvGetNormalizedCentralMoment :: Ptr CvMoments -> CInt -> CInt -> IO Double + +cvGetNormalizedCentralMoment (CvMoments p) xord yord = + withForeignPtr p (\ p' -> c_cvGetNormalizedCentralMoment p' xord yord ) + +foreign import ccall "cvGetHuMoments" + c_cvGetHuMoments :: Ptr CvMoments -> Ptr () -> IO () + +foreign import ccall "c_cvDrawContours" + c_cvDrawContours :: Ptr IplImage + -> Contour + -> Ptr CvScalar -- ^ RGBA external_color + -> Ptr CvScalar -- ^ RGBA hole_color + -> CInt -- max level + -> CInt -- thickness + -> CInt -- line-type + -> Ptr CvPoint -- offset + -> IO () + +cvDrawContours :: + Ptr IplImage + -> Contour + -> CvScalar -- ^ external color + -> CvScalar -- ^ hole color + -> CInt -- ^ max level + -> CInt -- ^ thickness + -> CInt -- ^ line type + -> CvPoint -- ^ offset + -> IO () +cvDrawContours img contour external_color hole_color max_level thickness line_type offset = + with external_color $ \ec -> + with hole_color $ \ hc -> + with offset $ \offset' -> + c_cvDrawContours img contour ec hc max_level thickness line_type offset' + + +cvGetHuMoments :: CvMoments -> IO CvHuMoments +cvGetHuMoments (CvMoments m) = allocaBytes (# size CvHuMoments ) $ \p -> do + withForeignPtr m $ \m' -> c_cvGetHuMoments m' p + h1 <- (#peek CvHuMoments, hu1) p + h2 <- (#peek CvHuMoments, hu2) p + h3 <- (#peek CvHuMoments, hu3) p + h4 <- (#peek CvHuMoments, hu4) p + h5 <- (#peek CvHuMoments, hu5) p + h6 <- (#peek CvHuMoments, hu6) p + h7 <- (#peek CvHuMoments, hu7) p + return (CvHuMoments h1 h2 h3 h4 h5 h6 h7) + +newtype Contour = Contour (Ptr (CvSeq (CInt, CInt))) + +-- | abstract. Use 'cvGetSpatialMoment' etc. +newtype CvMoments = CvMoments (ForeignPtr CvMoments) + +data CvHuMoments = CvHuMoments !Double !Double !Double !Double !Double !Double !Double + deriving Show -- |Contour extraction mode. data ContourMode = CV_RETR_EXTERNAL -- ^retrieves only the extreme @@ -32,9 +154,11 @@ data ContourMode = CV_RETR_EXTERNAL -- ^retrieves only the extreme | CV_RETR_TREE -- ^retrieves all of the contours -- and reconstructs the full -- hierarchy of nested contours + | CV_RETR_FLOODFILL deriving (Enum, Eq) -data ContourMethod = CV_CHAIN_APPROX_NONE +data ContourMethod = CV_CHAIN_CODE -- ^ ?? + | CV_CHAIN_APPROX_NONE -- ^translates all of the points from the chain -- code into points @@ -60,41 +184,40 @@ data ContourMethod = CV_CHAIN_APPROX_NONE -- |The function retrieves 'CvContour's from the binary image using the -- algorithm Suzuki85. The contours are a useful tool for shape -- analysis and object detection and recognition. -cvFindContours :: IplArrayType a => Ptr a -> ContourMode -> ContourMethod -> IO [CvContour] -cvFindContours img mode method = - do storage <- cvCreateMemStorage 0 - let header = case method of - --CV_CHAIN_CODE -> (#size CvChain) - _ -> (#size CvContour) - mode' = fromEnum mode - method' = case method of - CV_LINK_RUNS -> if mode == CV_RETR_LIST - then fromEnum method - else error $ "CV_LINK_RUNS can only be "++ - "used with CV_RETR_LIST" - _ -> fromEnum method - cs <- alloca $ \cseq -> - do _n <- alloca $ \cseq' -> - poke (cseq'::Ptr (Ptr CInt)) cseq >> - c_cvFindContours (fromArr img) storage (castPtr cseq') - header mode' method' 0 0 - putStrLn $ "Found "++show _n++" contours" - followContourList (castPtr cseq) +-- +-- only does @CV_RETR_LIST CV_CHAIN_APPROX_SIMPLE@ +-- +withContourList :: Image Monochromatic d roi -> (Contour -> IO r) -> IO [r] +withContourList img fn = withIplImage img $ \imgPtr -> do + storage <- cvCreateMemStorage 0 + cseq <- new nullPtr + n <- c_cvFindContours (fromArr imgPtr) storage + cseq + (#size CvContour) + (fromIntegral (fromEnum CV_RETR_LIST)) + (fromIntegral (fromEnum CV_CHAIN_APPROX_SIMPLE)) 0 0 + cs <- mapContours fn n . Contour =<< peek cseq cvReleaseMemStorage storage + free cseq return cs --- FIXME: This is wrong. We're actually getting an array of arrays of --- Points. Check the cvDrawContours function to see how to interpret --- the result of c_cvFindContours. -followContourList :: Ptr (CvSeq CvContour) -> IO [CvContour] -followContourList = go [] - where go acc p = if p == nullPtr - then return $ reverse acc - else do putStrLn "Getting element 1" - n <- seqNumElems p - putStrLn $ "Initial seq has "++show n++" elems" - x <- peek =<< cvGetSeqElem p 1 - putStrLn $ "Found " ++ show x - p' <- (#peek CvSeq, h_next) p - go (x:acc) p' +mapContours :: (Contour -> IO b) -> CInt -> Contour -> IO [ b ] +mapContours fn n (Contour p0) = go [] n p0 where + go acc 0 p = return $ reverse acc + go acc n p | p == nullPtr = return $ reverse acc + go acc n p = do + b <- fn (Contour p) + p' <- (#peek CvSeq, h_next) p + go (b:acc) (n-1) p' + +followPoints :: Contour -> IO [(CInt, CInt)] +followPoints (Contour p) = do + m <- (#peek CvSeq, total) p + alloca $ \x -> alloca $ \y -> + let go (-1) acc = return acc + go ni acc = do + c_cvGetSeqPoint p ni x y + xy <- liftM2 (,) (peek x) (peek y) + go (ni-1) (xy : acc) + in go ((m::CInt) - 1) [] diff --git a/src/OpenCV/Core/HOpenCV_wrap.c b/src/OpenCV/Core/HOpenCV_wrap.c index 8b6f9e9..9948d25 100644 --- a/src/OpenCV/Core/HOpenCV_wrap.c +++ b/src/OpenCV/Core/HOpenCV_wrap.c @@ -139,6 +139,12 @@ int seq_total(const CvSeq *seq) { return seq->total; } +void c_cvGetSeqPoint(const CvSeq *seq, int i, int*x, int*y) { + CvPoint* p = CV_GET_SEQ_ELEM( CvPoint, seq, i); + *x = p->x; + *y = p->y; +} + /* Commonly used case of CV_GET_SEQ_ELEM is CvRect-typed elements. The macro CV_GET_SEQ_ELEM is supposed to be faster in some cases than the function cvGetSeqElem. */ @@ -184,6 +190,26 @@ int c_cvFindContours(CvArr *img, CvMemStorage *storage, CvSeq** first_contour, method, cvPoint(offset_x,offset_y)); } + +double c_cvContourArea( const CvArr *contour) +{ + return cvContourArea( contour, CV_WHOLE_SEQ, 0 ); +} + + + +void c_cvMoments( const CvArr* arr, CvMoments* moments) +{ + cvMoments( arr, moments, 0); +} + +double c_cvContourPerimeter( const void* contour) +{ + cvContourPerimeter(contour); +} + +// int c_cvFollowContourList + void c_cvSetRoi(IplImage* img, int x, int y, int width, int height) { cvSetImageROI(img, cvRect(x,y,width,height)); @@ -205,6 +231,17 @@ void c_cvAvg(const CvArr *img, const CvArr *mask, CvScalar* avg) } +void c_cvDrawContours( CvArr * img, CvSeq* contour, + CvScalar * external_color, + CvScalar * hole_color, + int max_level, int max_thickness, int line_type, CvPoint * offset ) +{ + cvDrawContours( img, contour, *external_color, *hole_color, + max_level, max_thickness, line_type, *offset); +} + + + /****************************************************************************/ /* CvSeq *c_cvHaarDetectObjects( const CvArr* image, diff --git a/src/OpenCV/Core/HOpenCV_wrap.h b/src/OpenCV/Core/HOpenCV_wrap.h index f6faf58..67eb8be 100644 --- a/src/OpenCV/Core/HOpenCV_wrap.h +++ b/src/OpenCV/Core/HOpenCV_wrap.h @@ -31,6 +31,9 @@ void cv_free(void *obj); int seq_total(const CvSeq *seq); /* CvRect *c_rect_cvGetSeqElem(const CvSeq *seq, int index); */ +void c_cvGetSeqPoint(const CvSeq *seq, int i, int*x, int*y); + + CvVideoWriter* cvCreateVideoWriter(const char* filename, int fourcc, double fps, int frame_x, int frame_y, int is_color); @@ -49,6 +52,9 @@ int c_cvFindContours(CvArr *img, CvMemStorage *storage, CvSeq** first_contour, int header_size, int mode, int method, int offset_x, int offset_y); +double c_cvContourArea( const CvArr *contour); +double c_cvContourPerimeter( const void* contour); + void c_cvAvg(const CvArr *img, const CvArr *mask, CvScalar* avg); CvSeq *c_cvHaarDetectObjects( const CvArr* image, @@ -57,3 +63,8 @@ CvSeq *c_cvHaarDetectObjects( const CvArr* image, int min_neighbors , int flags, int width, int height); + +void c_cvDrawContours( CvArr * img, CvSeq* contour, + CvScalar * external_color, + CvScalar * hole_color, + int max_level, int max_thickness, int line_type, CvPoint * offset ); diff --git a/src/OpenCV/Core/Image.hsc b/src/OpenCV/Core/Image.hsc index b6fe55b..88d8e1e 100644 --- a/src/OpenCV/Core/Image.hsc +++ b/src/OpenCV/Core/Image.hsc @@ -29,7 +29,8 @@ import Control.Monad (when) import Data.Bits (complement, (.&.)) import Data.Int import Data.Proxy -import Data.Singletons +import Data.Singletons hiding (Proxy) +import Data.Singletons.TH import Data.Word (Word8, Word16) import Foreign.C.Types import Foreign.ForeignPtr diff --git a/src/OpenCV/Drawing.hsc b/src/OpenCV/Drawing.hsc index 91064a6..708f07b 100644 --- a/src/OpenCV/Drawing.hsc +++ b/src/OpenCV/Drawing.hsc @@ -138,4 +138,7 @@ fillConvexPoly (r,g,b) lineType pts = where lt = fi $ lineTypeEnum lineType flatten (x,y) = [fi x, fi y] fi = fromIntegral - fr = realToFrac \ No newline at end of file + fr = realToFrac + + +