cv-combinators 0.1.2.1 → 0.1.2.2

raw patch · 6 files changed

+155/−371 lines, 6 filesdep +SDLdep +allocated-processordep +graphics-drawingcombinatorsdep ~HOpenCVdep ~basenew-component:exe:test-cv-combinators2PVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: SDL, allocated-processor, graphics-drawingcombinators, vector-space

Dependency ranges changed: HOpenCV, base

API changes (from Hackage documentation)

Files

• cv-combinators.cabal +13/−7
• src/AI/CV/ImageProcessors.hs +13/−16
• src/AI/CV/Processor.hs +0/−344
• src/Graphics/GraphicsProcessors.hs +43/−0
• src/IntegratedTest.hs +82/−0
• src/Test.hs +4/−4

@@ -1,5 +1,5 @@ name: cv-combinators-version: 0.1.2.1+version: 0.1.2.2 license: BSD3 maintainer: Noam Lewis <jones.noamle@gmail.com> bug-reports: mailto:jones.noamle@gmail.com@@ -8,7 +8,7 @@ description:    Initial version; using the "HOpenCV" package as a backend.    .-   Provides a functional combinator library, naturally expressed as Arrow instances (but also Category, Functor and Applicative). +   Provides a functional combinator library for computer vision, based on the "allocated-processor" package.    .    Online documentation, if not built below, can be found at <http://www.ee.bgu.ac.il/~noamle/>.    .@@ -21,20 +21,26 @@ Tested-With:   GHC == 6.10.4  library-   exposed-modules: AI.CV.Processor,-                    AI.CV.ImageProcessors+   exposed-modules: AI.CV.ImageProcessors    hs-Source-Dirs: src-   build-depends: base >= 3 && < 5, HOpenCV >= 0.1.2+   build-depends: base >=4 && <5, HOpenCV >= 0.1.2.1, allocated-processor, vector-space    ghc-options: -Wall  executable test-cv-combinators   hs-source-dirs:  src-  Build-Depends: base >= 4+  Build-Depends: base >=4 && <5, HOpenCV >= 0.1.2.1, allocated-processor, vector-space   main-is: Test.hs   Ghc-Options: -Wall    Ghc-Prof-Options:  -prof -auto-all -  other-modules: AI.CV.Processor, AI.CV.ImageProcessors+  other-modules: AI.CV.ImageProcessors +executable test-cv-combinators2+  hs-source-dirs:  src+  Build-Depends: base >=4 && <5, HOpenCV >= 0.1.2.1, allocated-processor, SDL, graphics-drawingcombinators, vector-space+  main-is: IntegratedTest.hs+  Ghc-Options: -Wall +  Ghc-Prof-Options:  -prof -auto-all +  other-modules: AI.CV.ImageProcessors, Graphics.GraphicsProcessors  -- source-repository head --  type: git

