packages feed

HOpenCV (empty) → 0.1

raw patch · 10 files changed

+698/−0 lines, 10 filesdep +MaybeTdep +basedep +containerssetup-changed

Dependencies added: MaybeT, base, containers, mtl

Files

+ HOpenCV.cabal view
@@ -0,0 +1,42 @@+name: HOpenCV+version: 0.1+license: BSD3+maintainer: Noam Lewis <jones.noamle@gmail.com>+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++
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/AI/CV/OpenCV/CV.hsc view
@@ -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 <cv.h>+++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)+
+ src/AI/CV/OpenCV/CxCore.hsc view
@@ -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 <cxcore.h>++------------------------------------------------------++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 ()
+ src/AI/CV/OpenCV/HOpenCV_wrap.c view
@@ -0,0 +1,146 @@+#include <cxcore.h>+#include <cv.h>+#include <highgui.h>++#include <stdio.h>++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));+}+
+ src/AI/CV/OpenCV/HOpenCV_wrap.h view
@@ -0,0 +1,36 @@+#include <cv.h>+#include <cxcore.h>++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);+
+ src/AI/CV/OpenCV/HighGui.hs view
@@ -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
+ src/AI/CV/OpenCV/Types.hs view
@@ -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
+ src/Foreign/ForeignPtrWrap.hs view
@@ -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++
+ src/Test.hs view
@@ -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+++