CV 0.3.0.2 → 0.3.1.2
raw patch · 29 files changed
+617/−109 lines, 29 filesbinary-added
Files
- CV.cabal +4/−2
- CV/Binary.hs +2/−0
- CV/ColourUtils.chs +31/−14
- CV/ConnectedComponents.chs +73/−29
- CV/Conversions.hs +29/−2
- CV/Drawing.chs +48/−14
- CV/Edges.chs +15/−7
- CV/Filters.chs +34/−9
- CV/FunnyStatistics.hs +1/−1
- CV/HighGUI.chs +45/−0
- CV/Image.chs +16/−0
- CV/ImageMath.chs +8/−0
- CV/ImageOp.hs +36/−11
- CV/Morphology.chs +6/−6
- CV/Transforms.chs +1/−0
- CV/Video.chs +9/−7
- CV/cvWrapLEO.c +43/−1
- CV/cvWrapLEO.h +7/−0
- examples/FromCharPtr.hs +20/−0
- examples/Fuse.hs +39/−0
- examples/MR-Edge.hs +31/−0
- examples/PyramidNoise.hs +28/−0
- examples/TestIop.hs +41/−0
- examples/edges.hs +7/−1
- examples/fuse1.png binary
- examples/fuse2.png binary
- examples/video.hs +4/−5
- examples/video2.hs +20/−0
- examples/video3.hs +19/−0
CV.cabal view
@@ -1,5 +1,5 @@ Name: CV-Version: 0.3.0.2+Version: 0.3.1.2 Description: OpenCV Bindings License: GPL License-file: LICENSE@@ -28,6 +28,8 @@ examples/*.hs examples/shapes/*.png examples/shapePhoto.jpg+ examples/fuse1.png+ examples/fuse2.png examples/smallLena.jpg examples/elaine.jpg @@ -50,7 +52,7 @@ CV.TemplateMatching, CV.Transforms, CV.Conversions, CV.Binary, CV.Marking, CV.FunnyStatistics, CV.MultiresolutionSpline, CV.Gabor,- CV.ConnectedComponents+ CV.ConnectedComponents, CV.HighGUI Other-modules: C2HSTools, C2HS source-repository head
CV/Binary.hs view
@@ -1,3 +1,5 @@+-- |Binary instances for images. Currently it only supports the type +-- `Image Grayscale D32`. {-#LANGUAGE ScopedTypeVariables, FlexibleInstances#-} module CV.Binary where import CV.Image (Image,GrayScale,D32)
CV/ColourUtils.chs view
@@ -1,6 +1,15 @@+-- |This module contains functions for simple histogram manipulation. Use this+-- to scale the image for viewing or to perform simple light-level normalization+-- accross multiple images. {-#LANGUAGE ForeignFunctionInterface,ScopedTypeVariables#-} #include "cvWrapLEO.h"-module CV.ColourUtils where+module CV.ColourUtils (+ balance+ , logarithmicCompression+ , stretchHistogram+ , equalizeHistogram + )+where import Foreign.C.Types import Foreign.C.String import Foreign.ForeignPtr@@ -16,26 +25,22 @@ -- TODO: Rename this entire module to something else. Everything here is grayscale :/ --- Balance image grayscales so that it has m mean and md standard deviation+-- |Adjust the image histogram to have fixed mean and standard deviation. This can+-- be used for simple light level normalization.+balance :: (D32, D32) -> Image GrayScale D32 -> Image GrayScale D32 balance (m,md) i = m |+ (scale |* (i |- im) ) where imd :: D32 = realToFrac $ IM.stdDeviation i im :: D32 = IM.average i scale :: D32 = realToFrac $ md/imd --logarithmicCompression image = stretchHistogram $ - IM.log $ 1 `IM.addS` image ---getStretchScaling reference image = stretched- where- stretched = (1/realToFrac length) `IM.mulS` normed- normed = image `IM.subS` (realToFrac min)- length = max-min- (min,max) = IM.findMinMax reference-+-- |Perform logarithmic compression on the image. This will enhance dark features+-- and suppress bright features. Use this to visualize images with high dynamic range. +-- (FFT results, for example)+logarithmicCompression :: Image GrayScale D32 -> Image GrayScale D32+logarithmicCompression image = stretchHistogram $ IM.log $ 1 `IM.addS` image +-- |Histogram stretch scales the image to fit the range [0,1] stretchHistogram :: Image GrayScale D32 -> Image GrayScale D32 stretchHistogram image = stretched where@@ -44,9 +49,21 @@ length = max-min (min,max) = IM.findMinMax image +-- | Equalize contrast of the image. This is good for visualizing +-- images with backgrounds and foregrounds that are both bright or both dark. equalizeHistogram :: Image GrayScale D8 -> Image GrayScale D8 equalizeHistogram image = unsafePerformIO $ do withClone image $ \x -> withGenImage x $ \i -> {#call cvEqualizeHist#} i i++getStretchScaling :: Image GrayScale D32 -> Image GrayScale D32 -> Image GrayScale D32+getStretchScaling reference image = stretched+ where+ stretched = (1/realToFrac length) `IM.mulS` normed+ normed = image `IM.subS` (realToFrac min)+ length = max-min+ (min,max) = IM.findMinMax reference++
CV/ConnectedComponents.chs view
@@ -1,14 +1,33 @@ {-#LANGUAGE ForeignFunctionInterface, ScopedTypeVariables#-}-#include "cvWrapLEO.h"+-- | This module contains functions for extracting features from connected components+-- of black and white images as well as extracting other shape related features. module CV.ConnectedComponents--- (selectSizedComponents,countBlobs,centralMoments--- ,huMoments,Contours,getContours) + (+ -- * Working with connected components+ selectSizedComponents+ ,countBlobs+ -- * Working with Image moments+ -- |Note that these functions should probably go to a different module, since+ -- they deal with entire moments of entire images.+ ,centralMoments+ ,huMoments+ -- * Working with component contours aka. object boundaries.+ -- |This part is really old code and probably could be improved a lot.+ ,Contours+ ,getContours+ ,contourArea+ ,contourPerimeter+ ,contourPoints+ ,mapContours+ ,contourHuMoments) where+#include "cvWrapLEO.h" import Foreign.Ptr import Foreign.C.Types import System.IO.Unsafe import Foreign.ForeignPtr+import Control.Monad ((>=>)) import C2HSTools @@ -16,33 +35,42 @@ import CV.ImageOp +++-- |Count the number of connected components in the image countBlobs :: Image GrayScale D8 -> Int countBlobs image = fromIntegral $ unsafePerformIO $ do withGenImage image $ \i -> {#call blobCount#} i +-- |Remove all connected components that fall outside of given size range from the image.+selectSizedComponents :: Double -> CDouble -> Image GrayScale D8 -> Image GrayScale D8 selectSizedComponents minSize maxSize image = unsafePerformIO $ do withGenImage image $ \i ->- creatingImage ({#call sizeFilter#} i minSize maxSize)+ creatingImage ({#call sizeFilter#} i (realToFrac minSize) (realToFrac maxSize)) +-- * Working with Image moments. -{#pointer *CvMoments as Moments foreign newtype#} --- foreign import ccall "& freeCvMoments" releaseMoments :: FinalizerPtr Moments- +-- |Extract central moments of the image. These are useful for describing the object shape+-- for a classifier system.+centralMoments :: Image GrayScale D32 -> Bool -> [Double] centralMoments image binary = unsafePerformIO $ do moments <- withImage image $ \i -> {#call getMoments#} i (if binary then 1 else 0) ms <- sequence [{#call cvGetCentralMoment#} moments i j | i <- [0..3], j<-[0..3], i+j <= 3] {#call freeCvMoments#} moments- return ms+ return (map realToFrac ms) +-- |Extract Hu-moments of the image. These features are rotation invariant.+huMoments :: Image GrayScale D32 -> Bool -> [Double] huMoments image binary = unsafePerformIO $ do moments <- withImage image $ \i -> {#call getMoments#} i (if binary then 1 else 0) hu <- readHu moments {#call freeCvMoments#} moments- return hu+ return (map realToFrac hu) +-- read stuff out of hu-moments structure.. This could be done way better. readHu m = do hu <- mallocArray 7 {#call getHuMoments#} m hu@@ -50,18 +78,36 @@ free hu return hu' --- Contours+-- |Structure that contains the opencv sequence holding the contour data. {#pointer *FoundContours as Contours foreign newtype#} foreign import ccall "& free_found_contours" releaseContours :: FinalizerPtr Contours +-- | This function maps an opencv contour calculation over all+-- contours of the image. +mapContours :: ContourFunctionUS a -> Contours -> [a]+mapContours (CFUS op) contours = unsafePerformIO $ do+ let loop acc cp = do+ more <- withContours cp {#call more_contours#}+ if more < 1 + then return acc + else do+ x <- op cp+ (i::CInt) <- withContours cp {#call next_contour#}+ loop (x:acc) cp+ + acc <- loop [] contours+ withContours contours ({#call reset_contour#})+ return acc++-- |Extract contours of connected components of the image.+getContours :: Image GrayScale D8 -> Contours getContours img = unsafePerformIO $ do withImage img $ \i -> do ptr <- {#call get_contours#} i fptr <- newForeignPtr releaseContours ptr return $ Contours fptr - newtype ContourFunctionUS a = CFUS (Contours -> IO a) newtype ContourFunctionIO a = CFIO (Contours -> IO a) @@ -69,10 +115,18 @@ rawContourOp op = CFIO $ \c -> withContours c op printContour = rawContourOp {#call print_contour#}-contourArea = rawContourOpUS ({#call contour_area#})-contourPerimeter = rawContourOpUS {#call contour_perimeter#} -getContourPoints = rawContourOpUS getContourPoints'+contourArea :: ContourFunctionUS Double+contourArea = rawContourOpUS ({#call contour_area#} >=> return.realToFrac)+-- ^The area of a contour.++contourPerimeter :: ContourFunctionUS Double+contourPerimeter = rawContourOpUS $ {#call contour_perimeter#} >=> return.realToFrac+-- ^Get the perimeter of a contour.++-- |Get a list of the points in the contour.+contourPoints :: ContourFunctionUS [(Double,Double)]+contourPoints = rawContourOpUS getContourPoints' getContourPoints' f = do count <- {#call cur_contour_size#} f let count' = fromIntegral count @@ -86,27 +140,15 @@ free ys return $ zip (map fromIntegral xs') (map fromIntegral ys') -getContourHuMoments = rawContourOpUS getContourHuMoments' +-- | Operation for extracting Hu-moments from a contour+contourHuMoments :: ContourFunctionUS [Double]+contourHuMoments = rawContourOpUS $ getContourHuMoments' >=> return.map realToFrac getContourHuMoments' f = do m <- {#call contour_moments#} f hu <- readHu m {#call freeCvMoments#} m return hu -mapContours :: ContourFunctionUS a -> Contours -> [a]-mapContours (CFUS op) contours = unsafePerformIO $ do- let loop acc cp = do- more <- withContours cp {#call more_contours#}- if more < 1 - then return acc - else do- x <- op cp- (i::CInt) <- withContours cp {#call next_contour#}- loop (x:acc) cp- - acc <- loop [] contours- withContours contours ({#call reset_contour#})- return acc mapContoursIO :: ContourFunctionIO a -> Contours -> IO [a] mapContoursIO (CFIO op) contours = do@@ -122,3 +164,5 @@ acc <- loop [] contours withContours contours ({#call reset_contour#}) return acc++{#pointer *CvMoments as Moments foreign newtype#}
CV/Conversions.hs view
@@ -2,17 +2,28 @@ -- |This module provides slow but functional means for exporting images from and to -- CArrays, which can easily be passed into foreign functions. module CV.Conversions (+ -- Arrays of Double copyCArrayToImage+ ,copyImageToCArray+ -- Arrays of Float ,copyFCArrayToImage- ,copyComplexCArrayToImage ,copyImageToFCArray- ,copyImageToCArray+ -- * Complex arrays+ ,copyComplexCArrayToImage ,copyImageToComplexCArray+ -- * Copying+ ,copyImageToExistingCArray+ -- * Acquiring images from pointers+ ,unsafe8UC3FromPtr+ ,acquireImageSlowF'+ ,acquireImageSlow'+ ,acquireImageSlow8URGB' ) where import Complex import CV.Image+import Data.Word import Data.Array.CArray import Data.Array.IArray@@ -22,6 +33,9 @@ import Foreign.Storable.Complex import System.IO.Unsafe +unsafe8UC3FromPtr :: (Int,Int) -> Ptr Word8 -> IO (Image RGB D8)+unsafe8UC3FromPtr (w,h) ptr = S `fmap` creatingBareImage (acquireImageSlow8URGB' w h ptr)+ -- |Copy the contents of a CArray into CV.Image type. copyCArrayToImage :: CArray (Int,Int) Double -> Image GrayScale D32 copyCArrayToImage carr = S $ unsafePerformIO $@@ -46,6 +60,9 @@ where (w,h) = getSize img +++ -- |Copy the real part of an array to image copyComplexCArrayToImage :: CArray (Int,Int) (Complex Double) -> Image GrayScale D32 copyComplexCArrayToImage carr = S $ unsafePerformIO $@@ -61,6 +78,13 @@ createCArray ((0,0),(w-1,h-1)) (exportImageSlow' cimg) --({#call exportImageSlow#} cimg) where (w,h) = getSize img+-- |Copy the contents of CV.Image into a pre-existing CArray.+--+copyImageToExistingCArray (S img) arr = + withBareImage img $ \cimg -> + withCArray arr $ \carr -> (exportImageSlow' cimg carr) --({#call exportImageSlow#} cimg)+ where+ (w,h) = getSize img -- |Copy image as a real part of a complex CArray copyImageToComplexCArray :: Image GrayScale D32 -> CArray (Int,Int) (Complex Double)@@ -84,6 +108,9 @@ foreign import ccall safe "CV/cvWrapLeo.h acquireImageSlowF" acquireImageSlowF' :: (Int -> (Int -> ((Ptr Float) -> (IO (Ptr (BareImage))))))++foreign import ccall safe "CV/cvWrapLeo.h acquireImageSlow8URGB"+ acquireImageSlow8URGB' :: (Int -> (Int -> ((Ptr Word8) -> (IO (Ptr (BareImage)))))) foreign import ccall safe "CV/cvWrapLeo.h acquireImageSlowComplex" acquireImageSlowComplex' :: (Int -> (Int -> ((Ptr (Complex Double)) -> (IO (Ptr (BareImage))))))
CV/Drawing.chs view
@@ -1,10 +1,27 @@ {-#LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, TypeSynonymInstances#-} #include "cvWrapLEO.h"+-- | Module for exposing opencv drawing functions. These are meant for quick and dirty marking+-- and not for anything presentable. For any real drawing+-- you should figure out how to use cairo or related package, such as diagrams. They are+-- way better.+--+-- Consult the "CV.ImageOp" module for functions to apply the operations in this module to images. -module CV.Drawing(ShapeStyle(Filled,Stroked),circle- ,Drawable(..)- ,floodfill,drawLinesOp,drawLines,rectangle- ,rectOpS,fillPoly) where+module CV.Drawing(+ -- * Drawable class+ ShapeStyle(Filled,Stroked)+ ,Drawable(..)+ -- * Extra drawing operations+ ,drawLinesOp+ ,rectOpS+ -- * Floodfill operations+ ,fillOp+ ,floodfill+ -- * Shorthand for drawing single shapes+ ,circle+ ,drawLines+ ,rectangle+ ,fillPoly) where import Foreign.Ptr import Foreign.C.Types@@ -19,22 +36,27 @@ import CV.ImageOp +-- | Is the shape filled or just a boundary? data ShapeStyle = Filled | Stroked Int deriving(Eq,Show) styleToCV Filled = -1 styleToCV (Stroked w) = fromIntegral w --- TODO: Add fillstyle for rectOp-- -- TODO: The instances in here could be significantly smaller..+-- |Typeclass for images that support elementary drawing operations. class Drawable a b where+ -- | Type of the pixel, i.e. Float for a grayscale image and 3-tuple for RGB image. type Color a b :: * + -- | Put text of certain color to given coordinates. Good size seems to be around 0.5-1.5. putTextOp :: (Color a b) -> Float -> String -> (Int,Int) -> ImageOperation a b- lineOp :: (Color a b) -> Int -> (Int,Int) -> (Int,Int) -> ImageOperation a b+ -- | Draw a line between two points.+ lineOp :: (Color a b) -> Int -> (Int,Int) -> (Int,Int) -> ImageOperation a b+ -- | Draw a Circle circleOp :: (Color a b) -> (Int,Int) -> Int -> ShapeStyle -> ImageOperation a b+ -- | Draw a Rectangle by supplying two corners rectOp :: (Color a b) -> Int -> (Int,Int) -> (Int,Int) -> ImageOperation a b+ -- | Draw a filled polygon fillPolyOp :: (Color a b) -> [(Int,Int)] -> ImageOperation a b instance Drawable RGB D32 where@@ -118,8 +140,12 @@ free ys' +-- | Draw a rectangle by giving top left corner and size.+rectOpS :: Drawable a b => Color a b -> Int -> (Int, Int) -> (Int, Int) + -> ImageOperation a b rectOpS c t pos@(x,y) (w,h) = rectOp c t pos (x+w,y+h) +-- | Flood fill a region of the image fillOp :: (Int,Int) -> D32 -> D32 -> D32 -> Bool -> ImageOperation GrayScale D32 fillOp (x,y) color low high floats = ImgOp $ \i -> do@@ -130,26 +156,34 @@ toCINT False = 0 toCINT True = 1 --- Shorthand for single drawing operations. You should however use #> and <## in CV.ImageOp --- rather than these----line color thickness start end i = --- operate (lineOp color thickness start end ) i-+-- | Apply rectOp to an image+rectangle :: Drawable c d => Color c d -> Int -> (Int, Int) -> (Int, Int) -> Image c d+ -> IO (Image c d) rectangle color thickness a b i = operate (rectOp color thickness a b ) i +-- | Apply fillPolyOp to an image+fillPoly :: Drawable c d => Color c d -> [(Int, Int)] -> Image c d -> IO (Image c d) fillPoly c pts i = operate (fillPolyOp c pts) i +-- | Draw a polyline+drawLinesOp :: Drawable c d => Color c d -> Int -> [((Int, Int), (Int, Int))] -> CV.ImageOp.ImageOperation c d drawLinesOp color thickness segments = foldl (#>) nonOp $ map (\(a,b) -> lineOp color thickness a b) segments +-- | Apply drawLinesOp to an image+drawLines :: Drawable c d => Image c d -> Color c d -> Int -> [((Int, Int), (Int, Int))]+ -> IO (Image c d) drawLines img color thickness segments = operateOn img (drawLinesOp color thickness segments) +-- | Apply circleOp to an image+circle :: Drawable c d => (Int, Int) -> Int -> Color c d -> ShapeStyle -> Image c d -> Image c d circle center r color s i = unsafeOperate (circleOp color center r s) i +-- | Apply fillOp to an image+floodfill :: (Int, Int) -> D32 -> D32 -> D32 -> Bool -> Image GrayScale D32 -> Image GrayScale D32 floodfill (x,y) color low high floats = unsafeOperate (fillOp (x,y) color low high floats)
CV/Edges.chs view
@@ -1,9 +1,17 @@ {-#LANGUAGE ForeignFunctionInterface#-} #include "cvWrapLEO.h"-module CV.Edges (sobelOp,sobel+-- | This module is a collection of simple edge detectors.+module CV.Edges (+ -- * Common edge detectors+ sobelOp,sobel+ ,laplaceOp,laplace,canny,susan+ -- * Various aperture sizes+ -- | For added safety we define the possible + -- apertures as constants, since the filters accept only+ -- specific mask sizes. ,sScharr,s1,s3,s5,s7 ,l1,l3,l5,l7- ,laplaceOp,laplace,canny,susan) where+ ) where import Foreign.C.Types import Foreign.C.String import Foreign.ForeignPtr@@ -19,8 +27,7 @@ -- | Perform Sobel filtering on image. First argument gives order of horizontal and vertical -- derivative estimates and second one is the aperture. This function can also calculate -- Scharr filter with aperture specification of sScharr--- TODO: Type the aperture size and possibly the derivative orders as well--- TODO: It is possible to define sobel with different target image with other bit depths.+ sobelOp :: (Int,Int) -> SobelAperture -> ImageOperation GrayScale D32 sobelOp (dx,dy) (Sb aperture) | dx >=0 && dx <3@@ -35,7 +42,8 @@ -- | Aperture sizes for sobel operator newtype SobelAperture = Sb Int-sScharr = Sb (-1)+-- | Use Scharr mask instead+sScharr = Sb (-1) s1 = Sb 1 s3 = Sb 3 s5 = Sb 5@@ -70,10 +78,10 @@ --- | SUSAN edge detection filter, see http://users.fmrib.ox.ac.uk/~steve/susan/susan/susan.html--- TODO: Should return a binary image+-- | SUSAN edge detection filter, see <http://users.fmrib.ox.ac.uk/~steve/susan/susan/susan.html> susan :: (Int,Int) -> D32 -> Image GrayScale D32 -> Image GrayScale D8 susan (w,h) t image = unsafePerformIO $ do withGenImage image $ \img -> creatingImage ({#call susanEdge#} img (fromIntegral w) (fromIntegral h) (realToFrac t))+-- TODO: Should return a binary image
CV/Filters.chs view
@@ -1,13 +1,14 @@-{-#LANGUAGE ForeignFunctionInterface#-}+{-#LANGUAGE ForeignFunctionInterface, TypeFamilies#-} #include "cvWrapLEO.h"-module CV.Filters(gaussian,gaussianOp,bilateral+-- | This module is a collection of various image filters+module CV.Filters(gaussian,gaussianOp ,blurOp,blur,blurNS ,median ,susan,getCentralMoment,getAbsCentralMoment ,getMoment,secondMomentBinarize,secondMomentBinarizeOp ,secondMomentAdaptiveBinarize,secondMomentAdaptiveBinarizeOp ,selectiveAvg,convolve2D,convolve2DI,haar,haarAt- ,IntegralImage,getIISize,integralImage,verticalAverage) where+ ,IntegralImage(),integralImage,verticalAverage) where import Foreign.C.Types import Foreign.C.String import Foreign.ForeignPtr@@ -24,16 +25,26 @@ -- IplImage* susanSmooth(IplImage *src, int w, int h -- ,double t, double sigma); +-- | SUSAN adaptive smoothing filter, see <http://users.fmrib.ox.ac.uk/~steve/susan/susan/susan.html>+susan :: (Int, Int) -> Double -> Double+ -> Image GrayScale D32 -> Image GrayScale D32 susan (w,h) t sigma image = unsafePerformIO $ do withGenImage image $ \img -> creatingImage - ({#call susanSmooth#} img w h t sigma)+ ({#call susanSmooth#} img (fromIntegral w) (fromIntegral h) + (realToFrac t) (realToFrac sigma)) -- TODO: ADD checks above!++-- | A selective average filter is an edge preserving noise reduction filter.+-- It is a standard gaussian filter which ignores pixel values+-- that are more than a given threshold away from the filtered pixel value.+selectiveAvg :: (Int, Int) -> Double + -> Image GrayScale D32 -> Image GrayScale D32 selectiveAvg (w,h) t image = unsafePerformIO $ do withGenImage image $ \img -> creatingImage ({#call selectiveAvgFilter#} - img t w h)+ img (realToFrac t) (fromIntegral w) (fromIntegral h)) -- TODO: ADD checks above! getCentralMoment n (w,h) image = unsafePerformIO $ do@@ -61,7 +72,6 @@ (\i-> {#call smab#} i w h t) secondMomentAdaptiveBinarize w h t i = unsafeOperate (secondMomentAdaptiveBinarizeOp w h t) i --- Low level wrapper for opencv data SmoothType = BlurNoScale | Blur | Gaussian | Median | Bilateral@@ -105,6 +115,7 @@ (fromIntegral colorS) (fromIntegral spaceS) 0 0 +-- | Perform median filtering on an eight bit image. median :: (Int,Int) -> Image GrayScale D8 -> Image GrayScale D8 median (w,h) img | maskIsOk (w,h) = unsafePerformIO $ do@@ -137,6 +148,7 @@ {#call wrapFilter2DImg#} img k x y +-- | Replace pixel values by the average of the row. verticalAverage :: Image GrayScale D32 -> Image GrayScale D32 verticalAverage image = unsafePerformIO $ do let (w,h) = getSize image@@ -146,10 +158,18 @@ {#call vertical_average#} i sum return s +-- | A type for storing integral images. Integral image stores for every pixel the sum of pixels+-- above and left of it. Such images are used for significantly accelerating the calculation of+-- area averages. newtype IntegralImage = IntegralImage (Image GrayScale D64)+instance IntSized IntegralImage where+ getSize (IntegralImage i) = getSize i -getIISize (IntegralImage i) = getSize i+instance GetPixel IntegralImage where+ type P IntegralImage = Double+ getPixel = getPixel +-- | Calculate the integral image from the given image. integralImage :: Image GrayScale D32 -> IntegralImage integralImage image = unsafePerformIO $ do let (w,h) = getSize image@@ -160,6 +180,7 @@ return $ IntegralImage s +-- |Filter the image with box shaped averaging mask. haar :: IntegralImage -> (Int,Int,Int,Int) -> Image GrayScale D32 haar (IntegralImage image) (a',b',c',d') = unsafePerformIO $ do let (w,h) = getSize image@@ -175,5 +196,9 @@ res return r -haarAt (IntegralImage ii) (a,b,w,h) = unsafePerformIO $ withImage ii $ \i -> - {#call haar_at#} i a b w h +-- | Get an average of a given region.+haarAt :: IntegralImage -> (Int,Int,Int,Int) -> Double++haarAt (IntegralImage ii) (a,b,w,h) = realToFrac $ unsafePerformIO $ withImage ii $ \i -> + {#call haar_at#} i (f a) (f b) (f w) (f h)+ where f = fromIntegral
CV/FunnyStatistics.hs view
@@ -27,5 +27,5 @@ xx s i = IM.div (nthCM s 6 i) (stdDev s i |^6) -} -pearsonSkewness1 s image = IM.div (blur s image #- unsafeImageTo32F (median s (unsafeImageTo32F image))) +pearsonSkewness1 s image = IM.div (blur s image #- unsafeImageTo32F (median s (unsafeImageTo8Bit image))) (stdDev s image)
+ CV/HighGUI.chs view
@@ -0,0 +1,45 @@+{-#LANGUAGE ForeignFunctionInterface, ScopedTypeVariables#-}+#include "cvWrapLEO.h"+module CV.HighGUI where+import Foreign.C.Types+import Foreign.C.String+import Foreign.ForeignPtr+import Foreign.Ptr++import C2HSTools++import CV.Image+{#import CV.Image#}+import CV.ImageOp++-- Functions for easy operation++-- TODO: "__TMP__" should be a gensym+display image = do+ makeWindow "__TMP__"+ showImage "__TMP__" image+ --threadDelay 2000000+ waitKey 0+ destroyWindow "__TMP__"++--- Lower level interface+{#fun cvNamedWindow as mkWin {withCString* `String', `Int' } -> `()' #}++makeWindow name = mkWin name 1++destroyWindow n = withCString n $ \name -> do+ {#call cvDestroyWindow#} name++foreign import ccall "wrapper"+ trackbarCallback :: (CInt -> IO ()) -> IO (FunPtr (CInt -> IO ()))++mkTrackbar mx initial name window callback = do+ cb <- trackbarCallback callback+ withCString name $ \cname ->+ withCString window $ \cwindow ->+ {#call cvCreateTrackbar#} cname cwindow nullPtr (fromIntegral mx) cb+ +waitKey delay = {#call cvWaitKey#} delay++{#fun cvShowImage as showImage+ {`String', withGenImage* `Image c d'} -> `()'#}
CV/Image.chs view
@@ -24,6 +24,7 @@ import Data.Word + -- Colorspaces data GrayScale data RGB@@ -177,7 +178,17 @@ b <- {#call wrapGet32F2DC#} img y x 2 return (realToFrac r,realToFrac g, realToFrac b) +instance GetPixel (Image RGB D8) where+ type P (Image RGB D8) = (D8,D8,D8) + getPixel (fromIntegral -> x, fromIntegral -> y) image + = unsafePerformIO $ do + withGenImage image $ \img -> do+ r <- {#call wrapGet8U2DC#} img y x 0+ g <- {#call wrapGet8U2DC#} img y x 1+ b <- {#call wrapGet8U2DC#} img y x 2+ return (fromIntegral r,fromIntegral g, fromIntegral b) + convertTo :: CInt -> CInt -> BareImage -> BareImage convertTo code channels img = unsafePerformIO $ creatingBareImage $ do res <- {#call wrapCreateImage32F#} w h channels@@ -318,6 +329,11 @@ result <- cloneImage img fun result return result++withCloneValue img fun = do + result <- cloneImage img+ r <- fun result+ return r unsafeImageTo32F img = unsafePerformIO $ withGenImage img $ \image -> creatingImage
CV/ImageMath.chs view
@@ -83,6 +83,14 @@ withImage res $ \r -> do {#call calculateAtan#} s r return res++atan2 a b = unsafePerformIO $ do+ res <- create (getSize a)+ withImage a $ \c_a -> + withImage b $ \c_b -> + withImage res $ \c_res -> do+ {#call calculateAtan2#} c_a c_b c_res + return res -- Operation that subtracts image mean from image
CV/ImageOp.hs view
@@ -2,39 +2,64 @@ import Foreign import CV.Image+import Control.Monad ((>=>))+import Data.Monoid+import Control.Category+import Prelude hiding ((.),id) --- |ImageOperation is a device for mutating images inplace.-newtype ImageOperation c d= ImgOp (Image c d-> IO ())+-- |ImageOperation is a name for unary operators that mutate images inplace.+newtype ImageOperation c d = ImgOp (Image c d-> IO ()) -- |Compose two image operations (#>) :: ImageOperation c d-> ImageOperation c d -> ImageOperation c d (#>) (ImgOp a) (ImgOp b) = ImgOp (\img -> (a img >> b img)) --- |An unit operation for compose (#>) +-- |An unit operation for compose nonOp = ImgOp (\i -> return ()) -- |Apply image operation to a Copy of an image img <# op = unsafeOperate op img +-- motivating example:+-- >>> hop i = stretchHistogram $ i #- gaussian (5,5) +-- allocates two extra images+-- >>> hop = (gaussian (5,5) &#& id) #> subtract #> stretchHistogram +-- could be implemented in a way that allocates just one extra+fromImageOp (ImgOp f) = IOP $ \i -> (f i >> return i)++newtype IOP a b = IOP (a -> IO b)++instance Category IOP where+ id = IOP return+ (IOP f) . (IOP g) = IOP $ g >=> (f >>= return)++(&#&) :: IOP (Image c d) e -> IOP (Image c d) f -> IOP (Image c d) (Image c d,Image c d)+(IOP f) &#& (IOP g) = IOP $ op+ where + op i = withCloneValue i $ \cl -> (f i >> g cl >> return (i,cl))++unsafeOperate op img = unsafePerformIO $ operate op img++runIOP (IOP f) img = withCloneValue img $ \clone -> f clone+ -- |Apply list of image operations to a Copy of an image. (Makes a single copy and is -- faster than folding over (<#) img <## [] = img img <## op = unsafeOperate (foldl1 (#>) op) img --- |Iterate an operation N times-times n op = foldl (#>) nonOp (replicate n op) --- This could, if I take enough care, be pure.-runImageOperation :: Image c d -> ImageOperation c d -> IO (Image c d)-runImageOperation img (ImgOp op) = withClone img $ \clone -> +-- runImageOperation :: Image c d -> ImageOperation c d -> IO (Image c d)+operate (ImgOp op) img = withClone img $ \clone -> op clone >> return clone +operateOn = flip operate++-- |Iterate an operation N times+times n op = foldl (#>) nonOp (replicate n op) + directOp i (ImgOp op) = op i operateInPlace (ImgOp op) img = op img -operate op img = runImageOperation img op-operateOn = runImageOperation-unsafeOperate op img = unsafePerformIO $ operate op img unsafeOperateOn img op = unsafePerformIO $ operate op img operateWithROI pos size (ImgOp op) img = withClone img $ \clone ->
CV/Morphology.chs view
@@ -44,18 +44,18 @@ geodesic mask op = op #> IM.limitToOp mask -- | Perform a black tophat filtering of size-blackTopHat size i = unsafePerformIO $ do+blackTopHat size i = let se = structuringElement (size,size) (size `div` 2, size `div` 2) RectShape- x <- runImageOperation i (closeOp se)- return $ x `IM.sub` i+ x = unsafeOperate (closeOp se) i+ in x `IM.sub` i -- | Perform a white tophat filtering of size-whiteTopHat size i = unsafePerformIO $ do+whiteTopHat size i = let se = structuringElement (size,size) (size `div` 2, size `div` 2) RectShape- x <- runImageOperation i (openOp se)- return $ i `IM.sub` x+ x = unsafeOperate (openOp se) i+ in i `IM.sub` x basicSE = structuringElement (3,3) (1,1) RectShape bigSE = structuringElement (9,9) (4,4) RectShape
CV/Transforms.chs view
@@ -212,6 +212,7 @@ laplacian = zipWith (#-) downs upsampled ++ [last downs] -- |Reconstruct an image from a laplacian pyramid+reconstructFromLaplacian :: [Image GrayScale D32] -> Image GrayScale D32 reconstructFromLaplacian pyramid = foldl1 (\a b -> (pyrUp a) #+ b) (pyramid) -- where -- safeAdd x y = sameSizePad y x #+ y
CV/Video.chs view
@@ -58,7 +58,6 @@ else creatingImage (ensure32F p_frame) >>= return . Just -- NOTE: This works because Image module has generated wrappers for ensure32F --- These are likely to break.. #c enum CapProp { CAP_PROP_POS_MSEC = CV_CAP_PROP_POS_MSEC @@ -87,6 +86,10 @@ fromProp = fromIntegral . fromEnum +getCapProp cap prop = withCapture cap $ \ccap ->+ {#call cvGetCaptureProperty#} + ccap (fromProp prop) >>= return . realToFrac+ getFrameRate cap = unsafePerformIO $ withCapture cap $ \ccap -> {#call cvGetCaptureProperty#} @@ -120,19 +123,18 @@ data Codec = MPG4 deriving (Eq,Show) -createVideoWriter filename codec framerate frameSize isColor = +createVideoWriter filename codec framerate frameSize = withCString filename $ \cfilename -> do ptr <- {#call wrapCreateVideoWriter#} cfilename fourcc - framerate w h ccolor+ framerate w h 0 if ptr == nullPtr then error "Could not create video writer" else return () fptr <- newForeignPtr releaseVideoWriter ptr return . VideoWriter $ fptr where- (w,h) = frameSize- ccolor | isColor = 1- | otherwise = 0+ (fromIntegral -> w, fromIntegral -> h) = frameSize fourcc | codec == MPG4 = 0x4d504734 -- This is so wrong.. +writeFrame :: VideoWriter -> Image RGB D32 -> IO () writeFrame writer img = withVideoWriter writer $ \cwriter -> withImage img $ \cimg -> - {#call cvWriteFrame #} cwriter cimg+ {#call cvWriteFrame #} cwriter cimg >> return ()
CV/cvWrapLEO.c view
@@ -11,6 +11,9 @@ //@-node:aleator.20050908100314.1:Includes //@+node:aleator.20050908100314.2:Wrappers +#define FGET(img,x,y) (((float *)((img)->imageData + (y)*(img)->widthStep))[(x)])+#define UGETC(img,color,x,y) (((uint8_t *)((img)->imageData + (y)*(img)->widthStep))[(x)*3+(color)])+ size_t images; void incrImageC(void)@@ -266,6 +269,7 @@ cvSet2D(arr,x,y,cvRealScalar(value)); } + double wrapGet32F2D(CvArr *arr, int x, int y) { CvScalar r;@@ -280,7 +284,12 @@ return r.val[c]; } +uint8_t wrapGet8U2DC(IplImage *arr, int x, int y,int c)+{ + return UGETC(arr,c,y,x);+} + void wrapDrawCircle(CvArr *img, int x, int y, int radius, float r,float g,float b, int thickness) { cvCircle(img,cvPoint(x,y),radius,CV_RGB(r,g,b),thickness,8,0);@@ -397,7 +406,6 @@ cvResetImageROI(a); printf("Done!\n"); fflush(stdout); }-#define FGET(img,x,y) (((float *)((img)->imageData + (y)*(img)->widthStep))[(x)]) IplImage* makeEvenDown(IplImage *src) {@@ -764,6 +772,7 @@ return; } + double getHistValue(CvHistogram *h,int bin) { return *cvGetHistValue_1D(h,bin);@@ -863,6 +872,18 @@ cvSet2D(dst,j,i,cvScalarAll(atan(r))); } }++void calculateAtan2(IplImage *src1,IplImage *src2, IplImage *dst)+{+ CvSize imageSize = cvGetSize(dst);+ for(int i=0; i<imageSize.width; ++i)+ for(int j=0; j<imageSize.height; ++j) {+ double a = FGET(src1,j,i);+ double b = FGET(src2,j,i);+ FGET(dst,j,i) = atan2(a,b);+ }+}+ //@nonl //@-node:aleator.20070906153003:Trigonometric operations //@+node:aleator.20051109111547:Pixel accessors@@ -1806,6 +1827,27 @@ for (j=0; j<w; j++) { //printf("(%d,%d) => %d is %f\n",j,i,(i+j*h),d[i+j*h]); FGET(img,j,i) = d[j*h+i]; + }+ }+ return img;+}++#define BLUE = 0+#define GREEN = 1+#define RED = 2++++IplImage *acquireImageSlow8URGB(int w, int h, uint8_t *d)+{+ IplImage *img;+ int i,j;+ img = cvCreateImage(cvSize(w,h), IPL_DEPTH_8U,3);+ for (i=0; i<h; i++) {+ for (j=0; j<w; j++) { + UGETC(img,0,j,i) = *d; d++; + UGETC(img,1,j,i) = *d; d++; + UGETC(img,2,j,i) = *d; d++; } } return img;
CV/cvWrapLEO.h view
@@ -42,6 +42,7 @@ void wrapSet32F2D(CvArr *arr, int x, int y, double value); double wrapGet32F2D(CvArr *arr, int x, int y);+uint8_t wrapGet8U2DC(IplImage *arr, int x, int y,int c); void wrapDrawCircle(CvArr *img, int x, int y, int radius, float r,float g,float b, int thickness); @@ -62,6 +63,11 @@ ,int binCount ,double *values); +//void get_weighted_histogram(IplImage *img,IplImage *mask);+// ,float a, float b+// ,int binCount+// ,double *values);+ IplImage* getSubImage(IplImage *img, int sx,int sy,int w,int h); int getImageHeight(IplImage *img); int getImageWidth(IplImage *img);@@ -187,6 +193,7 @@ int thickness); void calculateAtan(IplImage *src, IplImage *dst);+void calculateAtan2(IplImage *src1,IplImage *src2, IplImage *dst); // Contours
+ examples/FromCharPtr.hs view
@@ -0,0 +1,20 @@+module Main where+import CV.Image+import CV.ColourUtils+import CV.Conversions+import Data.Array.CArray+import Data.Array.IArray+import Foreign.C.Types+import Foreign.Marshal.Alloc+import Foreign.Marshal.Array++main = do+ let values = concat [[129,x,y] | x <- [0..99], y <- [0..99]]+ print $ (length values,99*99*3)+ ptr <- newArray $ values+ let image :: Image RGB D8 + image = unsafe8UC3FromPtr (100,100) ptr+ print $ getPixel (0,0) image+ print $ getPixel (50,50) image+ print $ getPixel (00,99) image+ saveImage "sin.png" $ image
+ examples/Fuse.hs view
@@ -0,0 +1,39 @@+{-#LANGUAGE ScopedTypeVariables #-}+module Main where++import CV.Drawing+import CV.Filters+import CV.Image+import CV.ColourUtils+import CV.ImageMathOp+import CV.MultiresolutionSpline +import Control.Applicative+import Control.Monad+import Data.Maybe+import System.Environment+import qualified CV.ImageMath as IM+import qualified CV.Transforms as T++merge :: Image GrayScale D32 -> Image GrayScale D32 -> Image GrayScale D32+merge a b = (IM.invert mask #* a) #+ (mask #* b)+ where+ mask = unsafeImageTo32F $ (IM.abs a::Image GrayScale D32) #> (IM.abs b::Image GrayScale D32)++laplacianFusion a b = T.reconstructFromLaplacian $+ zipWith merge + (T.laplacianPyramid 5 a)+ (T.laplacianPyramid 5 b)++sFuser i1 fn = do+ Just i2 <- loadImage fn >>= return . fmap (T.enlarge 5)+ let r = laplacianFusion i1 i2+ r `seq` return r+++main = do+ (fn1:fns) <- getArgs + Just i1 <- loadImage fn1 >>= return . fmap (T.enlarge 5)+ r <- foldM sFuser i1 fns+ saveImage "fusing_result.png" $ stretchHistogram r++
+ examples/MR-Edge.hs view
@@ -0,0 +1,31 @@+{-#LANGUAGE ScopedTypeVariables #-}+module Main where++import CV.ColourUtils+import CV.Drawing+import CV.Filters+import CV.Edges+import CV.Image+import CV.ImageMathOp+import CV.MultiresolutionSpline +import CV.Transforms +import Control.Applicative+import Control.Monad+import Data.Maybe+import System.Environment+import qualified CV.ImageMath as IM+import CV.ConnectedComponents+import CV.Morphology++divLight x = IM.div x (gaussian (135,5) x)++main = do+ Just x <- loadImage "rynkky5.bmp" >>= return . fmap (enlarge n)+ let + operR = unsafeImageTo32F . IM.lessThan (-0.15) . (sobel (1,0) s3)+ operL = unsafeImageTo32F . IM.moreThan (0.005) . (sobel (1,0) s3)+ down oper = take n $ map oper $ iterate pyrDown x+ up oper = foldl1 (\a b -> (pyrUp a) `IM.min` b) $ reverse (down oper)+ saveImage "t2.png" $ (up operL :: Image GrayScale D32)+ where n = 5+
+ examples/PyramidNoise.hs view
@@ -0,0 +1,28 @@+{-#LANGUAGE ScopedTypeVariables #-}+module Main where++import CV.Image+import CV.MultiresolutionSpline +import CV.ImageOp+import CV.Drawing+import CV.Filters+import CV.ImageMathOp+import Control.Applicative+import Data.Maybe+import qualified CV.ImageMath as IM+import CV.Transforms+import System.Environment++absTresh :: D32 -> Image GrayScale D32 -> Image GrayScale D32 +absTresh t a = mask #* a+ where+ mask = unsafeImageTo32F $ t |> (IM.abs a::Image GrayScale D32) ++main = do+ [fn] <- getArgs + Just img <- loadImage fn >>= return.fmap (enlarge 4)+ let reduce = reconstructFromLaplacian . map (absTresh 0.1) . laplacianPyramid 4+ saveImage "denoising_result.png" $ montage (1,2) 2 $ [img,reduce img]+++
+ examples/TestIop.hs view
@@ -0,0 +1,41 @@+module Main where+import CV.Image+import CV.ImageOp+import qualified CV.Filters as F+import CV.ImageMath+import Foreign.Ptr+import CV.ColourUtils+import Prelude hiding (subtract, (.), id)+import qualified CV.ImageMath as IM+import Control.Category+idOp = IOP return++subtract = IOP $ \(a,b) -> do+ withGenImage a $ \ca -> + withGenImage b $ \cb -> cvSub ca cb ca nullPtr >> return a++subtractScalar sc = IOP $ \a -> do+ withGenImage a $ \ca -> + wrapSubS ca (realToFrac sc) ca >> return a++mulScalar sc = IOP $ \a -> do+ withGenImage a $ \ca -> + cvConvertScale ca ca (realToFrac sc) 0 >> return a++liftIOP f = IOP (return.f)++--stretch image = stretched+-- where+-- stretched = (1/realToFrac length) `IM.mulS` normed+-- normed = image `IM.subS` (realToFrac min)+-- length = max-min+-- (min,max) = IM.findMinMax image++ret x = IOP (const (return x))++gaussian s = fromImageOp (F.gaussianOp s)++main = do+ Just x <- loadImage "elaine.jpg"+ let iop = (gaussian (11,11) &#& id) >>> subtract >>> mulScalar 3+ runIOP iop x >>= saveImage "IOPTest.png"
examples/edges.hs view
@@ -1,14 +1,20 @@ module Main where import CV.Image import CV.Edges+import qualified CV.ImageMath as IM+import CV.ColourUtils main = do Just x <- loadImage "smallLena.jpg"- saveImage "edges.png" $ montage (3,2) 5 $+ let + dx = sobel (1,0) s5 x+ dy = sobel (0,1) s5 x+ saveImage "edges.png" $ montage (1,7) 5 $ [x ,sobel (1,0) s5 x ,sobel (0,1) s5 x ,laplace l5 x ,unsafeImageTo32F $ susan (5,5) 0.5 x ,unsafeImageTo32F $ canny 20 40 5 (unsafeImageTo8Bit x)+ ,stretchHistogram $ IM.atan2 dy dx ]
+ examples/fuse1.png view
binary file changed (absent → 429573 bytes)
+ examples/fuse2.png view
binary file changed (absent → 374033 bytes)
examples/video.hs view
@@ -5,15 +5,14 @@ import Utils.Stream main = do- Just x <- loadImage "smallLena.jpg" print "finding capture" Just cap <- captureFromCam (-1) print "capture acquired"- -- Just f <- getFrame cap- --saveImage "video.png" $ f- imgs :: [Image RGB D32] <- runStream . sideEffect (\_ -> print "frame taken") + let frameSize = getFrameSize cap+ writer <- createVideoWriter "test.mpg" MPG4 24 frameSize False+ imgs :: [Image RGB D32] <- runStream . sideEffect (\i -> writeFrame writer (unsafeImageTo8Bit i >> print "frame taken") . takeS (6*6) $ streamFromVideo cap print (map getSize imgs)- saveImage "video.png" $ montage (6,6) 2 (imgs)+ saveImage "video.png" $ montage (length imgs,1) 2 (imgs)
+ examples/video2.hs view
@@ -0,0 +1,20 @@+{-#LANGUAGE ScopedTypeVariables#-}+module Main where+import CV.Image+import CV.Video+import CV.HighGUI+import Utils.Stream+import Control.Concurrent++main = do+ print "finding capture"+ Just cap <- captureFromCam (-1)+ print "capture acquired"+ win <- makeWindow "test"+ let callback i = print i >> setCapProp cap CAP_PROP_GAIN (i/100) >> return ()+ mkTrackbar 100 50 "bar" "test" callback+ runStream_ . sideEffect (\i -> showImage "test" i >> waitKey 20>> print "frame taken") + . takeS (450) + $ streamFromVideo cap+ waitKey 10+ destroyWindow "test"
+ examples/video3.hs view
@@ -0,0 +1,19 @@+{-#LANGUAGE ScopedTypeVariables#-}+module Main where+import CV.Image+import CV.Video+import Utils.Stream++main = do+ Just x <- loadImage "smallLena.jpg"+ print "finding capture"+ Just cap <- captureFromCam (-1)+ print "capture acquired"+ -- Just f <- getFrame cap+ --saveImage "video.png" $ f+ imgs :: [Image RGB D32] <- runStream . sideEffect (\_ -> print "frame taken") + . takeS (6*6) + $ streamFromVideo cap+ print (map getSize imgs)+ saveImage "video.png" $ montage (6,6) 2 (imgs)+