@@ -46,7 +46,7 @@      runTill, runTillKeyPressed, keyPressed) where  -import AI.CV.Processor+import Control.Processor(runUntil, IOSink, IOSource, IOProcessor, processor)  import AI.CV.OpenCV.Types(PImage) import qualified AI.CV.OpenCV.CV as CV@@ -55,7 +55,7 @@ import AI.CV.OpenCV.CxCore(IplImage, CvSize, CvRect, CvMemStorage) import AI.CV.OpenCV.CV(CvHaarClassifierCascade) -import Foreign.Ptr+import Foreign.Ptr(Ptr)   type Image = PImage@@ -71,8 +71,7 @@  -- | Predicate for pressed keys keyPressed :: Show a => a -> IO Bool-keyPressed _ = do-  fmap (/= -1) $ HighGui.waitKey 3+keyPressed _ = fmap (/= -1) $ HighGui.waitKey 3 -- todo wrap waitKey more generally for the API  -- | Runs the processor until a predicate is true, for predicates, and processors that take () as input -- (such as chains that start with a camera).@@ -81,7 +80,7 @@  -- | Name (and type) says it all. runTillKeyPressed :: (Show a) => IOProcessor () a -> IO ()-runTillKeyPressed f = (f `runTill` keyPressed) >> (return ())+runTillKeyPressed f = f `runTill` keyPressed >> (return ())  ------------------------------------------------------------------ capture :: IO (Ptr HighGui.CvCapture) -> ImageSource@@ -89,7 +88,7 @@     where processQueryFrame :: () -> (Ptr CxCore.IplImage, Ptr HighGui.CvCapture)                                 -> IO (Ptr CxCore.IplImage, Ptr HighGui.CvCapture)           processQueryFrame _ (_, cap) = do-            newFrame <- HighGui.cvQueryFrame $ cap+            newFrame <- HighGui.cvQueryFrame cap             return (newFrame, cap)                      allocateCamera :: () -> IO (Ptr CxCore.IplImage, Ptr HighGui.CvCapture)@@ -98,11 +97,9 @@             newFrame <- HighGui.cvQueryFrame cap             return (newFrame, cap)           -          fromState (image, _) = do -            return image+          fromState (image, _) = return image           -          releaseNext (_, cap) = do-            HighGui.cvReleaseCapture $ cap+          releaseNext (_, cap) = HighGui.cvReleaseCapture cap   -- | A capture device, using OpenCV's HighGui lib's cvCreateCameraCapture@@ -120,9 +117,9 @@ -- | A window that displays images. -- Note: windows with the same index will be the same window....is this ok? window :: Int -> ImageSink-window num = processor procFunc allocFunc (do return) (do return)+window num = processor procFunc allocFunc return return     where procFunc :: (Image -> () -> IO ())-          procFunc src x = (HighGui.showImage (fromIntegral num) src) >> (return x)+          procFunc src x = HighGui.showImage (fromIntegral num) src >> return x                      allocFunc :: (Image -> IO ())           allocFunc _ = HighGui.newWindow (fromIntegral num) True@@ -131,7 +128,7 @@ -- | A convenience function for constructing a common type of processors that work exclusively on images imageProcessor :: (Image -> Image -> IO Image) -> (Image -> IO Image)                 -> ImageProcessor-imageProcessor procFunc allocFunc = processor procFunc allocFunc (do return) (CxCore.cvReleaseImage)+imageProcessor procFunc allocFunc = processor procFunc allocFunc return CxCore.cvReleaseImage  -- | OpenCV's cvResize resize :: Int -- Width@@ -172,7 +169,7 @@             gray <- CxCore.cvCreateImage (CxCore.cvGetSize src) 1 CxCore.iplDepth8u             return (gray, target)             -          convertState = do return . snd+          convertState = return . snd                                        releaseState (gray, target) = do             CxCore.cvReleaseImage gray@@ -202,7 +199,7 @@             print name -- todo verify that this is a haar cascade             return ([], (cascade, storage))           -          convFunc = do return . fst+          convFunc = return . fst                      freeFunc (_, (_, storage)) = do             CxCore.cvReleaseMemStorage storage@@ -216,7 +213,7 @@              -- | OpenCV's cvRectangle, currently without width, color or line type control drawRects :: IOProcessor (Image, [CvRect]) Image-drawRects = processor procFunc (CxCore.cvCloneImage . fst) (do return) CxCore.cvReleaseImage+drawRects = processor procFunc (CxCore.cvCloneImage . fst) return CxCore.cvReleaseImage     where procFunc (src,rects) dst = do             CxCore.cvCopy src dst             mapM_ (CxCore.cvRectangle dst) rects

