diff --git a/cv-combinators.cabal b/cv-combinators.cabal --- a/cv-combinators.cabal +++ b/cv-combinators.cabal @@ -1,5 +1,5 @@ name: cv-combinators -version: 0.1.2.2 +version: 0.1.2.3 license: BSD3 maintainer: Noam Lewis bug-reports: mailto:jones.noamle@gmail.com @@ -23,12 +23,12 @@ library exposed-modules: AI.CV.ImageProcessors hs-Source-Dirs: src - build-depends: base >=4 && <5, HOpenCV >= 0.1.2.1, allocated-processor, vector-space + build-depends: base >=4 && <5, HOpenCV >= 0.1.2.1, allocated-processor >= 0.0.2, vector-space ghc-options: -Wall executable test-cv-combinators hs-source-dirs: src - Build-Depends: base >=4 && <5, HOpenCV >= 0.1.2.1, allocated-processor, vector-space + Build-Depends: base >=4 && <5, HOpenCV >= 0.1.2.1, allocated-processor >= 0.0.2, vector-space main-is: Test.hs Ghc-Options: -Wall Ghc-Prof-Options: -prof -auto-all @@ -36,7 +36,7 @@ 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 + Build-Depends: base >=4 && <5, HOpenCV >= 0.1.2.1, allocated-processor >= 0.0.2, SDL, graphics-drawingcombinators, vector-space main-is: IntegratedTest.hs Ghc-Options: -Wall Ghc-Prof-Options: -prof -auto-all diff --git a/src/IntegratedTest.hs b/src/IntegratedTest.hs --- a/src/IntegratedTest.hs +++ b/src/IntegratedTest.hs @@ -11,7 +11,7 @@ import qualified AI.CV.OpenCV.CV as CV import qualified Control.Processor as Processor -import Control.Processor(DTime, DClock, scanlT, IOSource, IOProcessor) +import Control.Processor(scanlT, IOSource, IOProcessor, fir, trace, holdMaybe, revertAfterT) import AI.CV.OpenCV.CxCore(CvRect(..), CvSize(..)) import Data.VectorSpace((*^), zeroV, (^+^), Scalar, VectorSpace) @@ -20,6 +20,7 @@ import Control.Arrow import Control.Category import Data.Monoid +import Data.Maybe(listToMaybe) resX, resY :: Num a => a resX = 160 @@ -53,30 +54,17 @@ --drawRects = arr (mconcat . drawCvRects) --fmap (mconcat . map drawCvRect) id -- where drawCvRects = map drawCvRect +type DTime = Double -clock :: IO Double -- = DClock Double +clock :: IO DTime -- = 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 +--main = Processor.runUntil (captureDev >>> resizer >>> averageFace >>> arr drawCvRect >>> sdlWindow) () (const . return $ False) +main = IP.runTillKeyPressed (captureDev >>> resizer >>> (id &&& averageFace) >>> (second (arr return)) >>> IP.drawRects >>> IP.window 0) + where averageFace = lastFace --fir [0.9,0.1] 1 clock lastFace + lastFace = revertAfterT 5 zeroV . holdMaybe zeroV clock $ (faceDetect >>> arr listToMaybe) + --sdlWindow = GP.sdlWindow resX resY + headOrZero [] = zeroV + headOrZero (v:vs) = v