diff --git a/HOpenCV.cabal b/HOpenCV.cabal new file mode 100644 --- /dev/null +++ b/HOpenCV.cabal @@ -0,0 +1,42 @@ +name: HOpenCV +version: 0.1 +license: BSD3 +maintainer: Noam Lewis +bug-reports: mailto:jones.noamle@gmail.com +category: AI, Graphics +synopsis: A binding for the OpenCV computer vision library +description: + Initial version with very limited bindings to OpenCV +build-type: Simple +cabal-version: >= 1.2 +extra-source-files: + src/AI/CV/OpenCV/HOpenCV_wrap.h + +library + exposed-modules: + AI.CV.OpenCV.CV + AI.CV.OpenCV.CxCore + AI.CV.OpenCV.HighGui + AI.CV.OpenCV.Types + Foreign.ForeignPtrWrap + c-sources: + src/AI/CV/OpenCV/HOpenCV_wrap.c + hs-Source-Dirs: src + include-dirs: /usr/include/opencv + extra-libraries: cv,highgui + build-depends: base >= 3 && < 5, containers, MaybeT, mtl + ghc-options: -Wall + +executable test-hopencv + c-sources: + src/AI/CV/OpenCV/HOpenCV_wrap.c + include-dirs: /usr/include/opencv + hs-source-dirs: src + Build-Depends: base >= 4 + main-is: Test.hs + Ghc-Options: -Wall + Ghc-Prof-Options: -prof -auto-all + extra-libraries: cv,highgui + other-modules: AI.CV.OpenCV.CxCore, AI.CV.OpenCV.CV, AI.CV.OpenCV.HighGui, AI.CV.OpenCV.Types + + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/AI/CV/OpenCV/CV.hsc b/src/AI/CV/OpenCV/CV.hsc new file mode 100644 --- /dev/null +++ b/src/AI/CV/OpenCV/CV.hsc @@ -0,0 +1,92 @@ +{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} + +module AI.CV.OpenCV.CV where + +import Foreign.C.Types +import Foreign.Ptr + +import Data.Bits + +import AI.CV.OpenCV.CxCore + +#include + + +foreign import ccall unsafe "cv.h cvCanny" + c_cvCanny :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> CInt -> IO () + +cvCanny :: (IplArrayType i1, IplArrayType i2) => + Ptr i1 -> Ptr i2 -> CDouble -> CDouble -> CInt -> IO () +cvCanny src dst threshold1 threshold2 apertureSize = + c_cvCanny (fromArr src) (fromArr dst) (realToFrac threshold1) (realToFrac threshold2) apertureSize + + +data InterpolationMethod = CV_INTER_NN + | CV_INTER_LINEAR + | CV_INTER_CUBIC + | CV_INTER_AREA + deriving (Enum,Eq) + +foreign import ccall unsafe "cv.h cvResize" + c_cvResize :: Ptr CvArr -> Ptr CvArr -> CInt -> IO () + +cvResize :: (IplArrayType i1, IplArrayType i2) => Ptr i1 -> Ptr i2 -> InterpolationMethod -> IO () +cvResize src dst interp = c_cvResize (fromArr src) (fromArr dst) (fromIntegral . fromEnum $ interp) + +foreign import ccall unsafe "HOpenCV_warp.h dilate" + c_dilate :: Ptr CvArr -> Ptr CvArr -> CInt -> IO () + +cvDilate :: (IplArrayType i1, IplArrayType i2) => Ptr i1 -> Ptr i2 -> CInt -> IO () +cvDilate src dst iter = c_dilate (fromArr src) (fromArr dst) iter + + +foreign import ccall unsafe "cv.h cvPyrDown" + c_cvPyrDown :: Ptr CvArr -> Ptr CvArr -> CInt -> IO () + +-- for now only one filter type is supported so no need for the CInt (filter type) +constCvGaussian5x5 :: CInt +constCvGaussian5x5 = 7 +cvPyrDown :: (IplArrayType i1, IplArrayType i2) => Ptr i1 -> Ptr i2 -> IO () +cvPyrDown src dst = c_cvPyrDown (fromArr src) (fromArr dst) constCvGaussian5x5 + +------------------------------------------------------------------------------ + +data CvHaarClassifierCascade + +-- thanks to http://book.realworldhaskell.org/read/interfacing-with-c-the-ffi.html +newtype HaarDetectFlag = HaarDetectFlag { unHaarDetectFlag :: CInt } + deriving (Eq, Show) + +#{enum HaarDetectFlag, HaarDetectFlag + , cvHaarFlagNone = 0 + , cvHaarDoCannyPruning = CV_HAAR_DO_CANNY_PRUNING + , cvHaarScaleImage = CV_HAAR_SCALE_IMAGE + , cvHaarFindBiggestObject = CV_HAAR_FIND_BIGGEST_OBJECT + , cvHaarDoRoughSearch = CV_HAAR_DO_ROUGH_SEARCH + } + +combineHaarFlags :: [HaarDetectFlag] -> HaarDetectFlag +combineHaarFlags = HaarDetectFlag . foldr ((.|.) . unHaarDetectFlag) 0 + +foreign import ccall unsafe "HOpenCV_warp.h c_cvHaarDetectObjects" + c_cvHaarDetectObjects :: Ptr CvArr -- ^ image + -> Ptr CvHaarClassifierCascade -- ^ cascade + -> Ptr CvMemStorage -- ^ storage + -> CDouble -- ^ scale_factor + -> CInt -- ^ min_neighbors + -> CInt -- ^ flags + -> CInt -> CInt -- ^ min_size + -> IO (Ptr (CvSeq CvRect)) + +cvHaarDetectObjects :: (IplArrayType i) => + Ptr i -- ^ image + -> Ptr CvHaarClassifierCascade -- ^ cascade + -> Ptr CvMemStorage -- ^ storage + -> CDouble -- ^ scale_factor + -> CInt -- ^ min_neighbors + -> HaarDetectFlag -- ^ flags + -> CvSize -- ^ min_size + -> IO (Ptr (CvSeq CvRect)) +cvHaarDetectObjects image cascade storage scaleFactor minNeighbors flags minSize = + c_cvHaarDetectObjects (fromArr image) cascade storage scaleFactor minNeighbors (unHaarDetectFlag flags) (sizeWidth minSize) (sizeHeight minSize) + diff --git a/src/AI/CV/OpenCV/CxCore.hsc b/src/AI/CV/OpenCV/CxCore.hsc new file mode 100644 --- /dev/null +++ b/src/AI/CV/OpenCV/CxCore.hsc @@ -0,0 +1,230 @@ +{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} + +module AI.CV.OpenCV.CxCore where + +import Foreign.ForeignPtrWrap +import Foreign.C.Types +import Foreign.C.String +import Foreign + + +#include + +------------------------------------------------------ + +data CvSize = CvSize { sizeWidth :: CInt, sizeHeight :: CInt } + deriving (Show, Eq) +instance Storable CvSize where + sizeOf _ = (#size CvSize) + alignment _ = alignment (undefined :: CInt) + peek ptr = do + w <- (#peek CvSize, width) ptr + h <- (#peek CvSize, height) ptr + return (CvSize w h) + poke ptr (CvSize w h) = do + (#poke CvSize, width) ptr w + (#poke CvSize, height) ptr h + +data CvRect = CvRect { rectX :: CInt, rectY :: CInt, rectWidth :: CInt, rectHeight :: CInt } + deriving (Show, Eq) + +instance Storable CvRect where + sizeOf _ = (#size CvRect) + alignment _ = alignment (undefined :: CInt) + peek ptr = do + x <- (#peek CvRect, x) ptr + y <- (#peek CvRect, y) ptr + w <- (#peek CvRect, width) ptr + h <- (#peek CvRect, height) ptr + return (CvRect x y w h) + poke ptr (CvRect x y w h) = do + (#poke CvRect, x) ptr x + (#poke CvRect, y) ptr y + (#poke CvRect, width) ptr w + (#poke CvRect, height) ptr h + +------------------------------------------------------ +class IplArrayType a + +data CvArr +instance IplArrayType CvArr + +data IplImage +instance IplArrayType IplImage + +data CvMemStorage + +data CvSeq a + +fromArr :: IplArrayType a => Ptr a -> Ptr CvArr +fromArr = castPtr + +newtype Depth = Depth { unDepth :: CInt } + deriving (Eq, Show) + +#{enum Depth, Depth + , iplDepth1u = IPL_DEPTH_1U + , iplDepth8u = IPL_DEPTH_8U + , iplDepth8s = IPL_DEPTH_8S + , iplDepth16u = IPL_DEPTH_16U + , iplDepth16s = IPL_DEPTH_16S + , iplDepth32s = IPL_DEPTH_32S + , iplDepth32f = IPL_DEPTH_32F + , iplDepth64f = IPL_DEPTH_64F +} + +validDepths :: [Depth] +validDepths = [iplDepth1u, iplDepth8u, iplDepth8s, iplDepth16u, iplDepth16s, iplDepth32s, iplDepth32f, iplDepth64f] + +depthsLookupList :: [(CInt, Depth)] +depthsLookupList = map (\d -> (unDepth d, d)) validDepths + +numToDepth :: CInt -> Maybe Depth +numToDepth x = lookup x depthsLookupList + + +--------------------------------------------------------------- +-- mem storage +foreign import ccall unsafe "cxcore.h cvCreateMemStorage" + c_cvCreateMemStorage :: CInt -> IO (Ptr CvMemStorage) + +cvCreateMemStorage :: CInt -> IO (Ptr CvMemStorage) +cvCreateMemStorage = errorName "Failed to create mem storage" . checkPtr . c_cvCreateMemStorage + +foreign import ccall unsafe "HOpenCV_warp.h release_mem_storage" + cvReleaseMemStorage :: Ptr CvMemStorage -> IO () + +foreign import ccall unsafe "HOpenCV_warp.h &release_mem_storage" + cp_release_mem_storage :: FunPtr (Ptr CvMemStorage -> IO ()) + +createMemStorageF :: CInt -> IO (ForeignPtr CvMemStorage) +createMemStorageF = (createForeignPtr cp_release_mem_storage) . cvCreateMemStorage + + +-- images / matrices / arrays + +foreign import ccall unsafe "HOpenCV_warp.h create_image" + c_cvCreateImage :: CInt -> CInt -> CInt -> CInt -> IO (Ptr IplImage) + +cvCreateImage :: CvSize -> CInt -> Depth -> IO (Ptr IplImage) +cvCreateImage size numChans depth = errorName "Failed to create image" . checkPtr $ c_cvCreateImage (sizeWidth size) (sizeHeight size) (unDepth depth) numChans + +foreign import ccall unsafe "HOpenCV_warp.h release_image" + cvReleaseImage :: Ptr IplImage -> IO () + +foreign import ccall unsafe "HOpenCV_warp.h &release_image" + cp_release_image :: FunPtr (Ptr IplImage -> IO ()) + +createImageF :: CvSize -> CInt -> Depth -> IO (ForeignPtr IplImage) +createImageF x y z = createForeignPtr cp_release_image $ cvCreateImage x y z + +foreign import ccall unsafe "cxcore.h cvCloneImage" + c_cvCloneImage :: Ptr IplImage -> IO (Ptr IplImage) + +cvCloneImage :: Ptr IplImage -> IO (Ptr IplImage) +cvCloneImage = errorName "Failed to clone image" . checkPtr . c_cvCloneImage + +cloneImageF :: Ptr IplImage -> IO (ForeignPtr IplImage) +cloneImageF x = createForeignPtr cp_release_image $ cvCloneImage x + +foreign import ccall unsafe "HOpenCV_warp.h get_size" + c_get_size :: Ptr CvArr -> Ptr CvSize -> IO () + +foreign import ccall unsafe "cxcore.h cvCopy" + c_cvCopy :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO () + +-- todo add mask support +cvCopy :: IplArrayType a => Ptr a -> Ptr a -> IO () +cvCopy src dst = c_cvCopy (fromArr src) (fromArr dst) nullPtr + +cvGetSize :: IplArrayType a => Ptr a -> CvSize +cvGetSize p = unsafePerformIO $ + alloca $ \cvSizePtr -> do + c_get_size (castPtr p) cvSizePtr + size <- peek cvSizePtr + return size + +foreign import ccall unsafe "HOpenCV_warp.h get_depth" + c_get_depth :: Ptr IplImage -> IO CInt + +getDepth :: Ptr IplImage -> IO Depth +getDepth img = do + depthInt <- c_get_depth img + case numToDepth depthInt of + Nothing -> fail "Bad depth in image struct" + Just depth -> return depth + +foreign import ccall unsafe "HOpenCV_warp.h get_nChannels" + c_get_nChannels :: Ptr IplImage -> IO CInt + +getNumChannels :: Integral a => Ptr IplImage -> IO a +getNumChannels img = fmap fromIntegral $ c_get_nChannels img + + +foreign import ccall unsafe "cxcore.h cvConvertScale" + cvConvertScale :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> IO () + + +foreign import ccall unsafe "HOpenCV_warp.h cv_free" + cvFree :: Ptr a -> IO () + +foreign import ccall unsafe "cxcore.h cvLoad" + c_cvLoad :: CString -> Ptr CvMemStorage -> CString -> Ptr CString -> IO (Ptr a) + +cvLoad :: String -> Ptr CvMemStorage -> Maybe String -> IO (Ptr a, Maybe String) +cvLoad filename memstorage name = withCString filename cvLoad' + where cvLoad' filenameC = do + case name of + Nothing -> cvLoad'' filenameC nullPtr + Just n' -> withCString n' $ cvLoad'' filenameC + cvLoad'' filenameC nameC = alloca $ \ptrRealNameC -> do + ptrObj <- errorName "cvLoad failed" . checkPtr $ c_cvLoad filenameC memstorage nameC ptrRealNameC + realNameC <- peek ptrRealNameC + realName <- if realNameC == nullPtr + then return Nothing + else fmap Just $ peekCString realNameC + cvFree realNameC + return (ptrObj, realName) + +foreign import ccall unsafe "cxcore.h cvGetSeqElem" + cvGetSeqElem :: Ptr (CvSeq a) -> CInt -> IO (Ptr a) + +-- foreign import ccall unsafe "HOpenCV_warp.h c_rect_cvGetSeqElem" +-- cvGetSeqElemRect :: Ptr (CvSeq (Ptr CvRect)) -> CInt -> IO (Ptr CvRect) + +foreign import ccall unsafe "HOpenCV_warp.h seq_total" + seqNumElems :: Ptr (CvSeq a) -> IO CInt + +seqToPList :: Ptr (CvSeq a) -> IO [Ptr a] +seqToPList pseq = do + numElems <- seqNumElems pseq + mapM (cvGetSeqElem pseq) [1..(numElems)] + +seqToList :: Storable a => Ptr (CvSeq a) -> IO [a] +seqToList pseq = do + numElems <- seqNumElems pseq + flip mapM [1..(numElems)] $ \i -> do + elemP <- cvGetSeqElem pseq i + elem' <- peek elemP + return elem' + +-- seqToRectList :: Ptr (CvSeq (Ptr CvRect)) -> IO [CvRect] +-- seqToRectList pseq = do +-- numElems <- seqNumElems pseq +-- flip mapM [1..(numElems)] $ \i -> do +-- rectP <- cvGetSeqElemRect pseq i +-- rect <- peek rectP +-- return rect + +foreign import ccall unsafe "HOpenCV_warp.h c_cvRectangle" + c_cvRectangle :: Ptr CvArr -> CInt -> CInt -> CInt -> CInt -> IO () + +cvRectangle :: IplArrayType a => Ptr a -> CvRect -> IO () +cvRectangle dst (CvRect x y w h) = c_cvRectangle (fromArr dst) x y w h + +------------------------------------------------------------------------------ +-- Debugging stuff, not part of opencv + +-- | Debugging function to print some of the internal details of an IplImage structure +foreign import ccall unsafe "HOpenCV_warp.h debug_print_image_header" + c_debug_print_image_header :: Ptr IplImage -> IO () diff --git a/src/AI/CV/OpenCV/HOpenCV_wrap.c b/src/AI/CV/OpenCV/HOpenCV_wrap.c new file mode 100644 --- /dev/null +++ b/src/AI/CV/OpenCV/HOpenCV_wrap.c @@ -0,0 +1,146 @@ +#include +#include +#include + +#include + +void debug_print_image_header(IplImage *image) +{ + printf("IplImage: \n" + "\tnSize: %d\n" + "\tID: %d\n" + "\tnChannels: %d\n" + "\talphaChannel: %d\n" + "\tdepth: %d\n" + "\tdataOrder: %d\n" + "\torigin: %d\n" + "\talign: %d\n" + "\twidth: %d\n" + "\theight: %d\n" + "\timageSize: %d\n" + "\twidthStep: %d\n", + image->nSize, image->ID, image->nChannels, image->alphaChannel, + image->depth, image->dataOrder, image->origin, image->align, + image->width, image->height, image->imageSize, image->widthStep); +} + +/****************************************************************************/ + +void release_capture(CvCapture *capture) +{ + CvCapture *temp = capture; + cvReleaseCapture(&temp); +} + +/****************************************************************************/ + +void num_to_name(int num, char *name, int length) +{ + snprintf(name, length, "win-%d", num); +} + +void new_window(int num, int flags) +{ + char name[100]; + num_to_name(num, name, sizeof(name)); + cvNamedWindow(name, flags); +} + +void del_window(int num) +{ + char name[100]; + num_to_name(num, name, sizeof(name)); + cvDestroyWindow(name); +} + +void show_image(int num, IplImage *image) +{ + char name[100]; + num_to_name(num, name, sizeof(name)); + cvShowImage(name, image); +} + +/**********************************************************/ + +/* Haskell's FFI doesn't know how to pass structs by value, I think. */ +IplImage *create_image(int width, int height, int depth, int channels) +{ + return cvCreateImage(cvSize(width,height), depth, channels); +} + +void release_image(IplImage *image) +{ + IplImage *temp = image; + return cvReleaseImage(&temp); +} + +/* Notice that according to opencv docs, cvGetSize returns the ROI for images, not the image.width and .height */ +void get_size(const CvArr *arr, CvSize *size) +{ + *size = cvGetSize(arr); +} + +/* TODO instead of get_depth, get_nChannels maybe we should allow serialization of the IplImage struct itself, as we do + for CvSize? */ +int get_depth(const IplImage *image) +{ + return image->depth; +} + +int get_nChannels(const IplImage *image) +{ + return image->nChannels; +} + +void dilate(const CvArr *src, CvArr *dest, int iterations) +{ + cvDilate(src, dest, NULL, iterations); +} + +/**********************************************************/ + +void release_mem_storage(CvMemStorage *mem_store) +{ + CvMemStorage *temp = mem_store; + cvReleaseMemStorage(&temp); +} + +void cv_free(void *obj) +{ + void *temp = obj; + cvFree(&temp); +} + +/****************************************************************************/ + +int seq_total(const CvSeq *seq) { + return seq->total; +} + +/* 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. */ +/*CvRect *c_rect_cvGetSeqElem(const CvSeq *seq, int index) { + return CV_GET_SEQ_ELEM( CvRect, seq, index); + }*/ + + +void c_cvRectangle(CvArr *img, int x, int y, int width, int height) +{ + cvRectangle(img, cvPoint(x,y), + cvPoint((x+width), + (y+height)), + CV_RGB(255,0,0), 3 , 8, 0); +} + +/****************************************************************************/ + +CvSeq *c_cvHaarDetectObjects( const CvArr* image, + CvHaarClassifierCascade* cascade, + CvMemStorage* storage, double scale_factor, + int min_neighbors , int flags, + int width, int height) +{ + return cvHaarDetectObjects(image, cascade, storage, scale_factor, min_neighbors, flags, cvSize(width, height)); +} + diff --git a/src/AI/CV/OpenCV/HOpenCV_wrap.h b/src/AI/CV/OpenCV/HOpenCV_wrap.h new file mode 100644 --- /dev/null +++ b/src/AI/CV/OpenCV/HOpenCV_wrap.h @@ -0,0 +1,36 @@ +#include +#include + +void debug_print_image_header(IplImage *image); + +void release_capture(CvCapture *capture); + + +void new_window(int num, int flags); +void del_window(int num); +void show_image(int num, IplImage *image); + +IplImage *create_image(int width, int height, int depth, int channels); +void release_image(IplImage *image); + +void get_size(const CvArr *arr, CvSize *size); +int get_depth(const IplImage *image); +int get_nChannels(const IplImage *image); + +void dilate(const CvArr *src, CvArr *dest, int iterations); + +void release_mem_storage(CvMemStorage *mem_store); +void cv_free(void *obj); + +int seq_total(const CvSeq *seq); +/* CvRect *c_rect_cvGetSeqElem(const CvSeq *seq, int index); */ + +void c_cvRectangle(CvArr *img, int x, int y, int width, int height); + + +CvSeq *c_cvHaarDetectObjects( const CvArr* image, + CvHaarClassifierCascade* cascade, + CvMemStorage* storage, double scale_factor, + int min_neighbors , int flags, + int width, int height); + diff --git a/src/AI/CV/OpenCV/HighGui.hs b/src/AI/CV/OpenCV/HighGui.hs new file mode 100644 --- /dev/null +++ b/src/AI/CV/OpenCV/HighGui.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} + +module AI.CV.OpenCV.HighGui where + +import Foreign.ForeignPtrWrap +import Foreign.C.Types +import Foreign.Ptr +import Foreign.ForeignPtr + +import AI.CV.OpenCV.CxCore + + +------------------------------------------------ +-- General +foreign import ccall unsafe "highgui.h cvConvertImage" + c_cvConvertImage :: Ptr CvArr -> Ptr CvArr -> CInt -> IO () + +cvConvertImage :: (IplArrayType a, IplArrayType a1) => Ptr a -> Ptr a1 -> CInt -> IO () +cvConvertImage src dst flags = c_cvConvertImage (fromArr src) (fromArr dst) flags + +------------------------------------------------ +-- Capturing +data CvCapture + + +foreign import ccall unsafe "highgui.h cvCreateCameraCapture" + c_cvCreateCameraCapture :: CInt -> IO (Ptr CvCapture) + +cvCreateCameraCapture :: CInt -> IO (Ptr CvCapture) +cvCreateCameraCapture x = errorName "Failed to create camera" . checkPtr $ c_cvCreateCameraCapture . fromIntegral $ x + + +foreign import ccall unsafe "HOpenCV_warp.h release_capture" + cvReleaseCapture :: Ptr CvCapture -> IO () + +foreign import ccall unsafe "HOpenCV_warp.h &release_capture" + cp_release_capture :: FunPtr (Ptr CvCapture -> IO () ) + +createCameraCaptureF :: CInt -> IO (ForeignPtr CvCapture) +createCameraCaptureF = (createForeignPtr cp_release_capture) . cvCreateCameraCapture + + + +foreign import ccall unsafe "highgui.h cvQueryFrame" + c_cvQueryFrame :: Ptr CvCapture -> IO (Ptr IplImage) + +cvQueryFrame :: Ptr CvCapture -> IO (Ptr IplImage) +cvQueryFrame cap = errorName "Failed to query frame from camera" . checkPtr $ c_cvQueryFrame cap + +------------------------------------------------- +-- Windows +foreign import ccall unsafe "HOpenCV_wrap.h new_window" + c_newWindow :: CInt -> CInt -> IO () + +newWindow :: CInt -> Bool -> IO () +newWindow num autoSize = c_newWindow num (if autoSize then 1 else 0) + +foreign import ccall unsafe "HOpenCV_wrap.h del_window" + delWindow :: CInt -> IO () + +foreign import ccall unsafe "HOpenCV_wrap.h show_image" + showImage :: CInt -> Ptr IplImage -> IO () + +foreign import ccall unsafe "highgui.h cvWaitKey" + waitKey :: CInt -> IO CInt diff --git a/src/AI/CV/OpenCV/Types.hs b/src/AI/CV/OpenCV/Types.hs new file mode 100644 --- /dev/null +++ b/src/AI/CV/OpenCV/Types.hs @@ -0,0 +1,16 @@ +module AI.CV.OpenCV.Types where + + +import AI.CV.OpenCV.CxCore +import AI.CV.OpenCV.HighGui + +import Foreign +import Foreign.ForeignPtr + + + +type PImage = Ptr IplImage +type PCapture = Ptr CvCapture + +type FPImage = ForeignPtr IplImage +type FPCapture = ForeignPtr CvCapture diff --git a/src/Foreign/ForeignPtrWrap.hs b/src/Foreign/ForeignPtrWrap.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/ForeignPtrWrap.hs @@ -0,0 +1,29 @@ +module Foreign.ForeignPtrWrap where + +import Foreign.Ptr +import Foreign.ForeignPtr + +import System.IO.Error + +-- A wrapper for newForeignPtr that handles nullPtrs, and can be chained to an IO Ptr creator. +-- usage: +-- myPtrCreator = (createForeignPtr deallocFunc) . allocFunc +-- where, allocFunc :: a->b->c->...-> IO (Ptr z) +createForeignPtr :: (FunPtr (Ptr a -> IO () )) -> IO (Ptr a) -> IO (ForeignPtr a) +createForeignPtr dealloc allocedPtr = do + ptr <- checkPtr allocedPtr + newForeignPtr dealloc ptr + + +checkPtr :: IO (Ptr a) -> IO (Ptr a) +checkPtr x = do + res <- x + if res /= nullPtr + then return res + else fail "Null Pointer" + +------------------------------------------------ +errorName :: String -> IO a -> IO a +errorName = modifyIOError . const . userError + + diff --git a/src/Test.hs b/src/Test.hs new file mode 100644 --- /dev/null +++ b/src/Test.hs @@ -0,0 +1,40 @@ +module Main where + +import Foreign.Ptr +import Foreign.ForeignPtr +import Foreign.C.Types + +import AI.CV.OpenCV.CxCore +import AI.CV.OpenCV.CV +import AI.CV.OpenCV.HighGui + +import Control.Monad(when) + +showFrames :: CInt -> Ptr IplImage -> Ptr CvCapture -> IO () +showFrames winNum targetImage cvcapture = do + frame <- cvQueryFrame cvcapture + cvConvertImage (fromArr frame) (fromArr targetImage) 0 + calcFrame targetImage + where calcFrame targetSmall = do + cvResize targetImage targetSmall CV_INTER_LINEAR + cvCanny targetSmall targetSmall 30 190 3 + showImage winNum targetSmall + key <- waitKey 5 + when (key == -1) (showFrames winNum targetImage cvcapture) + + +processImages :: Ptr CvCapture -> IO () +processImages capture = do + frame <- cvQueryFrame capture + let winNum = 0 + newWindow winNum True + target <- createImageF (cvGetSize frame) 1 iplDepth8u + withForeignPtr target $ (\target' -> showFrames winNum target' capture) + +main :: IO () +main = do + capture <- createCameraCaptureF 0 + withForeignPtr capture processImages + + +