@@ -1,344 +0,0 @@-{-# LANGUAGE RankNTypes, GADTs, NoMonomorphismRestriction #-}--- | --- Module      : AI.CV.Processor--- Copyright   : (c) Noam Lewis, 2010--- License     : BSD3------ Maintainer  : Noam Lewis <jones.noamle@gmail.com>--- Stability   : experimental--- Portability : tested on GHC only------ Framework for expressing IO actions that require initialization and finalizers.--- This module provides a *functional* interface for defining and chaining a series of processors.------ Motivating example: bindings to C libraries that use functions such as: f(foo *src, foo *dst),--- where the pointer `dst` must be pre-allocated. In this case we normally do:------   > foo *dst = allocateFoo();---   > ... ---   > while (something) {---   >    f(src, dst);---   >    ...---   > }---   > releaseFoo(dst);------ You can use the 'runUntil' function below to emulate that loop.------ Processor is an instance of Category, Functor, Applicative and Arrow. ------ In addition to the general type @'Processor' m a b@, this module also defines the semantic model--- for @'Processor' IO a b@, which has synonym @'IOProcessor' a b@.--module AI.CV.Processor where--import Prelude hiding ((.),id)--import Control.Category-import Control.Applicative hiding (empty)-import Control.Arrow--import Control.Monad(liftM, join)---- | The type of Processors------    * a, b = the input and output types of the processor (think a -> b)------    * x = type of internal state (existentially quantified)------ The arguments to the constructor are:------    1. Processing function: Takes input and internal state, and returns new internal state.------    2. Allocator for internal state (this is run only once): Takes (usually the first) input, and returns initial internal state.------    3. Convertor from state x to output b: Takes internal state and returns the output.------    4. Releaser for internal state (finalizer, run once): Run after processor is done being used, to release the internal state.----data Processor m a b where-    Processor :: Monad m => (a -> x -> m x) -> (a -> m x) -> (x -> m b) -> (x -> m ()) -> (Processor m a b)-    --- | The semantic model for 'IOProcessor' is a function:------ > [[ 'IOProcessor' a b ]] = a -> b------ And the following laws:------    1. The processing function (@a -> x -> m x@) must act as if purely, so that indeed for a given input the---       output is always the same. One particular thing to be careful with is that the output does not depend---       on time (for example, you shouldn't use IOProcessor to implement an input device). The @IOSource@ type---       is defined exactly for time-dependent processors. For pointer typed inputs and outputs, see next law.------    2. For processors that work on pointers, @[[ Ptr t ]] = t@. This is guaranteed by the following---       implementation constraints for @IOProcessor a b@:------       1. If `a` is a pointer type (@a = Ptr p@), then the processor must NOT write (modify) the referenced data.------       2. If `b` is a pointer, the memory it points to (and its allocation status) is only allowed to change---          by the processor that created it (in the processing and releasing functions). In a way this---          generalizes the first constraint.------ Note, that unlike "Yampa", this model does not allow transformations of the type @(Time -> a) -> (Time ->--- b)@. The reason is that I want to prevent arbitrary time access (whether causal or not). This limitation--- means that everything is essentially "point-wise" in time. To allow memory-full operations under this--- model, 'scanlT' is defined. See <http://www.ee.bgu.ac.il/~noamle/_downloads/gaccum.pdf> for more about--- arbitrary time access.-type IOProcessor a b = Processor IO a b---- | @'IOSource' a b@ is the type of time-dependent processors, such that:------ > [[ 'IOSource' a b ]] = (a, Time) -> b------ Thus, it is ok to implement a processing action that outputs arbitrary time-dependent values during runtime--- regardless of input. (Although the more useful case is to calculate something from the input @a@ that is--- also time-dependent. The @a@ input is often not required and in those cases @a = ()@ is used.------ Notice that this means that IOSource doesn't qualify as an 'IOProcessor'. However, currently the--- implementation /does NOT/ enforce this, i.e. IOSource is not a newtype; I don't know how to implement it--- correctly. Also, one question is whether primitives like "chain" will have to disallow placing 'IOSource'--- as the second element in a chain. Maybe they should, maybe they shouldn't.-type IOSource a b = Processor IO a b---- | TODO: What's the semantic model for @'IOSink' a@?-type IOSink a = IOProcessor a ()---- | TODO: do we need this? we're exporting the data constructor anyway for now, so maybe we don't.-processor :: Monad m =>-             (a -> x -> m x) -> (a -> m x) -> (x -> m b) -> (x -> m ())-          -> Processor m a b-processor = Processor---- | Chains two processors serially, so one feeds the next.-chain :: Processor m a b'  -> Processor m b' b -> Processor m a b-chain (Processor pf1 af1 cf1 rf1) (Processor pf2 af2 cf2 rf2) = processor pf3 af3 cf3 rf3-    where pf3 a (x1,x2) = do-            x1' <- pf1 a x1-            b'  <- cf1 x1-            x2' <- pf2 b' x2-            return (x1', x2')-            -          af3 a = do-            x1 <- af1 a-            b' <- cf1 x1-            x2 <- af2 b'-            return (x1,x2)-            -          cf3 (_,x2) = do-            b <- cf2 x2-            return b-            -          rf3 (x1,x2) = do-            rf2 x2-            rf1 x1-  --- | A processor that represents two sub-processors in parallel (although the current implementation runs them--- sequentially, but that may change in the future)-parallel :: Processor m a b -> Processor m c d -> Processor m (a,c) (b,d)-parallel (Processor pf1 af1 cf1 rf1) (Processor pf2 af2 cf2 rf2) = processor pf3 af3 cf3 rf3-    where pf3 (a,c) (x1,x2) = do-            x1' <- pf1 a x1-            x2' <- pf2 c x2-            return (x1', x2')-            -          af3 (a,c) = do-            x1 <- af1 a-            x2 <- af2 c-            return (x1,x2)-            -          cf3 (x1,x2) = do-            b  <- cf1 x1-            d <- cf2 x2-            return (b,d)-            -          rf3 (x1,x2) = do-            rf2 x2-            rf1 x1---- | Constructs a processor that: given two processors, gives source as input to both processors and runs them--- independently, and after both have have finished, outputs their combined outputs.--- --- Semantic meaning, using Arrow's (&&&) operator:--- [[ forkJoin ]] = &&& --- Or, considering the Applicative instance of functions (which are the semantic meanings of a processor):--- [[ forkJoin ]] = liftA2 (,)--- Alternative implementation to consider: f &&& g = (,) <&> f <*> g-forkJoin :: Processor m a b  -> Processor m a b' -> Processor m a (b,b')-forkJoin (Processor pf1 af1 cf1 rf1) (Processor pf2 af2 cf2 rf2) = processor pf3 af3 cf3 rf3-    where --pf3 :: a -> (x1,x2) -> m (x1,x2)-          pf3 a (x1,x2) = do-            x1' <- pf1 a x1-            x2' <- pf2 a x2-            return (x1', x2')-            -          --af3 :: a -> m (x1, x2)-          af3 a = do-            x1 <- af1 a-            x2 <- af2 a-            return (x1,x2)-          -          --cf3 :: (x1,x2) -> m (b,b')-          cf3 (x1,x2) = do-            b <- cf1 x1-            b' <- cf2 x2-            return (b,b')-          -          --rf3 :: (x1,x2) -> m ()-          rf3 (x1,x2) = rf2 x2 >> rf1 x1------------------------------------------------------------------- | The identity processor: output = input. Semantically, [[ empty ]] = id-empty :: Monad m => Processor m a a-empty = processor pf af cf rf-    where pf _ = do return-          af   = do return-          cf   = do return-          rf _ = do return ()-               -instance Monad m => Category (Processor m) where-  (.) = flip chain-  id  = empty-  -instance Monad m => Functor (Processor m a) where-  -- |-  -- > [[ fmap ]] = (.)-  ---  -- This could have used fmap internally as a Type Class Morphism, but monads-  -- don't neccesary implement the obvious: fmap = liftM.-  fmap f (Processor pf af cf rf) = processor pf af cf' rf-    where cf' x = liftM f (cf x) --instance Monad m => Applicative (Processor m a) where-  -- | -  -- > [[ pure ]] = const-  pure b = processor pf af cf rf-    where pf _ = do return-          af _ = do return ()-          cf _ = do return b-          rf _ = do return ()-            -  -- |-  -- [[ pf <*> px ]] = \a -> ([[ pf ]] a) ([[ px ]] a)-  -- (same as '(<*>)' on functions)-  (<*>) (Processor pf af cf rf) (Processor px ax cx rx) = processor py ay cy ry-    where py a (stateF, stateX) = do-            f' <- pf a stateF-            x' <- px a stateX-            return (f', x')-            -          ay a = do-            stateF <- af a-            stateX <- ax a-            return (stateF, stateX)-            -          -- this is the only part that seems specific to <*>-          cy (stateF, stateX) = do-            b2c <- cf stateF-            b <- cx stateX-            return (b2c b)-            -          ry (stateF, stateX) = do-            rx stateX-            rf stateF-  --- | A few tricks by Saizan from #haskell to perhaps use here:---  first f = (,) <$> (arr fst >>> f) <*> arr snd---  arr f = f <$> id---  f *** g = (arr fst >>> f) &&& (arr snd >>> g)-instance Monad m => Arrow (Processor m) where-  arr = flip liftA id-  (&&&) = forkJoin-  (***) = parallel-  first = (*** id)-  second = (id ***)-  ------------------------------------------------------------------- | Splits (duplicates) the output of a functor, or on this case a processor.-split :: Functor f => f a -> f (a,a)-split = (join (,) <$>)---- | 'f --< g' means: split f and feed it into g. Useful for feeding parallelized (***'d) processors.--- For example, a --< (b *** c) = a >>> (b &&& c)-(--<) :: (Functor (cat a), Category cat) => cat a a1 -> cat (a1, a1) c -> cat a c-f --< g = split f >>> g-infixr 1 --<-----------------------------------------------------------------            --- | Runs the processor once: allocates, processes, converts to output, and deallocates.-run :: Monad m => Processor m a b -> a -> m b-run = runWith id---- | Keeps running the processing function in a loop until a predicate on the output is true.--- Useful for processors whose main function is after the allocation and before deallocation.-runUntil :: Monad m => Processor m a b -> a -> (b -> m Bool) -> m b-runUntil (Processor pf af cf rf) a untilF = do-  x <- af a-  let repeatF y = do-        y' <- pf a y-        b <- cf y'-        b' <- untilF b-        if b' then return b else repeatF y'-  d <- repeatF x-  rf x-  return d----- | Runs the processor once, but passes the processing + conversion action to the given function.-runWith :: Monad m => (m b -> m b') -> Processor m a b -> a -> m b'-runWith f (Processor pf af cf rf) a = do-        x <- af a-        b' <- f (pf a x >>= cf)-        rf x-        return b'-----------------------------------------------------------------type DTime = Double--type Clock m = m Double---- | scanlT provides the primitive for performing memory-full operations on time-dependent processors, as described in <http://www.ee.bgu.ac.il/~noamle/_downloads/gaccum.pdf>.------ /Untested/.-scanlT :: Clock IO -> (b -> b -> DTime -> c -> c) -> c -> IOSource a b -> IOSource a c-scanlT clock transFunc initOut (Processor pf af cf rf) = processor procFunc allocFunc convFunc releaseFunc-    where procFunc curIn' (prevIn, prevTime, prevOut, x) = do-            x' <- pf curIn' x-            curIn <- cf x'-            curTime <- clock-            let dtime = curTime - prevTime-                curOut = transFunc prevIn curIn dtime prevOut-            return (curIn, curTime, curOut, x')-          -          allocFunc firstIn' = do-            x <- af firstIn'-            firstIn <- cf x-            curTime <- clock-            return (firstIn, curTime, initOut, x)-          -          convFunc (_, _, curOut, _) = return curOut-          -          releaseFunc (_, _, _, x') = rf x'-          -          --- | Differentiate using scanlT. TODO: test, and also generalize for any monad (trivial change of types).-differentiate :: (Real b) => Clock IO -> IOSource a b -> IOSource a Double-differentiate clock = scanlT clock diffFunc 0-    where diffFunc y' y dt _ = (realToFrac (y' - y)) / dt -- horrible approximation!-          -integrate :: (Real b) => Clock IO -> IOSource a b -> IOSource a Double-integrate clock p = scanlT clock intFunc 0 p-    where intFunc y' y dt prevSum = prevSum + (realToFrac (y' + y)) * dt / 2 -- horrible approximation!--max_ :: Ord b => Clock IO -> b -> IOSource a b -> IOSource a b-max_ clock minVal = scanlT clock maxFunc minVal-    where maxFunc y' y _ _ = max y' y-          -min_ :: Ord b => Clock IO -> b -> IOSource a b -> IOSource a b-min_ clock maxVal = scanlT clock minFunc maxVal-    where minFunc y' y _ _ = min y' y-

@@ -0,0 +1,43 @@++--------------------------------------------------------------+-- | +-- Module      : AI.CV.ImageProcessors+-- Copyright   : (c) Noam Lewis 2010+-- License     : BSD3+--+-- Maintainer  : Noam Lewis <jones.noamle@gmail.com>+-- Stability   : experimental+-- Portability : tested on GHC only+--+--------------------------------------------------------------+module Graphics.GraphicsProcessors where+++import Control.Processor+import qualified Graphics.DrawingCombinators as Draw+import qualified Graphics.UI.SDL as SDL++type DrawRenderer a = IOSink (Draw.Image a)+++------------------------------------------------------------------+-- | A window that displays images.+sdlWindow :: Int -> Int -> DrawRenderer a+sdlWindow width height = processor procFunc allocFunc return return+    where procFunc :: (Draw.Image a -> () -> IO ())+          procFunc image _ = do+            Draw.clearRender image >> SDL.glSwapBuffers+            return ()+          +          allocFunc :: (Draw.Image a -> IO ())+          allocFunc firstImage = do+            -- TODO: doh, this is global state! the processor should handle individual windows.+            SDL.init [SDL.InitTimer, SDL.InitVideo]+            -- resolution & color depth+            SDL.setVideoMode width height 32 [SDL.OpenGL]+            Draw.clearRender firstImage +            SDL.glSwapBuffers+            return ()+++

@@ -0,0 +1,82 @@+{-# LANGUAGE FlexibleContexts #-}++module Main where+++import qualified AI.CV.ImageProcessors as IP++import qualified Graphics.DrawingCombinators as Draw+import Graphics.DrawingCombinators((%%))+import qualified Graphics.GraphicsProcessors as GP++import qualified AI.CV.OpenCV.CV as CV+import qualified Control.Processor as Processor+import Control.Processor(DTime, DClock, scanlT, IOSource, IOProcessor)+import AI.CV.OpenCV.CxCore(CvRect(..), CvSize(..))++import Data.VectorSpace((*^), zeroV, (^+^), Scalar, VectorSpace)++import Prelude hiding ((.),id)+import Control.Arrow+import Control.Category+import Data.Monoid++resX, resY :: Num a => a+resX = 160+resY = 120++resizer :: IP.ImageProcessor+resizer = IP.resize resX resY CV.CV_INTER_LINEAR++faceDetect :: IOProcessor IP.Image [CvRect]+faceDetect = IP.haarDetect "/usr/share/opencv/haarcascades/haarcascade_frontalface_alt.xml" 1.1 3 CV.cvHaarFlagNone (CvSize 20 20)+  +captureDev :: IP.ImageSource+--captureDev = videoFile "/tmp/video.flv" -- Many formats are supported, not just flv (FFMPEG-based, normally).++-- If you have a webcam, uncomment this, and comment the other definition.+captureDev = IP.camera 0++square :: Draw.Image Any+square = Draw.rotate (pi/4) %% Draw.regularPoly (4 :: Int)++drawCvRect :: CvRect -> Draw.Image Any+drawCvRect (CvRect x y w h) = tr %% Draw.tint (Draw.Color 0 1 0 0.5) square+    where tr = Draw.translate (1 - (2*x'/resX + w'/resX), 1 - (2*y'/resY + h'/resY))+               `mappend` (Draw.scale (2*w'/resX) (2*h'/resY))+          w' = fromIntegral w+          h' = fromIntegral h+          x' = fromIntegral x+          y' = fromIntegral y+  +--drawRects :: IP.ImageSink+--drawRects = arr (mconcat . drawCvRects) --fmap (mconcat . map drawCvRect) id+--    where drawCvRects = map drawCvRect+++clock :: IO Double -- = DClock Double+clock = return 1 -- todo implement really in some module that wraps SDL, GLUT or whatever.++-- todo: ins't this just an n-step past memory? generalize a bit and move to Processor package?+movingAverage :: Int -> ([(DTime, b)] -> c) -> (DTime, b) -> c -> IOSource a b -> IOProcessor a c+movingAverage n f initA initB p = (scanlT clock f' (take n . repeat $ initA, initB) p) >>> arr snd+    where f' _ y2 dt (lastNSamps, _) = (nextSamps, f nextSamps )+              where nextSamps = (dt, y2) : (tail lastNSamps)++-- todo: this is a general function, perhaps move to a module?+averageV :: (Fractional (Scalar a), VectorSpace a) => [Scalar a] -> [a] -> a+averageV weights samps = ((1/n) *^) . foldr (^+^) zeroV $ zipWith (*^) weights samps+    where n = fromIntegral (length weights)+          +  +-- todo: this is a general function, perhaps move to Processor package?+movingCvRectAverage :: (Fractional (Scalar v), VectorSpace v) => [Scalar v] -> IOProcessor a [v] -> IOProcessor a v+movingCvRectAverage weights pIn = movingAverage (length weights) (averageV weights . map snd) (0, zeroV) zeroV pIn'+    where pIn' = pIn >>> arr headOrZero+          headOrZero [] = zeroV+          headOrZero xs = head xs++main :: IO ()+main = Processor.runUntil (captureDev >>> resizer >>> avgRect faceDetect >>> arr drawCvRect >>> sdlWindow) () (const . return $ False)+    where avgRect = movingCvRectAverage [2,1,1,0]+          sdlWindow = GP.sdlWindow resX resY  

@@ -4,8 +4,8 @@ import AI.CV.ImageProcessors  import qualified AI.CV.OpenCV.CV as CV-import qualified AI.CV.Processor as Processor-import AI.CV.Processor((--<))+import qualified Control.Processor as Processor+import Control.Processor((--<)) import AI.CV.OpenCV.Types import AI.CV.OpenCV.CxCore(CvRect(..), CvSize(..)) @@ -23,10 +23,10 @@ faceDetect = haarDetect "/usr/share/opencv/haarcascades/haarcascade_frontalface_alt.xml" 1.1 3 CV.cvHaarFlagNone (CvSize 20 20)    captureDev :: ImageSource-captureDev = videoFile "/tmp/video.flv" -- Many formats are supported, not just flv (FFMPEG-based, normally).+--captureDev = videoFile "/tmp/video.flv" -- Many formats are supported, not just flv (FFMPEG-based, normally).  -- If you have a webcam, uncomment this, and comment the other definition.--- captureDev = camera 0+captureDev = camera 0  main :: IO () main = runTillKeyPressed (captureDev >>> resizer --< (faces *** edges) >>> (window 0 *** window 1))