diff --git a/HOpenCV.cabal b/HOpenCV.cabal --- a/HOpenCV.cabal +++ b/HOpenCV.cabal @@ -1,5 +1,5 @@ name: HOpenCV -version: 0.3.0.1 +version: 0.4.0.0 license: GPL-2 maintainer: Noam Lewis bug-reports: mailto:jones.noamle@gmail.com diff --git a/demo/cannyVideo.hs b/demo/cannyVideo.hs --- a/demo/cannyVideo.hs +++ b/demo/cannyVideo.hs @@ -6,15 +6,20 @@ showFrames :: String -> IplImage -> Capture -> IO () showFrames win target cap = do - frame <- queryFrame cap - convertImage frame target 0 - canny target target 30 190 3 - showImage win target - k <- waitKey 5 - when (isNothing k) $ showFrames win target cap + let step 0 = return () + step n = do + frame <- queryFrame cap + convertImage frame target 0 + canny target target 30 190 3 + showImage win target + k <- waitKey 5 + putStr $ "\r" ++ show n ++ "\t\t frames before exiting...\r" + when (isNothing k) $ step (n - 1) + step 100 main :: IO () main = do + putStrLn "Running..." let win = "win" namedWindow win autoSize cap <- createCameraCapture 0 diff --git a/src/AI/CV/OpenCV/CxCore.hsc b/src/AI/CV/OpenCV/CxCore.hsc --- a/src/AI/CV/OpenCV/CxCore.hsc +++ b/src/AI/CV/OpenCV/CxCore.hsc @@ -54,7 +54,7 @@ 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) @@ -69,8 +69,8 @@ (#poke CvRect, y) ptr y (#poke CvRect, width) ptr w (#poke CvRect, height) ptr h - + liftCvRect :: (RealFrac c, Num b) => (b -> c) -> CvRect -> CvRect liftCvRect f (CvRect x y w h) = CvRect (f' x) (f' y) (f' w) (f' h) where f' = toFromIntegral f @@ -87,7 +87,7 @@ instance VectorSpace CvRect where type Scalar CvRect = Double -- todo: use CInt instead of Double here? a *^ r = liftCvRect (a*) r - + ------------------------------------------------------ {- data Priv_CvArr @@ -103,10 +103,10 @@ data Priv_CvSeq a type CvSeq a = ForeignPtr (Priv_CvSeq a) -newtype Depth = Depth { unDepth :: CInt } +newtype Depth = Depth { unDepth :: CInt } deriving (Eq, Show) - -#{enum Depth, Depth + +#{enum Depth, Depth , iplDepth1u = IPL_DEPTH_1U , iplDepth8u = IPL_DEPTH_8U , iplDepth8s = IPL_DEPTH_8S @@ -115,7 +115,7 @@ , iplDepth32s = IPL_DEPTH_32S , iplDepth32f = IPL_DEPTH_32F , iplDepth64f = IPL_DEPTH_64F -} +} validDepths :: [Depth] validDepths = [iplDepth1u, iplDepth8u, iplDepth8s, iplDepth16u, iplDepth16s, iplDepth32s, iplDepth32f, iplDepth64f] @@ -125,7 +125,7 @@ numToDepth :: CInt -> Maybe Depth numToDepth x = lookup x depthsLookupList - + --------------------------------------------------------------- -- mem storage @@ -135,15 +135,9 @@ foreign import ccall unsafe "HOpenCV_wrap.h &release_mem_storage" cf_releaseMemStorage :: FunPtr (Ptr Priv_CvMemStorage -> IO ()) -foreign import ccall unsafe "HOpenCV_wrap.h release_mem_storage" - c_releaseMemStorage :: Ptr Priv_CvMemStorage -> IO () - -releaseMemStorage :: MemStorage -> IO () -releaseMemStorage memstorage = withForeignPtr memstorage c_releaseMemStorage - createMemStorage :: Int -> IO MemStorage -createMemStorage i - = do p <- errorName "Failed to create mem storage" +createMemStorage i + = do p <- errorName "Failed to create mem storage" . checkPtr . c_cvCreateMemStorage $ fromIntegral i newForeignPtr cf_releaseMemStorage p @@ -158,19 +152,13 @@ createImage :: CvSize -> Depth -> Int -> IO IplImage createImage size depth numChans - = do im <- errorName "Failed to create image" . checkPtr + = do im <- errorName "Failed to create image" . checkPtr $ c_cvCreateImage (sizeWidth size) (sizeHeight size) (unDepth depth) (fromIntegral numChans) fp <- newForeignPtr cvFree im return fp -foreign import ccall unsafe "HOpenCV_wrap.h release_image" - c_releaseImage :: Ptr Priv_IplImage -> IO () - -releaseImage :: IplImage -> IO () -releaseImage image = withForeignPtr image c_releaseImage - -- foreign import ccall unsafe "HOpenCV_wrap.h &release_image" -- cp_release_image :: FunPtr (Ptr Priv_IplImage -> IO ()) @@ -180,17 +168,17 @@ cloneImage :: IplImage -> IO IplImage cloneImage p - = do p' <- errorName "Failed to clone image" . checkPtr + = do p' <- errorName "Failed to clone image" . checkPtr $ withForeignPtr p c_cvCloneImage fp <- newForeignPtr cvFree p' - return fp - + return fp + foreign import ccall unsafe "HOpenCV_wrap.h get_size" c_get_size :: Ptr Priv_IplImage -> Ptr CvSize -> IO () foreign import ccall unsafe "cxcore.h cvCopy" c_cvCopy :: Ptr Priv_IplImage -> Ptr Priv_IplImage -> Ptr Priv_IplImage -> IO () - + -- todo add mask support copy :: IplImage -> IplImage -> IO () copy src dst @@ -225,7 +213,7 @@ getDepth :: IplImage -> IO Depth getDepth img = do - depthInt <- withForeignPtr img c_get_depth + depthInt <- withForeignPtr img c_get_depth case numToDepth depthInt of Nothing -> fail "Bad depth in image struct" Just depth -> return depth @@ -272,16 +260,16 @@ $ c_cvLoad filenameC mem' nameC ptrRealNameC ptrObj <- withForeignPtr mem g realNameC <- peek ptrRealNameC - realName <- if realNameC == nullPtr - then return Nothing + realName <- if realNameC == nullPtr + then return Nothing else fmap Just $ peekCString realNameC -- cvFree realNameC fp <- newForeignPtr cvFree ptrObj return (fp, realName) - + foreign import ccall unsafe "cxcore.h cvGetSeqElem" cvGetSeqElem :: Ptr (Priv_CvSeq a) -> CInt -> IO (Ptr a) - + -- foreign import ccall unsafe "HOpenCV_wrap.h c_rect_cvGetSeqElem" -- cvGetSeqElemRect :: Ptr (CvSeq (Ptr CvRect)) -> CInt -> IO (Ptr CvRect) @@ -308,7 +296,7 @@ -- seqToRectList :: Ptr (CvSeq (Ptr CvRect)) -> IO [CvRect] -- seqToRectList pseq = do --- numElems <- withForeignPtr pseq seqNumElems +-- numElems <- withForeignPtr pseq seqNumElems -- flip mapM [1..(numElems)] $ \i -> do -- rectP <- cvGetSeqElemRect pseq i -- rect <- peek rectP diff --git a/src/AI/CV/OpenCV/HighGui.hsc b/src/AI/CV/OpenCV/HighGui.hsc --- a/src/AI/CV/OpenCV/HighGui.hsc +++ b/src/AI/CV/OpenCV/HighGui.hsc @@ -1,7 +1,7 @@ {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} - + module AI.CV.OpenCV.HighGui where - + import Control.Monad import Foreign.ForeignPtrWrap import Foreign.C.Types @@ -10,7 +10,7 @@ import Foreign.C.String import Foreign.Marshal import Foreign.Storable - + import AI.CV.OpenCV.CxCore import AI.CV.OpenCV.Util @@ -35,7 +35,7 @@ foreign import ccall unsafe "highgui.h cvCreateCameraCapture" c_cvCreateCameraCapture :: CInt -> IO (Ptr Priv_CvCapture) - + -- | self-documenting camera specification pickAnyCam :: Int pickAnyCam = -1 @@ -48,27 +48,20 @@ createCameraCapture x = do p <- errorName "Failed to create camera" . checkPtr $ c_cvCreateCameraCapture . fromIntegral $ x newForeignPtr cp_release_capture p - + foreign import ccall unsafe "highgui.h cvCreateFileCapture" c_cvCreateFileCapture :: CString -> IO (Ptr Priv_CvCapture) - + createFileCapture :: String -> IO Capture createFileCapture filename = do c <- err' . checkPtr $ withCString filename f newForeignPtr cp_release_capture c where err' = errorName $ "Failed to capture from file: '" ++ filename ++ "'" f filenameC = c_cvCreateFileCapture filenameC - -foreign import ccall unsafe "HOpenCV_wrap.h release_capture" - c_releaseCapture :: Ptr Priv_CvCapture -> IO () - -releaseCapture :: Capture -> IO () -releaseCapture cap = withForeignPtr cap c_releaseCapture - foreign import ccall unsafe "HOpenCV_wrap.h &release_capture" cp_release_capture :: FunPtr (Ptr Priv_CvCapture -> IO ()) - + foreign import ccall unsafe "highgui.h cvQueryFrame" c_cvQueryFrame :: Ptr Priv_CvCapture -> IO (Ptr Priv_IplImage) @@ -103,7 +96,7 @@ destroyWindow :: String -> IO () destroyWindow wId - = withCString wId cvDestroyWindow + = withCString wId cvDestroyWindow foreign import ccall unsafe "highgui.h cvShowImage" cvShowImage :: CString -> Ptr Priv_IplImage -> IO () @@ -135,7 +128,7 @@ loadImage :: String -> LoadImageColor -> IO IplImage loadImage filename (LoadImageColor color) - = do i <- err' . checkPtr $ withCString filename + = do i <- err' . checkPtr $ withCString filename $ \fn -> c_cvLoadImage fn color fp <- newForeignPtr cvFree i return fp @@ -164,7 +157,7 @@ createTrackbar trackbarName winName startPosition maxValue = withCString trackbarName $ \tb -> withCString winName $ \wn -> - alloca $ \sp -> + alloca $ \sp -> do maybeToPtr sp startPosition wrap_createTrackbar tb wn sp (fromIntegral maxValue) where