CV 0.3.4 → 0.3.5
raw patch · 70 files changed
+3258/−1258 lines, 70 filesdep +storable-tupledep −haskell98dep ~base
Dependencies added: storable-tuple
Dependencies removed: haskell98
Dependency ranges changed: base
Files
- C2HS.hs +0/−220
- C2HSTools.hs +0/−220
- CV.cabal +109/−30
- CV/Bindings/Calibrate.hsc +1/−22
- CV/Bindings/Core.hsc +230/−0
- CV/Bindings/Drawing.hsc +16/−0
- CV/Bindings/Features.hsc +38/−0
- CV/Bindings/Fittings.hsc +47/−0
- CV/Bindings/ImgProc.hsc +103/−0
- CV/Bindings/Iterators.hsc +22/−0
- CV/Bindings/Matrix.hsc +0/−34
- CV/Bindings/Tracking.hsc +26/−0
- CV/Bindings/Types.hsc +285/−0
- CV/Calibration.chs +6/−3
- CV/ColourUtils.chs +1/−1
- CV/ConnectedComponents.chs +5/−5
- CV/Conversions.hs +7/−7
- CV/Corners.hs +46/−0
- CV/DFT.hs +129/−0
- CV/DrawableInstances.hs +21/−0
- CV/Drawing.chs +61/−22
- CV/Edges.chs +4/−2
- CV/Features.hs +160/−0
- CV/Filters.chs +21/−12
- CV/Fitting.hs +103/−0
- CV/HighGUI.chs +0/−2
- CV/Histogram.chs +101/−79
- CV/HoughTransform.hs +91/−0
- CV/Image.chs +275/−75
- CV/ImageMath.chs +91/−59
- CV/ImageOp.hs +8/−8
- CV/Iterators.hs +72/−0
- CV/LightBalance.chs +2/−1
- CV/Marking.hs +21/−20
- CV/Matrix.hs +53/−26
- CV/Morphology.chs +1/−1
- CV/Operations.hs +80/−0
- CV/Pixelwise.hs +19/−0
- CV/TemplateMatching.chs +3/−1
- CV/Textures.chs +7/−2
- CV/Thresholding.hs +10/−10
- CV/Tracking.hs +43/−0
- CV/Transforms.chs +2/−2
- Utils/DrawingClass.hs +5/−0
- Utils/GeometryClass.hs +53/−0
- Utils/Point.hs +7/−5
- Utils/Pointer.hs +14/−0
- Utils/Rectangle.hs +40/−38
- Utils/Stream.hs +13/−14
- cbits/cvIterators.c +63/−0
- cbits/cvIterators.h +56/−0
- cbits/cvWrapCore.c +69/−0
- cbits/cvWrapCore.h +26/−0
- cbits/cvWrapLEO.c +241/−196
- cbits/cvWrapLEO.h +50/−15
- cbits/wrapImgProc.c +6/−0
- cbits/wrapImgProc.h +8/−0
- examples/ConnectedComponents.hs +21/−0
- examples/Fitting.hs +54/−0
- examples/Fuse.hs +24/−4
- examples/Histograms.hs +15/−0
- examples/Hough.hs +26/−0
- examples/MR-Edge.hs +0/−31
- examples/MeanShift.hs +31/−0
- examples/Monster.hs +37/−25
- examples/StupidConv.hs +0/−35
- examples/montageDebug.hs +0/−16
- examples/mser.hs +23/−0
- examples/pixelwise.hs +10/−15
- examples/surf.hs +46/−0
− C2HS.hs
@@ -1,220 +0,0 @@--- C->Haskell Compiler: Marshalling library------ Copyright (c) [1999...2005] Manuel M T Chakravarty------ Redistribution and use in source and binary forms, with or without--- modification, are permitted provided that the following conditions are met:--- --- 1. Redistributions of source code must retain the above copyright notice,--- this list of conditions and the following disclaimer. --- 2. Redistributions in binary form must reproduce the above copyright--- notice, this list of conditions and the following disclaimer in the--- documentation and/or other materials provided with the distribution. --- 3. The name of the author may not be used to endorse or promote products--- derived from this software without specific prior written permission. ------ THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR--- IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES--- OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN--- NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED--- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR--- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF--- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING--- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS--- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.------- Description --------------------------------------------------------------------- Language: Haskell 98------ This module provides the marshaling routines for Haskell files produced by --- C->Haskell for binding to C library interfaces. It exports all of the--- low-level FFI (language-independent plus the C-specific parts) together--- with the C->HS-specific higher-level marshalling routines.-----module C2HS (-- -- * Re-export the language-independent component of the FFI - module Foreign,-- -- * Re-export the C language component of the FFI- module CForeign,-- -- * Composite marshalling functions- withCStringLenIntConv, peekCStringLenIntConv, withIntConv, withFloatConv,- peekIntConv, peekFloatConv, withBool, peekBool, withEnum, peekEnum,-- -- * Conditional results using 'Maybe'- nothingIf, nothingIfNull,-- -- * Bit masks- combineBitMasks, containsBitMask, extractBitMasks,-- -- * Conversion between C and Haskell types- cIntConv, cFloatConv, cToBool, cFromBool, cToEnum, cFromEnum-) where ---import Foreign- hiding (Word)- -- Should also hide the Foreign.Marshal.Pool exports in- -- compilers that export them-import CForeign--import Monad (when, liftM)----- Composite marshalling functions--- ----------------------------------- Strings with explicit length----withCStringLenIntConv s f = withCStringLen s $ \(p, n) -> f (p, cIntConv n)-peekCStringLenIntConv (s, n) = peekCStringLen (s, cIntConv n)---- Marshalling of numerals-----withIntConv :: (Storable b, Integral a, Integral b) - => a -> (Ptr b -> IO c) -> IO c-withIntConv = with. cIntConv--withFloatConv :: (Storable b, RealFloat a, RealFloat b) - => a -> (Ptr b -> IO c) -> IO c-withFloatConv = with . cFloatConv--peekIntConv :: (Storable a, Integral a, Integral b) - => Ptr a -> IO b-peekIntConv = liftM cIntConv . peek--peekFloatConv :: (Storable a, RealFloat a, RealFloat b) - => Ptr a -> IO b-peekFloatConv = liftM cFloatConv . peek---- Passing Booleans by reference-----withBool :: (Integral a, Storable a) => Bool -> (Ptr a -> IO b) -> IO b-withBool = with . fromBool--peekBool :: (Integral a, Storable a) => Ptr a -> IO Bool-peekBool = liftM toBool . peek----- Passing enums by reference-----withEnum :: (Enum a, Integral b, Storable b) => a -> (Ptr b -> IO c) -> IO c-withEnum = with. cFromEnum--peekEnum :: (Enum a, Integral b, Storable b) => Ptr b -> IO a-peekEnum = liftM cToEnum . peek----- Storing of 'Maybe' values--- ---------------------------instance Storable a => Storable (Maybe a) where- sizeOf _ = sizeOf (undefined :: Ptr ())- alignment _ = alignment (undefined :: Ptr ())-- peek p = do- ptr <- peek (castPtr p)- if ptr == nullPtr- then return Nothing- else liftM Just $ peek ptr-- poke p v = do- ptr <- case v of- Nothing -> return nullPtr- Just v' -> new v'- poke (castPtr p) ptr----- Conditional results using 'Maybe'--- ------------------------------------- Wrap the result into a 'Maybe' type.------ * the predicate determines when the result is considered to be non-existing,--- ie, it is represented by `Nothing'------ * the second argument allows to map a result wrapped into `Just' to some--- other domain----nothingIf :: (a -> Bool) -> (a -> b) -> a -> Maybe b-nothingIf p f x = if p x then Nothing else Just $ f x---- |Instance for special casing null pointers.----nothingIfNull :: (Ptr a -> b) -> Ptr a -> Maybe b-nothingIfNull = nothingIf (== nullPtr)----- Support for bit masks--- ------------------------- Given a list of enumeration values that represent bit masks, combine these--- masks using bitwise disjunction.----combineBitMasks :: (Enum a, Bits b) => [a] -> b-combineBitMasks = foldl (.|.) 0 . map (fromIntegral . fromEnum)---- Tests whether the given bit mask is contained in the given bit pattern--- (i.e., all bits set in the mask are also set in the pattern).----containsBitMask :: (Bits a, Enum b) => a -> b -> Bool-bits `containsBitMask` bm = let bm' = fromIntegral . fromEnum $ bm- in- bm' .&. bits == bm'---- |Given a bit pattern, yield all bit masks that it contains.------ * This does *not* attempt to compute a minimal set of bit masks that when--- combined yield the bit pattern, instead all contained bit masks are--- produced.----extractBitMasks :: (Bits a, Enum b, Bounded b) => a -> [b]-extractBitMasks bits = - [bm | bm <- [minBound..maxBound], bits `containsBitMask` bm]----- Conversion routines--- ----------------------- |Integral conversion----cIntConv :: (Integral a, Integral b) => a -> b-cIntConv = fromIntegral---- |Floating conversion----cFloatConv :: (RealFloat a, RealFloat b) => a -> b-cFloatConv = realToFrac--- As this conversion by default goes via `Rational', it can be very slow...-{-# RULES - "cFloatConv/Float->Float" forall (x::Float). cFloatConv x = x;- "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x- #-}---- |Obtain C value from Haskell 'Bool'.----cFromBool :: Num a => Bool -> a-cFromBool = fromBool---- |Obtain Haskell 'Bool' from C value.----cToBool :: Num a => a -> Bool-cToBool = toBool---- |Convert a C enumeration to Haskell.----cToEnum :: (Integral i, Enum e) => i -> e-cToEnum = toEnum . cIntConv---- |Convert a Haskell enumeration to C.----cFromEnum :: (Enum e, Integral i) => e -> i-cFromEnum = cIntConv . fromEnum
− C2HSTools.hs
@@ -1,220 +0,0 @@--- C->Haskell Compiler: Marshalling library------ Copyright (c) [1999...2005] Manuel M T Chakravarty------ Redistribution and use in source and binary forms, with or without--- modification, are permitted provided that the following conditions are met:--- --- 1. Redistributions of source code must retain the above copyright notice,--- this list of conditions and the following disclaimer. --- 2. Redistributions in binary form must reproduce the above copyright--- notice, this list of conditions and the following disclaimer in the--- documentation and/or other materials provided with the distribution. --- 3. The name of the author may not be used to endorse or promote products--- derived from this software without specific prior written permission. ------ THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR--- IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES--- OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN--- NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED--- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR--- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF--- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING--- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS--- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.------- Description --------------------------------------------------------------------- Language: Haskell 98------ This module provides the marshaling routines for Haskell files produced by --- C->Haskell for binding to C library interfaces. It exports all of the--- low-level FFI (language-independent plus the C-specific parts) together--- with the C->HS-specific higher-level marshalling routines.-----module C2HSTools (-- -- * Re-export the language-independent component of the FFI - module Foreign,-- -- * Re-export the C language component of the FFI- module CForeign,-- -- * Composite marshalling functions- withCStringLenIntConv, peekCStringLenIntConv, withIntConv, withFloatConv,- peekIntConv, peekFloatConv, withBool, peekBool, withEnum, peekEnum,-- -- * Conditional results using 'Maybe'- nothingIf, nothingIfNull,-- -- * Bit masks- combineBitMasks, containsBitMask, extractBitMasks,-- -- * Conversion between C and Haskell types- cIntConv, cFloatConv, cToBool, cFromBool, cToEnum, cFromEnum-) where ---import Foreign- hiding (Word)- -- Should also hide the Foreign.Marshal.Pool exports in- -- compilers that export them-import CForeign--import Monad (when, liftM)----- Composite marshalling functions--- ----------------------------------- Strings with explicit length----withCStringLenIntConv s f = withCStringLen s $ \(p, n) -> f (p, cIntConv n)-peekCStringLenIntConv (s, n) = peekCStringLen (s, cIntConv n)---- Marshalling of numerals-----withIntConv :: (Storable b, Integral a, Integral b) - => a -> (Ptr b -> IO c) -> IO c-withIntConv = with. cIntConv--withFloatConv :: (Storable b, RealFloat a, RealFloat b) - => a -> (Ptr b -> IO c) -> IO c-withFloatConv = with . cFloatConv--peekIntConv :: (Storable a, Integral a, Integral b) - => Ptr a -> IO b-peekIntConv = liftM cIntConv . peek--peekFloatConv :: (Storable a, RealFloat a, RealFloat b) - => Ptr a -> IO b-peekFloatConv = liftM cFloatConv . peek---- Passing Booleans by reference-----withBool :: (Integral a, Storable a) => Bool -> (Ptr a -> IO b) -> IO b-withBool = with . fromBool--peekBool :: (Integral a, Storable a) => Ptr a -> IO Bool-peekBool = liftM toBool . peek----- Passing enums by reference-----withEnum :: (Enum a, Integral b, Storable b) => a -> (Ptr b -> IO c) -> IO c-withEnum = with. cFromEnum--peekEnum :: (Enum a, Integral b, Storable b) => Ptr b -> IO a-peekEnum = liftM cToEnum . peek----- Storing of 'Maybe' values--- ---------------------------instance Storable a => Storable (Maybe a) where- sizeOf _ = sizeOf (undefined :: Ptr ())- alignment _ = alignment (undefined :: Ptr ())-- peek p = do- ptr <- peek (castPtr p)- if ptr == nullPtr- then return Nothing- else liftM Just $ peek ptr-- poke p v = do- ptr <- case v of- Nothing -> return nullPtr- Just v' -> new v'- poke (castPtr p) ptr----- Conditional results using 'Maybe'--- ------------------------------------- Wrap the result into a 'Maybe' type.------ * the predicate determines when the result is considered to be non-existing,--- ie, it is represented by `Nothing'------ * the second argument allows to map a result wrapped into `Just' to some--- other domain----nothingIf :: (a -> Bool) -> (a -> b) -> a -> Maybe b-nothingIf p f x = if p x then Nothing else Just $ f x---- |Instance for special casing null pointers.----nothingIfNull :: (Ptr a -> b) -> Ptr a -> Maybe b-nothingIfNull = nothingIf (== nullPtr)----- Support for bit masks--- ------------------------- Given a list of enumeration values that represent bit masks, combine these--- masks using bitwise disjunction.----combineBitMasks :: (Enum a, Bits b) => [a] -> b-combineBitMasks = foldl (.|.) 0 . map (fromIntegral . fromEnum)---- Tests whether the given bit mask is contained in the given bit pattern--- (i.e., all bits set in the mask are also set in the pattern).----containsBitMask :: (Bits a, Enum b) => a -> b -> Bool-bits `containsBitMask` bm = let bm' = fromIntegral . fromEnum $ bm- in- bm' .&. bits == bm'---- |Given a bit pattern, yield all bit masks that it contains.------ * This does *not* attempt to compute a minimal set of bit masks that when--- combined yield the bit pattern, instead all contained bit masks are--- produced.----extractBitMasks :: (Bits a, Enum b, Bounded b) => a -> [b]-extractBitMasks bits = - [bm | bm <- [minBound..maxBound], bits `containsBitMask` bm]----- Conversion routines--- ----------------------- |Integral conversion----cIntConv :: (Integral a, Integral b) => a -> b-cIntConv = fromIntegral---- |Floating conversion----cFloatConv :: (RealFloat a, RealFloat b) => a -> b-cFloatConv = realToFrac--- As this conversion by default goes via `Rational', it can be very slow...-{-# RULES - "cFloatConv/Float->Float" forall (x::Float). cFloatConv x = x;- "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x- #-}---- |Obtain C value from Haskell 'Bool'.----cFromBool :: Num a => Bool -> a-cFromBool = fromBool---- |Obtain Haskell 'Bool' from C value.----cToBool :: Num a => a -> Bool-cToBool = toBool---- |Convert a C enumeration to Haskell.----cToEnum :: (Integral i, Enum e) => i -> e-cToEnum = toEnum . cIntConv---- |Convert a Haskell enumeration to C.----cFromEnum :: (Enum e, Integral i) => e -> i-cFromEnum = cIntConv . fromEnum
CV.cabal view
@@ -1,5 +1,5 @@ Name: CV-Version: 0.3.4+Version: 0.3.5 Description: OpenCV Bindings License: GPL License-file: LICENSE@@ -14,17 +14,19 @@ Currently this package is quite dirty and requires much work on documentation and code clean-up, but is somewhat tested. .- (The scarce) Documentation is available at - <http://http://aleator.github.com/CV/>+ (The scarce) Documentation is available at+ <http://aleator.github.com/CV/> . Changelog.+ 0.3.5 - Many new wrappers, clean ups and other fixes.+ . 0.3.4 - Pixelwise operations, bug fixes and additional documentation . 0.3.3.0 - Improvements, including compatablity with opencv 2.3.1 and removal of dependency with deprecated JYU.Utils . Changelog.- 0.3.2.0 - Improvements, including fancier pixel-wise manipulations + 0.3.2.0 - Improvements, including fancier pixel-wise manipulations . Changelog. 0.3.0.2 - Workaround for compiling with OS X 10.6 & fixed errors about M_PI@@ -50,34 +52,111 @@ Library Build-Tools: c2hs >= 0.16.0- Include-dirs: cbits/ - Includes: opencv/cv.h, opencv/cxcore.h, opencv/highgui.h, cbits/cvWrapLEO.h- c-sources: cbits/cvWrapLEO.c- install-includes: cbits/cvWrapLEO.h+ Include-dirs: cbits/+ Includes: opencv/cv.h,+ opencv/cxcore.h,+ opencv/highgui.h,+ cbits/cvWrapLEO.h,+ cbits/cvWrapCore.h,+ cbits/wrapImgProc.h,+ cbits/cvIterators.h+ c-sources: cbits/cvWrapLEO.c,+ cbits/cvWrapCore.c,+ cbits/wrapImgProc.c,+ cbits/cvIterators.c+ install-includes: cbits/cvWrapLEO.h,+ cbits/cvWrapCore.h,+ cbits/wrapImgProc.h,+ cbits/cvIterators.h if flag(opencv23)- cpp-options: -DOpenCV23- cc-options: -DOpenCV23+ cpp-options: -DOpenCV23+ cc-options: -DOpenCV23 cc-options: --std=c99 -U__BLOCKS__- extra-libraries: opencv_calib3d,opencv_contrib,opencv_core,opencv_features2d,opencv_highgui,opencv_imgproc,opencv_legacy,opencv_ml,opencv_objdetect,opencv_video- - Build-Depends: haskell98, base >= 3 && < 5, parallel > 3.1, unix > 2.3, array >= 0.2.0.0,- mtl >= 1.1.0, random >= 1.0.0, carray >= 0.1.5, QuickCheck >= 2.1, - containers >= 0.2, - storable-complex, binary >= 0.5, deepseq >= 1.1,- bindings-DSL >= 1.0.14 && < 1.1, vector >= 0.7.0.1 && < 1.1,- lazysmallcheck >= 0.5 && < 1- Exposed-modules: CV.Image, CV.ImageOp, CV.ImageMath CV.Sampling, CV.Edges, CV.Filters, - CV.Morphology, CV.ColourUtils, CV.ImageMathOp, CV.Video,- CV.Textures,CV.Drawing, CV.Thresholding, CV.Histogram, CV.LightBalance,- CV.TemplateMatching, CV.Transforms, CV.Conversions,- CV.Binary, CV.Marking, CV.FunnyStatistics,- CV.MultiresolutionSpline, CV.Gabor,- CV.ConnectedComponents, CV.HighGUI, CV.Calibration- CV.Pixelwise, CV.Matrix, CV.Arbitrary- Utils.List, Utils.Point, Utils.Rectangle, Utils.Stream, Utils.Function- Other-modules: C2HSTools, C2HS, CV.Bindings.Matrix, CV.Bindings.Calibrate- Extensions: CPP+ extra-libraries: opencv_calib3d,+ opencv_contrib,+ opencv_core,+ opencv_features2d,+ opencv_flann,+ opencv_gpu,+ opencv_highgui,+ opencv_imgproc,+ opencv_legacy,+ opencv_ml,+ opencv_objdetect,+ opencv_video + Build-Depends: base >= 4 && < 6,+ parallel > 3.1,+ unix > 2.3,+ array >= 0.2.0.0,+ mtl >= 1.1.0,+ random >= 1.0.0,+ carray >= 0.1.5,+ QuickCheck >= 2.1,+ containers >= 0.2,+ storable-complex,+ binary >= 0.5,+ deepseq >= 1.1,+ bindings-DSL >= 1.0.14 && < 1.1,+ vector >= 0.7.0.1 && < 1.1,+ lazysmallcheck >= 0.5 && < 1,+ storable-tuple >= 0.0.2 && <= 1+ Exposed-modules: CV.Image + ,CV.Arbitrary + ,CV.Binary + ,CV.Bindings.Types + ,CV.Calibration + ,CV.ColourUtils + ,CV.ConnectedComponents + ,CV.Conversions + ,CV.DFT+ ,CV.Corners + ,CV.DrawableInstances + ,CV.Drawing + ,CV.Edges + ,CV.Features + ,CV.Filters + ,CV.Fitting + ,CV.FunnyStatistics + ,CV.Gabor + ,CV.HighGUI + ,CV.Histogram + ,CV.HoughTransform + ,CV.ImageMath CV.Sampling + ,CV.ImageMathOp + ,CV.ImageOp + ,CV.Iterators + ,CV.LightBalance + ,CV.Marking + ,CV.Matrix + ,CV.Morphology + ,CV.MultiresolutionSpline + ,CV.Operations + ,CV.Pixelwise + ,CV.TemplateMatching + ,CV.Textures + ,CV.Thresholding + ,CV.Tracking + ,CV.Transforms + ,CV.Video + ,Utils.DrawingClass + ,Utils.Function + ,Utils.GeometryClass + ,Utils.List + ,Utils.Point + ,Utils.Pointer + ,Utils.Rectangle+ ,Utils.Stream+ Other-modules: CV.Bindings.Matrix,+ CV.Bindings.Calibrate,+ CV.Bindings.Fittings,+ CV.Bindings.Core,+ CV.Bindings.ImgProc,+ CV.Bindings.Tracking,+ CV.Bindings.Drawing,+ CV.Bindings.Features,+ CV.Bindings.Iterators+ Extensions: CPP source-repository head type: git@@ -86,4 +165,4 @@ source-repository head type: git location: http://yousource.it.jyu.fi/cv- +
CV/Bindings/Calibrate.hsc view
@@ -8,34 +8,13 @@ import Foreign.C.Types import CV.Bindings.Matrix import CV.Image+import CV.Bindings.Types #strict_import --- typedef struct--- {--- int width;--- int height;--- }--- CvSize;--#starttype CvSize-#field width , CInt-#field height , CInt-#stoptype--#starttype CvPoint2D32f-#field x , Float-#field y , Float-#stoptype-- #ccall wrapCalibrateCamera2 , Ptr <CvMat> -> Ptr <CvMat> -> Ptr <CvMat> -> Ptr <CvSize> -> Ptr <CvMat> -> Ptr <CvMat> -> Ptr <CvMat> -> Ptr <CvMat> -> CInt -> IO Double #ccall wrapFindCornerSubPix , Ptr BareImage -> Ptr <CvPoint2D32f> -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Double -> IO ()--#num CV_TERMCRIT_ITER-#num CV_TERMCRIT_EPS- #num CV_CALIB_USE_INTRINSIC_GUESS #num CV_CALIB_FIX_ASPECT_RATIO
+ CV/Bindings/Core.hsc view
@@ -0,0 +1,230 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module CV.Bindings.Core where++import Foreign.C.Types+import CV.Bindings.Types+import CV.Image(BareImage)++#strict_import++#include <bindings.dsl.h>+#include "cvWrapCore.h"+#include <opencv2/core/core_c.h>++-- CVAPI(IplImage*) cvCreateImage(+-- CvSize size,+-- int depth,+-- int channels+-- );++-- Creates IPL image (header and data)++-- need to use wrapper functions since passing struct by value.++-- #ccall wrapCreateImage , CInt -> CInt -> CInt -> CInt -> IO (Ptr IplImage)++-- Releases IPL image header and data+-- CVAPI(void) cvReleaseImage(+-- IplImage** image+-- );++-- Allocates and initializes CvMat header and allocates data+-- CVAPI(CvMat*) cvCreateMat(+-- int rows,+-- int cols,+-- int type+-- );++-- Releases CvMat header and deallocates matrix data+-- (reference counting is used for data)+-- CVAPI(void) cvReleaseMat(+-- CvMat** mat+-- );++-- CVAPI(void) cvSet(+-- CvArr* arr,+-- CvScalar value,+-- const CvArr* mask CV_DEFAULT(NULL)+-- );++-- Sets all or "masked" elements of input array+-- to the same value++-- need to use wrapper functions since passing struct by value.++#ccall wrapSet , Ptr <CvArr> -> Ptr <CvScalar> -> Ptr <CvArr> -> IO ()+#ccall wrapSetAll , Ptr <CvArr> -> CDouble -> Ptr <CvArr> -> IO ()+#ccall wrapSet1 , Ptr <CvArr> -> CDouble -> Ptr <CvArr> -> IO ()+#ccall wrapSet2 , Ptr <CvArr> -> CDouble -> CDouble -> Ptr <CvArr> -> IO ()+#ccall wrapSet3 , Ptr <CvArr> -> CDouble -> CDouble -> CDouble -> Ptr <CvArr> -> IO ()+#ccall wrapSet4 , Ptr <CvArr> -> CDouble -> CDouble -> CDouble -> CDouble -> Ptr <CvArr> -> IO ()++-- CVAPI(void) cvSetZero(+-- CvArr* arr+-- );++-- Clears all the array elements (sets them to 0)++#ccall cvSetZero , Ptr <CvArr> -> IO ()++-- CVAPI(void) cvSplit(+-- const CvArr* src,+-- CvArr* dst0,+-- CvArr* dst1,+-- CvArr* dst2,+-- CvArr* dst3+-- );++-- Splits a multi-channel array into the set of single-channel arrays or+-- extracts particular [color] plane++#ccall cvSplit , Ptr <CvArr> -> Ptr <CvArr> -> Ptr <CvArr> -> Ptr <CvArr> -> Ptr <CvArr> -> IO ()++-- |CVAPI(void) cvMerge(+-- | const CvArr* src0,+-- | const CvArr* src1,+-- | const CvArr* src2,+-- | const CvArr* src3,+-- | CvArr* dst+-- |);+-- |Merges a set of single-channel arrays into the single multi-channel array+-- |or inserts one particular [color] plane to the array+#ccall cvMerge , Ptr <CvArr> -> Ptr <CvArr> -> Ptr <CvArr> -> Ptr <CvArr> -> Ptr <CvArr> -> IO ()++-- CVAPI(void) cvCartToPolar(+-- const CvArr* x,+-- const CvArr* y,+-- CvArr* magnitude,+-- CvArr* angle CV_DEFAULT(NULL),+-- int angle_in_degrees CV_DEFAULT(0)+-- );++-- Does cartesian->polar coordinates conversion.+-- Either of output components (magnitude or angle) is optional++#ccall cvCartToPolar , Ptr <CvArr> -> Ptr <CvArr> -> Ptr <CvArr> -> Ptr <CvArr> -> CInt -> IO ()++-- | CVAPI(void) cvPolarToCart(+-- | const CvArr* magnitude,+-- | const CvArr* angle,+-- | CvArr* x,+-- | CvArr* y,+-- | int angle_in_degrees CV_DEFAULT(0)+-- | );++-- | Does polar->cartesian coordinates conversion.+-- Either of output components (magnitude or angle) is optional.+-- If magnitude is missing it is assumed to be all 1's+#ccall cvPolarToCart , Ptr <CvArr> -> Ptr <CvArr> -> Ptr <CvArr> -> Ptr <CvArr> -> CInt -> IO ()++-- | CVAPI(void) cvMinMaxLoc(+-- | const CvArr* arr,+-- | double* min_val,+-- | double* max_val,+-- | CvPoint* min_loc CV_DEFAULT(NULL),+-- | CvPoint* max_loc CV_DEFAULT(NULL),+-- | const CvArr* mask CV_DEFAULT(NULL)+-- | );++-- | Finds global minimum, maximum and their positions+#ccall cvMinMaxLoc , Ptr <CvArr> -> Ptr CDouble -> Ptr CDouble -> Ptr <CvPoint> -> Ptr <CvPoint> -> Ptr <CvArr> -> IO ()++-- | CVAPI(void) cvAvgSdv(+-- | const CvArr* arr,+-- | CvScalar* mean,+-- | CvScalar* std_dev,+-- | const CvArr* mask CV_DEFAULT(NULL)+-- | );++-- | Calculates mean and standard deviation of pixel values.+#ccall cvAvgSdv , Ptr BareImage -> Ptr <CvScalar> -> Ptr <CvScalar> -> Ptr <CvArr> -> IO ()++-- types of array norm++#num CV_C+#num CV_L1+#num CV_L2+#num CV_NORM_MASK+#num CV_RELATIVE+#num CV_DIFF+#num CV_MINMAX++#num CV_DIFF_C+#num CV_DIFF_L1+#num CV_DIFF_L2+#num CV_RELATIVE_C+#num CV_RELATIVE_L1+#num CV_RELATIVE_L2++-- CVAPI(void) cvNormalize(+-- const CvArr* src,+-- CvArr* dst,+-- double a CV_DEFAULT(1.),+-- double b CV_DEFAULT(0.),+-- int norm_type CV_DEFAULT(CV_L2),+-- const CvArr* mask CV_DEFAULT(NULL)+-- );++#ccall cvNormalize , Ptr <CvArr> -> Ptr <CvArr> -> CDouble -> CDouble -> CInt -> Ptr <CvArr> -> IO ()++-- stuff related to DFT++#num CV_DXT_FORWARD+#num CV_DXT_INVERSE+#num CV_DXT_SCALE+#num CV_DXT_INV_SCALE+#num CV_DXT_ROWS+#num CV_DXT_MUL_CONJ+#num CV_DXT_COMPLEX_OUTPUT+#num CV_DXT_REAL_OUTPUT+#num CV_DXT_INV_REAL++-- CVAPI(void) cvDFT(+-- const CvArr* src,+-- CvArr* dst,+-- int flags,+-- int nonzero_rows CV_DEFAULT(0)+-- );++-- Discrete Fourier Transform:+-- complex->complex,+-- real->ccs (forward),+-- ccs->real (inverse)++#ccall cvDFT , Ptr <CvArr> -> Ptr <CvArr> -> CInt -> CInt -> IO ()++-- #ccall cvWrapDFT , Ptr <CvArr> -> Ptr <CvArr> -> IO ()++-- #ccall cvWrapIDFT , Ptr <CvArr> -> Ptr <CvArr> -> IO ()++-- CVAPI(void) cvMulSpectrums(+-- const CvArr* src1,+-- const CvArr* src2,+-- CvArr* dst,+-- int flags+-- );++#ccall swapQuadrants, Ptr <CvArr> -> IO ()++-- Multiply results of DFTs: DFT(X)*DFT(Y) or DFT(X)*conj(DFT(Y))++#ccall cvMulSpectrums , Ptr <CvArr> -> Ptr <CvArr> -> Ptr <CvArr> -> CInt -> IO ()++-- CVAPI(int) cvGetOptimalDFTSize(+-- int size0+-- );++-- Finds optimal DFT vector size >= size0+-- Note: this function has no side effects, thus not called in IO monad.++#ccall cvGetOptimalDFTSize , CInt -> CInt++-- CVAPI(void) cvDCT(+-- const CvArr* src+-- CvArr* dst,+-- int flags+-- );++-- Discrete Cosine Transform++#ccall cvDCT , Ptr <CvArr> -> Ptr <CvArr> -> CInt -> IO ()
+ CV/Bindings/Drawing.hsc view
@@ -0,0 +1,16 @@+{-# LANGUAGE ForeignFunctionInterface#-}+module CV.Bindings.Drawing where+import Foreign.C.Types+import Foreign.Storable+import Foreign.Ptr+import Foreign.Marshal.Utils+import Utils.GeometryClass+import GHC.Float+import CV.Bindings.Types++#strict_import++#include <bindings.dsl.h>+#include "cvWrapLEO.h"++#ccall wrapEllipseBox, Ptr <CvArr> -> Ptr <CvBox2D> -> Ptr <CvScalar> -> CInt -> CInt -> CInt -> IO ()
+ CV/Bindings/Features.hsc view
@@ -0,0 +1,38 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module CV.Bindings.Features where++import Foreign.C.Types+import CV.Bindings.Types++#strict_import++#include <bindings.dsl.h>+#include <opencv/cv.h>++#starttype CvSURFParams+#field extended, CInt+#field hessianThreshold, CDouble+#field nOctaves, CInt+#field nOctaveLayers, CInt+#stoptype++#ccall wrapExtractSURF, Ptr <CvArr> -> Ptr <CvArr> -> Ptr (Ptr <CvSeq>) -> Ptr (Ptr <CvSeq>) -> Ptr <CvMemStorage> -> Ptr <CvSURFParams> -> Int -> IO ()++#starttype CvMSERParams+#field delta, Int+#field maxArea, Int+#field minArea, Int+#field maxVariation, Float+#field minDiversity, Float+#field maxEvolution, Int+#field areaThreshold, Double+#field minMargin, Double+#field edgeBlurSize, Int+#stoptype++#ccall wrapExtractMSER, Ptr <CvArr> -> Ptr <CvArr> -> Ptr (Ptr <CvSeq>) -> Ptr <CvMemStorage> -> Ptr <CvMSERParams> -> IO ()++#ccall cvMoments , Ptr <CvArr> -> Ptr <CvMoments> -> Int -> IO ()+#ccall cvGetSpatialMoment, Ptr <CvMoments> -> CInt -> CInt -> IO CDouble+#ccall cvGetNormalizedCentralMoment, Ptr <CvMoments> -> CInt -> CInt -> IO CDouble+#ccall cvGetCentralMoment, Ptr <CvMoments> -> CInt -> CInt -> IO CDouble
+ CV/Bindings/Fittings.hsc view
@@ -0,0 +1,47 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module CV.Bindings.Fittings where+import Data.Word+import Foreign.C.Types+import Foreign.Ptr+import Foreign.Storable+import CV.Bindings.Types++#include <bindings.dsl.h>+#include "cvWrapLEO.h"++#ccall wrapFitEllipse , Ptr <CvArr> -> Ptr <CvBox2D> -> IO ()+#ccall cvFitLine , Ptr <CvArr> -> CInt -> Double -> Double -> Double-> Ptr Float -> IO ()+#ccall cvConvexHull2 , Ptr <CvArr> -> Ptr () -> CInt -> CInt -> IO (Ptr <CvSeq>)+#ccall cvConvexityDefects, Ptr <CvArr> -> Ptr <CvArr> -> Ptr <CvMemStorage> ->IO (Ptr <CvSeq>)+#ccall wrapMinAreaRect2 , Ptr <CvArr> -> Ptr <CvMemStorage> -> Ptr <CvBox2D> -> IO ()+#ccall wrapBoundingRect , Ptr <CvArr> -> CInt -> Ptr <CvRect> -> IO ()+#ccall cvMinEnclosingCircle, Ptr <CvArr> -> Ptr <CvPoint2D32f> -> Ptr CFloat -> IO ()++#num CV_DIST_USER +#num CV_DIST_L1 +#num CV_DIST_L2 +#num CV_DIST_C +#num CV_DIST_L12 +#num CV_DIST_FAIR +#num CV_DIST_WELSCH +#num CV_DIST_HUBER ++data Dist = + Dist_User + | Dist_L1 + | Dist_L2 + | Dist_C + | Dist_L12 + | Dist_Fair + | Dist_Welsch + | Dist_Huber ++toNum Dist_User = c'CV_DIST_USER +toNum Dist_L1 = c'CV_DIST_L1 +toNum Dist_L2 = c'CV_DIST_L2 +toNum Dist_C = c'CV_DIST_C +toNum Dist_L12 = c'CV_DIST_L12 +toNum Dist_Fair = c'CV_DIST_FAIR +toNum Dist_Welsch = c'CV_DIST_WELSCH+toNum Dist_Huber = c'CV_DIST_HUBER +
+ CV/Bindings/ImgProc.hsc view
@@ -0,0 +1,103 @@+{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}+module CV.Bindings.ImgProc where++import Foreign.C.Types+import Foreign.Ptr+import Foreign.Marshal.Utils+import Foreign.Marshal.Array+import Foreign.ForeignPtr hiding (newForeignPtr)+import Foreign.Concurrent+import CV.Bindings.Types+import CV.Bindings.Core+import CV.Image+import System.IO.Unsafe++import CV.Bindings.Matrix+#strict_import++#include <bindings.dsl.h>+#include <opencv2/imgproc/imgproc_c.h>+#include "cvWrapLEO.h"+#include "wrapImgProc.h"++-- CVAPI(void) cvCopyMakeBorder(+-- const CvArr* src,+-- CvArr* dst,+-- CvPoint offset,+-- int bordertype,+-- CvScalar value CV_DEFAULT(cvScalarAll(0))+-- );++-- Copies source 2D array inside of the larger destination array and+-- makes a border of the specified type (IPL_BORDER_*) around the copied area.++#ccall wrapCopyMakeBorder , Ptr <CvArr> -> CInt -> CInt -> CInt -> CInt -> CInt -> CFloat -> IO (Ptr BareImage)++data BorderType = BorderConstant | BorderReplicate | BorderReflect | BorderWrap++cBorderType t = case t of+ BorderConstant -> c'IPL_BORDER_CONSTANT+ BorderReplicate -> c'IPL_BORDER_REPLICATE+ BorderReflect -> c'IPL_BORDER_REFLECT+ BorderWrap -> c'IPL_BORDER_WRAP++copyMakeBorder :: Image d c -> Int -> Int -> Int -> Int -> BorderType -> Float -> IO (Image d c)+copyMakeBorder i t b l r border value =+ withGenImage i $ \iptr ->+ creatingImage $+ c'wrapCopyMakeBorder iptr+ (fromIntegral t)+ (fromIntegral b)+ (fromIntegral l)+ (fromIntegral r)+ (cBorderType border)+ (realToFrac value)++-- CVAPI(void) cvCornerHarris(+-- const CvArr* image,+-- CvArr* harris_responce,+-- int block_size,+-- int aperture_size CV_DEFAULT(3),+-- double k CV_DEFAULT(0.04)+-- );++#ccall cvCornerHarris , Ptr <CvArr> -> Ptr <CvArr> -> Int -> Int -> Double -> IO ()++-- CVAPI(CvSeq*) cvHoughLines2(+-- CvArr* image,+-- void* line_storage,+-- int method,+-- double rho,+-- double theta,+-- int threshold,+-- double param1 CV_DEFAULT(0),+-- double param2 CV_DEFAULT(0)+-- );++#num CV_HOUGH_STANDARD+#num CV_HOUGH_PROBABILISTIC+#num CV_HOUGH_MULTI_SCALE+#num CV_HOUGH_GRADIENT++#ccall cvHoughLines2, Ptr <CvArr> -> Ptr () -> Int -> Double -> Double -> Int -> Double -> Double -> IO ()++#ccall wrapFilter2, Ptr <CvArr> -> Ptr <CvArr> -> Ptr <CvMat> -> Ptr <CvPoint> -> IO ()++#ccall cvCalcArrBackProject, Ptr (Ptr <IplImage>) -> Ptr <CvArr> -> Ptr <CvHistogram> -> IO ()++#num CV_HIST_ARRAY++#ccall cvCreateHist, Int -> Ptr Int -> Int -> Ptr (Ptr Float) -> Int -> IO (Ptr <CvHistogram>)+#ccall cvReleaseHist, Ptr (Ptr <CvHistogram>) -> IO ()+#ccall cvCalcArrHist, Ptr (Ptr <IplImage>) -> Ptr <CvHistogram> -> Int -> Ptr <CvArr> -> IO ()++newtype Histogram = Histogram (ForeignPtr C'CvHistogram)+creatingHistogram fun = do+ iptr :: Ptr C'CvHistogram <- fun+ fptr :: ForeignPtr C'CvHistogram <- newForeignPtr iptr (with iptr c'cvReleaseHist)+ return . Histogram $ fptr+++emptyUniformHistogramND dims =+ withArray dims $ \c_sizes ->+ c'cvCreateHist 1 c_sizes c'CV_HIST_ARRAY nullPtr 1
+ CV/Bindings/Iterators.hsc view
@@ -0,0 +1,22 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module CV.Bindings.Iterators where++import Foreign.Ptr+import CV.Bindings.Types+import CV.Image(BareImage)++#strict_import++#include <bindings.dsl.h>+#include "cvIterators.h"++#starttype F32_image_iterator+#field image_data , Ptr Float+#stoptype++#ccall alloc_F32_image_iterator , IO (Ptr <F32_image_iterator>)+#ccall free_F32_image_iterator , Ptr <F32_image_iterator> -> IO ()+#ccall F32_create_rowwise_iterator , Ptr <F32_image_iterator> -> Ptr BareImage -> IO ()+#ccall F32_next , Ptr <F32_image_iterator> -> IO (Ptr <F32_image_iterator>)+#ccall F32_val , Ptr <F32_image_iterator> -> Ptr CFloat+#ccall F32_rowwise_pos , Ptr <F32_image_iterator> -> Ptr <CvPoint>
CV/Bindings/Matrix.hsc view
@@ -34,40 +34,6 @@ #num CV_GEMM_B_T #num CV_GEMM_C_T -#num CV_8UC1 -#num CV_8UC2 -#num CV_8UC3 -#num CV_8UC4 --#num CV_8SC1 -#num CV_8SC2 -#num CV_8SC3 -#num CV_8SC4 --#num CV_16UC1 -#num CV_16UC2 -#num CV_16UC3 -#num CV_16UC4 --#num CV_16SC1 -#num CV_16SC2 -#num CV_16SC3 -#num CV_16SC4 --#num CV_32SC1 -#num CV_32SC2 -#num CV_32SC3 -#num CV_32SC4 --#num CV_32FC1 -#num CV_32FC2 -#num CV_32FC3 -#num CV_32FC4 --#num CV_64FC1 -#num CV_64FC2 -#num CV_64FC3 -#num CV_64FC4 -- typedef struct CvMat
+ CV/Bindings/Tracking.hsc view
@@ -0,0 +1,26 @@+{-# LANGUAGE ForeignFunctionInterface #-}++#include <bindings.dsl.h>+#include "cvWrapLEO.h"+#include <opencv2/legacy/legacy.hpp>++module CV.Bindings.Tracking where+import Data.Word+import Foreign.C.Types+import CV.Bindings.Matrix+import CV.Image+import CV.Bindings.Types++#strict_import++#ccall wrapCamShift, Ptr <CvArr> -> Ptr <CvRect> -> Ptr <CvTermCriteria>-> Ptr <CvConnectedComp> -> Ptr <CvBox2D> -> IO ()++#ccall wrapMeanShift, Ptr <CvArr> -> Ptr <CvRect> -> Ptr <CvTermCriteria> -> Ptr <CvConnectedComp> -> IO ()++-- void wrapSnakeImage(const IplImage* image, CvPoint* points, int length, float* alpha, float* beta, float* gamma, int coeff_usage, CvSize win, CvTermCriteria criteria, int calc_gradient=1)¶++#ccall cvSnakeImage, Ptr <IplImage> -> Ptr <CvPoint> -> Int -> Ptr Float -> Ptr Float -> Ptr Float -> Int -> Ptr <CvSize> -> Ptr <CvTermCriteria> -> Int -> IO ()++#num CV_VALUE+#num CV_ARRAY+
+ CV/Bindings/Types.hsc view
@@ -0,0 +1,285 @@+{-# LANGUAGE ForeignFunctionInterface, TypeFamilies #-}+module CV.Bindings.Types where++import Data.Word+import Foreign.C.Types+import Foreign.Storable+import Foreign.Ptr+import Foreign.Marshal.Utils+import Foreign.Marshal.Array+import Utils.GeometryClass+import Utils.Rectangle+import GHC.Float++#strict_import++#include <bindings.dsl.h>+#include "cvWrapLEO.h"++#num IPL_DEPTH_1U+#num IPL_DEPTH_8U+#num IPL_DEPTH_16U+#num IPL_DEPTH_32F+#num IPL_DEPTH_8S+#num IPL_DEPTH_16S+#num IPL_DEPTH_32S++#num IPL_BORDER_CONSTANT+#num IPL_BORDER_REPLICATE+#num IPL_BORDER_REFLECT+#num IPL_BORDER_WRAP++#opaque_t IplImage+#opaque_t CvMemStorage+#opaque_t CvSeqBlock+#opaque_t CvArr++#opaque_t CvHistogram++#starttype CvSeq+#field flags, CInt+#field header_size, CInt+#field h_prev, Ptr <CvSeq>+#field h_next, Ptr <CvSeq>+#field v_prev, Ptr <CvSeq>+#field v_next, Ptr <CvSeq>+#field total, CInt+#field elem_size, CInt+#field block_max, Ptr Char+#field ptr, Ptr Char+#field delta_elems, CInt+#field free_blocks, Ptr <CvSeqBlock>+#field first, Ptr <CvSeqBlock>+#stoptype++#ccall extractCVSeq, Ptr <CvSeq> -> Ptr () -> IO ()+#ccall cvGetSeqElem, Ptr <CvSeq> -> CInt -> IO (Ptr CChar)+#ccall printSeq, Ptr <CvSeq> -> IO ()++-- | Convert a CvSeq object into list of its contents. Note that+-- since CvSeq can be approximately anything, including a crazy man from the moon,+-- this is pretty unsafe and you must make sure that `a` is actually the element+-- in the seq, and the seq is something that remotely represents a sequence of elements.+cvSeqToList :: (Storable a) => Ptr C'CvSeq -> IO [a]+cvSeqToList ptrseq = do+ seq <- peek ptrseq+ dest <- mallocArray (fromIntegral $ c'CvSeq'total seq)+ c'extractCVSeq ptrseq (castPtr dest)+ peekArray (fromIntegral $ c'CvSeq'total seq) dest+++#starttype CvRect+#field x , CInt+#field y , CInt+#field width , CInt+#field height , CInt+#stoptype++instance BoundingBox C'CvRect where+ type ELBB C'CvRect = Int+ bounds (C'CvRect x y w h) = Rectangle (f x) (f y) (f w) (f h)+ where f = fromIntegral++instance FromBounds C'CvRect where+ type ELFB C'CvRect = Int+ fromBounds (Rectangle x y w h) = C'CvRect (f x) (f y) (f w) (f h)+ where f = fromIntegral++#starttype CvScalar+#field val[0] , CDouble+#field val[1] , CDouble+#field val[2] , CDouble+#field val[3] , CDouble+#stoptype++-- CV_INLINE CvScalar cvScalar(+-- double val0,+-- double val1 CV_DEFAULT(0),+-- double val2 CV_DEFAULT(0),+-- double val3 CV_DEFAULT(0)+-- )++-- #cinline cvScalar , CDouble -> CDouble -> CDouble -> CDouble -> IO(<CvScalar>)++-- CV_INLINE CvScalar cvRealScalar(+-- double val0+-- )++-- #cinline cvRealScalar , CDouble -> IO(<CvScalar>)++-- CV_INLINE CvScalar cvScalarAll(+-- double val0123+-- )++-- #cinline cvScalarAll , CDouble -> IO(<CvScalar>)++-- CvSize++#starttype CvSize+#field width , CInt+#field height , CInt+#stoptype++#starttype CvSize2D32f+#field width , CFloat+#field height , CFloat+#stoptype++#starttype CvConnectedComp+#field area, CDouble+#field value, <CvScalar>+#field rect, <CvRect>+#field contour, Ptr <CvSeq>+#stoptype++#starttype CvPoint+#field x , CInt+#field y , CInt+#stoptype++instance Point2D C'CvPoint where+ type ELP C'CvPoint = Int+ pt (C'CvPoint x y) = (fromIntegral x,fromIntegral y)+ toPt (x,y) = C'CvPoint (fromIntegral x) (fromIntegral y)++#starttype CvPoint2D32f+#field x , CFloat+#field y , CFloat+#stoptype++instance Point2D C'CvPoint2D32f where+ type ELP C'CvPoint2D32f = Double+ pt (C'CvPoint2D32f x y) = (realToFrac x,realToFrac y)+ toPt (x,y) = C'CvPoint2D32f (realToFrac x) (realToFrac y)++-- // #starttype CV_32FC2+-- // #field x , Float+-- // #field y , Float+-- // #stoptype++mkCvPoint2D32F (x,y) = C'CvPoint2D32f x y++#starttype CvBox2D+#field center ,<CvPoint2D32f>+#field size ,<CvSize2D32f>+#field angle ,CFloat+#stoptype++-- #startype CvHistogram+-- #field type, Int+-- #field bins, Ptr <CvArr>+-- #array_field thresh, Ptr (Ptr Float)+-- #field thresh2, Ptr (Ptr Float)+-- #array_field mat, <CvMatND>+-- #endtype++++#starttype CvMoments+#field m00, CDouble+#field m10, CDouble+#field m01, CDouble+#field m20, CDouble+#field m11, CDouble+#field m02, CDouble+#field m30, CDouble+#field m21, CDouble+#field m12, CDouble+#field m03, CDouble++#field mu20, CDouble+#field mu11, CDouble+#field mu02, CDouble+#field mu30, CDouble+#field mu21, CDouble+#field mu12, CDouble+#field mu03, CDouble++#field inv_sqrt_m00, CDouble+#stoptype++#starttype CvTermCriteria+#field type, CInt+#field max_iter, CInt+#field epsilon, Double+#stoptype++data TermCriteria = EPS Double | ITER Int deriving (Show, Eq)++toCvTCrit (EPS d) = C'CvTermCriteria c'CV_TERMCRIT_EPS 0 d+toCvTCrit (ITER i) = C'CvTermCriteria c'CV_TERMCRIT_ITER (fromIntegral i) 0++#num CV_TERMCRIT_ITER +#num CV_TERMCRIT_NUMBER +#num CV_TERMCRIT_EPS +++-- Memory Storage+#ccall cvCreateMemStorage, Int -> IO (Ptr <CvMemStorage>)+#ccall cvReleaseMemStorage, Ptr (Ptr <CvMemStorage>) -> IO ()++withNewMemory fun = do+ mem <- c'cvCreateMemStorage 0+ res <- fun mem+ with mem c'cvReleaseMemStorage+ return res+++#num CV_8UC1+#num CV_8UC2+#num CV_8UC3+#num CV_8UC4++#num CV_8SC1+#num CV_8SC2+#num CV_8SC3+#num CV_8SC4++#num CV_16UC1+#num CV_16UC2+#num CV_16UC3+#num CV_16UC4++#num CV_16SC1+#num CV_16SC2+#num CV_16SC3+#num CV_16SC4++#num CV_32SC1+#num CV_32SC2+#num CV_32SC3+#num CV_32SC4++#num CV_32FC1+#num CV_32FC2+#num CV_32FC3+#num CV_32FC4++#num CV_64FC1+#num CV_64FC2+#num CV_64FC3+#num CV_64FC4++#num CV_CLOCKWISE+#num CV_COUNTER_CLOCKWISE++#starttype CvConvexityDefect+#field start , Ptr <CvPoint +#field end , Ptr <CvPoint>+#field depth_point, Ptr <CvPoint>+#field depth , CFloat+#stoptype++#starttype CvSURFPoint+#field pt, <CvPoint2D32f>+#field laplacian, CInt+#field size, CInt+#field dir, CFloat+#field hessian, CFloat+#stoptype++instance Point2D C'CvSURFPoint where+ type ELP C'CvSURFPoint = Float+ pt (C'CvSURFPoint (C'CvPoint2D32f x y) _ _ _ _) = (realToFrac x,realToFrac y)+ toPt (x,y) = C'CvSURFPoint (C'CvPoint2D32f (realToFrac x) (realToFrac y)) 0 0 0 0+
CV/Calibration.chs view
@@ -27,22 +27,25 @@ -- * Camera calibration ,calibrateCamera2) where {-#OPTIONS-GHC -fwarn-unused-imports #-}+ import Foreign.C.Types import Foreign.C.String import Foreign.ForeignPtr import Foreign.Storable import Foreign.Marshal.Array+import Foreign.Marshal.Utils import Foreign.Ptr import Data.Bits import CV.Image -import C2HSTools+import System.IO.Unsafe import Utils.Point import Control.Applicative import CV.Matrix import CV.Bindings.Calibrate+import CV.Bindings.Types {#import CV.Image#} @@ -88,8 +91,8 @@ c'wrapFindCornerSubPix c_img c_corners (length pts) winW winH zeroW zeroH tType maxIter epsilon map fromPt `fmap` peekArray (length pts) c_corners where- mkPt (x,y) = C'CvPoint2D32f x y- fromPt (C'CvPoint2D32f x y) = (x,y)+ mkPt (x,y) = C'CvPoint2D32f (realToFrac x) (realToFrac y)+ fromPt (C'CvPoint2D32f x y) = (realToFrac x,realToFrac y) tType = c'CV_TERMCRIT_ITER maxIter = 100 epsilon = 0.01
CV/ColourUtils.chs view
@@ -21,7 +21,7 @@ import qualified CV.ImageMath as IM import CV.ImageMathOp -import C2HS+import System.IO.Unsafe -- TODO: Rename this entire module to something else. Everything here is grayscale :/
CV/ConnectedComponents.chs view
@@ -23,13 +23,13 @@ where #include "cvWrapLEO.h" -import Foreign.Ptr+import Control.Monad ((>=>)) import Foreign.C.Types-import System.IO.Unsafe import Foreign.ForeignPtr-import Control.Monad ((>=>))--import C2HSTools+import Foreign.Marshal.Alloc+import Foreign.Marshal.Array+import Foreign.Ptr+import System.IO.Unsafe {#import CV.Image#}
CV/Conversions.hs view
@@ -1,5 +1,5 @@ {-#LANGUAGE ForeignFunctionInterface#-}--- |This module provides slow but functional means for exporting images from and to +-- |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@@ -22,7 +22,7 @@ ,acquireImageSlow8URGB' ) where -import Complex+import Data.Complex import CV.Image import Data.Word@@ -67,7 +67,7 @@ -- |Copy D32 grayscale image to CArray copyImageToFCArray :: Image GrayScale D32 -> CArray (Int,Int) Float copyImageToFCArray (S img) = unsafePerformIO $- withBareImage img $ \cimg -> + withBareImage img $ \cimg -> createCArray ((0,0),(w-1,h-1)) (exportImageSlowF' cimg) --({#call exportImageSlow#} cimg) where (w,h) = getSize img@@ -86,14 +86,14 @@ -- |Copy the contents of a CV.Image into a CArray. copyImageToCArray :: Image GrayScale D32 -> CArray (Int,Int) Double copyImageToCArray (S img) = unsafePerformIO $- withBareImage img $ \cimg -> + withBareImage img $ \cimg -> 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 -> +copyImageToExistingCArray (S img) arr =+ withBareImage img $ \cimg -> withCArray arr $ \carr -> (exportImageSlow' cimg carr) --({#call exportImageSlow#} cimg) where (w,h) = getSize img@@ -101,7 +101,7 @@ -- |Copy image as a real part of a complex CArray copyImageToComplexCArray :: Image GrayScale D32 -> CArray (Int,Int) (Complex Double) copyImageToComplexCArray (S img) = unsafePerformIO $- withBareImage img $ \cimg -> + withBareImage img $ \cimg -> createCArray ((0,0),(w-1,h-1)) (exportImageSlowComplex' cimg) --({#call exportImageSlow#} cimg) where (w,h) = getSize img
+ CV/Corners.hs view
@@ -0,0 +1,46 @@+module CV.Corners+( HarrisDesc+, Corner(..)+, ImageWithCorners(..)+, harris+, harrisCorners+) where++import CV.Bindings.Types+import CV.Bindings.Core+import CV.Bindings.ImgProc+import CV.Image+import CV.Operations+import CV.Iterators+import System.IO.Unsafe++type HarrisDesc = Float++data Corner d =+ Corner+ { pos :: (Int,Int)+ , desc :: d+ }++data ImageWithCorners d =+ ImageWithCorners+ { image :: Image GrayScale D32+ , corners :: [Corner d]+ }++harris :: Int -> Int -> Double -> Image GrayScale D32 -> Image GrayScale D32+harris bs as k src =+ unsafePerformIO $ do+ withCloneValue src $ \clone ->+ withGenImage src $ \si ->+ withGenImage clone $ \ci -> do+ c'cvCornerHarris si ci bs as k+ return clone++-- threshold for selecting harris corners+-- image _with_harris_applied_ (TODO: describe images with operations applied to them?)+-- result is an image normalize to [0..1] range, and a list of found corners+harrisCorners :: Float -> Image GrayScale D32 -> ImageWithCorners HarrisDesc+harrisCorners t src = (ImageWithCorners src cs)+ where+ cs = map (\(p,v) -> (Corner p v)) $ filterPixels (>t) $ normalize 1 0 NormMinMax $ harris 2 3 0.04 $ src
+ CV/DFT.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE ScopedTypeVariables #-}+module CV.DFT where++import CV.Bindings.Core+import CV.Bindings.ImgProc+import CV.Bindings.Types+import CV.Image+import CV.Operations++import Foreign.Ptr (castPtr,nullPtr)+import System.IO.Unsafe++type I32 = Image GrayScale D32+type Idft32 = Image DFT D32+data Icomplex32 = Icomplex32{ re :: I32, im :: I32 }+data Ipolar32 = Ipolar32{ magnitude :: I32, phase :: I32 }++dft :: Image GrayScale d -> Image DFT D32+dft i = unsafePerformIO $ do+ --n::(Image GrayScale D32) <- create (w', h')+ --n <- copyMakeBorder i 0 (h'-h) 0 (w'-w) BorderReplicate 0+ z::(Image GrayScale D32) <- create (w, h)+ d::(Image DFT D32) <- create (w, h)+ withImage i $ \i_ptr ->+ withImage z $ \z_ptr ->+ withImage d $ \d_ptr -> do+ c'cvMerge (castPtr i_ptr) (castPtr z_ptr) nullPtr nullPtr (castPtr d_ptr)+ c'cvDFT (castPtr d_ptr) (castPtr d_ptr) c'CV_DXT_FORWARD (fromIntegral 0)+ c'swapQuadrants (castPtr d_ptr)+ return d+ where+ (w,h) = getSize i+ --w' = fromIntegral $ c'cvGetOptimalDFTSize (fromIntegral w)+ --h' = fromIntegral $ c'cvGetOptimalDFTSize (fromIntegral h)++idft :: Image DFT D32 -> Image GrayScale D32+idft d = unsafePerformIO $ do+ n::(Image GrayScale D32) <- create s+ --z::(Image GrayScale D32) <- create s+ withImage d $ \d_ptr ->+ withImage n $ \n_ptr -> do+ --withImage z $ \z_ptr -> do+ c'swapQuadrants (castPtr d_ptr)+ c'cvDFT (castPtr d_ptr) (castPtr n_ptr) c'CV_DXT_INV_SCALE (fromIntegral 0)+ --c'cvSplit (castPtr d_ptr) (castPtr n_ptr) (castPtr z_ptr) nullPtr nullPtr+ return n+ where+ s = getSize d++dftSplit :: Image DFT D32 -> (Image GrayScale D32, Image GrayScale D32)+dftSplit d = unsafePerformIO $ do+ re::(Image GrayScale D32) <- create (w, h)+ im::(Image GrayScale D32) <- create (w, h)+ withImage d $ \d_ptr ->+ withImage re $ \re_ptr ->+ withImage im $ \im_ptr -> do+ c'cvSplit (castPtr d_ptr) (castPtr re_ptr) (castPtr im_ptr) nullPtr nullPtr+ return (re,im)+ where+ (w,h) = getSize d++dftMerge :: (Image GrayScale D32, Image GrayScale D32) -> Image DFT D32+dftMerge (re,im) = unsafePerformIO $ do+ d::(Image DFT D32) <- create (w, h)+ withImage re $ \re_ptr ->+ withImage im $ \im_ptr ->+ withImage d $ \d_ptr -> do+ c'cvMerge (castPtr re_ptr) (castPtr im_ptr) nullPtr nullPtr (castPtr d_ptr)+ return d+ where+ (w,h) = getSize re++dftToPolar :: Image DFT D32 -> (Image GrayScale D32, Image GrayScale D32)+dftToPolar d = unsafePerformIO $ do+ mag::(Image GrayScale D32) <- create (w, h)+ ang::(Image GrayScale D32) <- create (w, h)+ withImage re $ \re_ptr ->+ withImage im $ \im_ptr ->+ withImage mag $ \mag_ptr ->+ withImage ang $ \ang_ptr ->+ c'cvCartToPolar (castPtr re_ptr) (castPtr im_ptr) (castPtr mag_ptr) (castPtr ang_ptr) (fromIntegral 0)+ return (mag,ang)+ where+ (re,im) = dftSplit d+ (w,h) = getSize d++dftFromPolar :: (Image GrayScale D32, Image GrayScale D32) -> Image DFT D32+dftFromPolar (mag,ang) = unsafePerformIO $ do+ re::(Image GrayScale D32) <- create (w, h)+ im::(Image GrayScale D32) <- create (w, h)+ withImage mag $ \mag_ptr ->+ withImage ang $ \ang_ptr ->+ withImage re $ \re_ptr -> do+ withImage im $ \im_ptr -> do+ c'cvPolarToCart (castPtr mag_ptr) (castPtr ang_ptr) (castPtr re_ptr) (castPtr im_ptr) (fromIntegral 0)+ return $ dftMerge (re,im)+ where+ (w,h) = getSize mag++--withPolar :: Image DFT D32 ->+-- ((Image GrayScale D32, Image GrayScale D32) -> (Image GrayScale D32, Image GrayScale D32)) ->+-- Image DFT D32+++rgbSplit :: Image RGB D32 -> (Image GrayScale D32, Image GrayScale D32, Image GrayScale D32)+rgbSplit i = unsafePerformIO $ do+ r::(Image GrayScale D32) <- create (w, h)+ g::(Image GrayScale D32) <- create (w, h)+ b::(Image GrayScale D32) <- create (w, h)+ withImage i $ \i_ptr ->+ withImage r $ \r_ptr ->+ withImage g $ \g_ptr ->+ withImage b $ \b_ptr -> do+ c'cvSplit (castPtr i_ptr) (castPtr r_ptr) (castPtr g_ptr) (castPtr b_ptr) nullPtr+ return (r,g,b)+ where+ (w,h) = getSize i++rgbMerge :: (Image GrayScale D32, Image GrayScale D32, Image GrayScale D32) -> Image RGB D32+rgbMerge (r,g,b) = unsafePerformIO $ do+ i::(Image RGB D32) <- create (w, h)+ withImage r $ \r_ptr ->+ withImage g $ \g_ptr ->+ withImage b $ \b_ptr ->+ withImage i $ \i_ptr -> do+ c'cvMerge (castPtr r_ptr) (castPtr g_ptr) (castPtr b_ptr) nullPtr (castPtr i_ptr)+ return i+ where+ (w,h) = getSize r
+ CV/DrawableInstances.hs view
@@ -0,0 +1,21 @@+{-#LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies #-}+module CV.DrawableInstances where+import Utils.DrawingClass +import Utils.GeometryClass+import CV.Drawing +import CV.Image+import CV.ImageOp+import CV.Bindings.Types+import CV.Bindings.Features+++instance Draws C'CvSURFPoint (ImageOperation GrayScale D32) where+ draw (C'CvSURFPoint (C'CvPoint2D32f x y) l s d h) + = circleOp 1 (round x, round y) (fromIntegral s) (Stroked 1) + #> lineOp 1 1 (round x,round y) (round $ x+fromIntegral s*cos (realToFrac d)+ ,round $ y+fromIntegral s*sin (realToFrac d)) + +instance Draws C'CvPoint2D32f (ImageOperation GrayScale D32) where+ draw (C'CvPoint2D32f x y) = circleOp 1 (round x, round y) 3 Filled+ +
CV/Drawing.chs view
@@ -1,4 +1,5 @@-{-#LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, TypeSynonymInstances#-}+{-#LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, TypeSynonymInstances, + ViewPatterns, FlexibleContexts #-} #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@@ -13,7 +14,7 @@ ,Drawable(..) -- * Extra drawing operations ,drawLinesOp- ,rectOpS+ ,drawBox2Dop -- * Floodfill operations ,fillOp ,floodfill@@ -28,13 +29,19 @@ import Foreign.C.String import Foreign.ForeignPtr import Foreign.Marshal.Array+import Foreign.Marshal.Utils import Foreign.Marshal.Alloc import System.IO.Unsafe import Control.Monad(when)+import CV.Bindings.Types+import CV.Bindings.Drawing+import Utils.Point {#import CV.Image#} import CV.ImageOp+import Utils.GeometryClass+import Utils.Rectangle -- | Is the shape filled or just a boundary? data ShapeStyle = Filled | Stroked Int@@ -55,10 +62,30 @@ -- | 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+ rectOp :: (BoundingBox bb, Integral (ELBB bb)) => (Color a b) -> Int -> bb -> ImageOperation a b -- | Draw a filled polygon fillPolyOp :: (Color a b) -> [(Int,Int)] -> ImageOperation a b+ ellipseBoxOp :: (Color a b) -> C'CvBox2D -> Int -> Int -> ImageOperation a b +primRectOp (r,g,b) t (bounds -> Rectangle x y w h) = ImgOp $ \i -> do+ withGenImage i $ \img -> + {#call wrapDrawRectangle#} img (fromIntegral x)+ (fromIntegral y) (fromIntegral $ x+w) (fromIntegral $ y+h)+ (realToFrac r) (realToFrac g)(realToFrac b)(fromIntegral t)++-- | Primitive form of ellipse box. Not typesafe, not for end user.+primEllipseBox :: (D32,D32,D32,D32) -> C'CvBox2D -> Int -> Int -> ImageOperation c d++primEllipseBox (a,b,c,e) box thickness shift = + ImgOp $ \i -> + withGenImage i $ \c_img -> + with box $ \c_box ->+ with (C'CvScalar (rtf a) (rtf b) (rtf c) (rtf 0)) $ \c_color -> + c'wrapEllipseBox c_img c_box c_color (fromIntegral thickness) 8 + (fromIntegral shift)++rtf = realToFrac+ instance Drawable RGB D32 where type Color RGB D32 = (D32,D32,D32) putTextOp (r,g,b) size text (x,y) = ImgOp $ \img -> do@@ -75,17 +102,18 @@ (realToFrac r) (realToFrac g) (realToFrac b) (fromIntegral t) + ellipseBoxOp (r,g,b) = primEllipseBox (r,g,b,0) ++ circleOp (red,g,b) (x,y) r s = ImgOp $ \i -> do when (r>0) $ withGenImage i $ \img -> ({#call wrapDrawCircle#} img (fromIntegral x) (fromIntegral y) (fromIntegral r) (realToFrac red) (realToFrac g) (realToFrac b) $ styleToCV s)- rectOp (r,g,b) t (x,y) (x1,y1) = ImgOp $ \i -> do- withGenImage i $ \img -> - {#call wrapDrawRectangle#} img (fromIntegral x)- (fromIntegral y) (fromIntegral x1) (fromIntegral y1)- (realToFrac r) (realToFrac g)(realToFrac b)(fromIntegral t)++ rectOp c = primRectOp c+ fillPolyOp (r,g,b) pts = ImgOp $ \i -> do withImage i $ \img -> do let (xs,ys) = unzip pts@@ -121,13 +149,9 @@ (fromIntegral r) (realToFrac c) (realToFrac c) (realToFrac c) $ styleToCV s)-- rectOp c t (x,y) (x1,y1) = ImgOp $ \i -> do- withGenImage i $ \img -> - {#call wrapDrawRectangle#} img (fromIntegral x)- (fromIntegral y) (fromIntegral x1) (fromIntegral y1)- (realToFrac c)(realToFrac c)(realToFrac c) (fromIntegral t)+ ellipseBoxOp c = primEllipseBox (c,c,c,0) + rectOp c = primRectOp (c,c,c) fillPolyOp c pts = ImgOp $ \i -> do withImage i $ \img -> do let (xs,ys) = unzip pts@@ -140,11 +164,6 @@ 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 = @@ -157,10 +176,11 @@ toCINT True = 1 -- | Apply rectOp to an image-rectangle :: Drawable c d => Color c d -> Int -> (Int, Int) -> (Int, Int) -> Image c d+rectangle :: (BoundingBox bb, Integral (ELBB bb), Drawable c d) + => Color c d -> Int -> bb -> Image c d -> IO (Image c d)-rectangle color thickness a b i = - operate (rectOp color thickness a b ) i+rectangle color thickness rect i = + operate (rectOp color thickness rect) i -- | Apply fillPolyOp to an image fillPoly :: Drawable c d => Color c d -> [(Int, Int)] -> Image c d -> IO (Image c d)@@ -177,6 +197,25 @@ -> IO (Image c d) drawLines img color thickness segments = operateOn img (drawLinesOp color thickness segments)++-- | Draw C'CvBox2D+drawBox2Dop :: Drawable c d => Color c d -> C'CvBox2D -> ImageOperation c d+drawBox2Dop color (C'CvBox2D (C'CvPoint2D32f (realToFrac -> x) (realToFrac ->y))+ (C'CvSize2D32f (realToFrac -> w) (realToFrac ->h)) + (degToRad -> θ)) + = drawLinesOp color 1 (zip corners $ tail (cycle corners)) + where+ rot (x,y) = (x * sin (-θ) - y * cos (-θ)+ ,x * cos (-θ) + y * sin (-θ))+ corners = map (both round . (+ (x,y)) . rot) + [( 0.5*h, 0.5*w)+ ,(-0.5*h, 0.5*w)+ ,(-0.5*h, -0.5*w)+ ,( 0.5*h, -0.5*w) ]+ both f (a,b) = (f a, f b)++degToRad deg = deg/180*pi+ -- | Apply circleOp to an image circle :: Drawable c d => (Int, Int) -> Int -> Color c d -> ShapeStyle -> Image c d -> Image c d
CV/Edges.chs view
@@ -1,4 +1,5 @@-{-#LANGUAGE ForeignFunctionInterface#-}+{-#LANGUAGE ForeignFunctionInterface #-}+ #include "cvWrapLEO.h" -- | This module is a collection of simple edge detectors. module CV.Edges (@@ -22,11 +23,12 @@ import CV.Image {#import CV.Image#} -import C2HSTools+import System.IO.Unsafe -- | 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+ sobelOp :: (Int,Int) -> SobelAperture -> ImageOperation GrayScale D32 sobelOp (dx,dy) (Sb aperture)
+ CV/Features.hs view
@@ -0,0 +1,160 @@+{-#LANGUAGE RecordWildCards, ScopedTypeVariables, TypeFamilies#-}+module CV.Features (SURFParams, defaultSURFParams, getSURF+ ,getMSER, MSERParams, mkMSERParams, defaultMSERParams+ ,moments,Moments,getSpatialMoment,getCentralMoment,getNormalizedCentralMoment) where+import CV.Image+import CV.Bindings.Types+import CV.Bindings.Features+import Foreign.Ptr+import Control.Monad+import Foreign.Storable+import Foreign.Marshal.Array+import Foreign.Marshal.Utils+import Utils.GeometryClass+import System.IO.Unsafe++newtype MSERParams = MP C'CvMSERParams deriving (Show)++-- | Create parameters for getMSER.+mkMSERParams :: Int -- ^ Delta+ -> Int -- ^ prune the area which bigger than maxArea+ -> Int -- ^ prune the area which smaller than minArea+ -> Float -- ^ prune the area have similar size to its children+ -> Float -- ^ trace back to cut off mser with diversity < min_diversity+ -> Int -- ^ for color image, the evolution steps+ -> Double -- ^ the area threshold to cause re-initialize+ -> Double -- ^ ignore too small margin+ -> Int -- ^ the aperture size for edge blur+ -> MSERParams++mkMSERParams a b c d e f g h i= MP $ C'CvMSERParams a b c d e f g h i+defaultMSERParams = mkMSERParams 5 14400 60 0.25 0.2 200 1.01 0.003 5++-- | The function encapsulates all the parameters of the MSER extraction algorithm (see+-- <http://en.wikipedia.org/wiki/Maximally_stable_extremal_regions>+getMSER :: (Point2D a, ELP a~Int)+ => Image GrayScale D8 -> Maybe (Image GrayScale D8) -> MSERParams -> [[a]]+getMSER image mask (MP params) = unsafePerformIO $+ withMask mask $ \ptr_mask ->+ with nullPtr $ \ptr_ptr_contours ->+ withNewMemory $ \ptr_mem ->+ with params $ \ptr_params ->+ withImage image $ \ptr_image -> do+ c'wrapExtractMSER (castPtr ptr_image) ptr_mask ptr_ptr_contours+ ptr_mem ptr_params+ ptr_contours <- peek ptr_ptr_contours+ forM [0..10] $ \ix -> do+ ptr_ctr <- c'cvGetSeqElem ptr_contours ix+ ctr <- peek (castPtr ptr_ctr)+ pts :: [C'CvPoint] <- cvSeqToList ctr+ return (map convertPt pts)+++-- TODO: Move this to some utility module+withMask :: Maybe (Image GrayScale D8) -> (Ptr C'CvArr -> IO α) -> IO α+withMask m f = case m of+ Just m -> withImage m (f.castPtr)+ Nothing -> f nullPtr++-- | Parameters for SURF feature extraction+newtype SURFParams = SP C'CvSURFParams deriving Show+mkSURFParams :: Double+ -- ^ only features with keypoint.hessian+ -- larger than that are extracted.+ -- good default value is ~300-500 (can depend on the+ -- average local contrast and sharpness of the image).+ -- user can further filter out some features based on+ -- their hessian values and other characteristics.+ -> Int+ -- ^ The number of octaves to be used for extraction.+ -- With each next octave the feature size is doubled+ -- (3 by default)+ -> Int+ -- ^ The number of layers within each octave (4 by default)+ -> Bool+ -- ^ If true, getSurf returns extended descriptors of 128 floats. Otherwise+ -- returns 64 floats.+ -> SURFParams+mkSURFParams a b c d = SP $ C'CvSURFParams (fromBool d)+ (realToFrac a)+ (fromIntegral b)+ (fromIntegral c)+++-- | Default parameters for getSURF+defaultSURFParams :: SURFParams+defaultSURFParams = mkSURFParams 400 3 4 False++-- | Extract Speeded Up Robust Features from an image.+getSURF :: SURFParams+ -- ^ Method parameters. See `defaultSURFParams` and `mkSURFParams`+ -> Image GrayScale D8+ -- ^ Input GrayScale image+ -> Maybe (Image GrayScale D8)+ -- ^ Optional Binary mask image+ -> [(C'CvSURFPoint,[Float])]+getSURF (SP params) image mask = unsafePerformIO $+ withNewMemory $ \ptr_mem ->+ withMask mask $ \ptr_mask ->+ with nullPtr $ \ptr_ptr_keypoints ->+ with nullPtr $ \ptr_ptr_descriptors ->+ with params $ \ptr_params ->+ withImage image $ \ptr_image -> do+ ptr_keypoints' <- peek ptr_ptr_keypoints+ c'wrapExtractSURF (castPtr ptr_image) ptr_mask ptr_ptr_keypoints+ ptr_ptr_descriptors ptr_mem ptr_params 0+ ptr_keypoints <- peek ptr_ptr_keypoints+ ptr_descriptors <- peek ptr_ptr_descriptors+ a <- cvSeqToList ptr_keypoints+ b <- if c'CvSURFParams'extended params /= 1+ then do+ es :: [FloatBlock128] <- cvSeqToList ptr_descriptors+ return (map (\(FP128 e) -> e) es)+ else do+ es :: [FloatBlock64] <- cvSeqToList ptr_descriptors+ return (map (\(FP64 e) -> e) es)+ return (zip a b)++newtype FloatBlock64 = FP64 [Float] deriving (Show)+newtype FloatBlock128 = FP128 [Float] deriving (Show)++instance Storable FloatBlock64 where+ sizeOf _ = sizeOf (undefined :: Float) * 64+ alignment _ = 4+ peek ptr = FP64 `fmap` peekArray 64 (castPtr ptr)+ poke ptr (FP64 e) = pokeArray (castPtr ptr) e++instance Storable FloatBlock128 where+ sizeOf _ = sizeOf (undefined :: Float) * 128+ alignment _ = 4+ peek ptr = FP128 `fmap` peekArray 128 (castPtr ptr)+ poke ptr (FP128 e) = pokeArray (castPtr ptr) e+++type Moments = C'CvMoments+++moments :: Image GrayScale D32 -> Moments+moments img = unsafePerformIO $+ withGenImage img $ \c_img ->+ with (C'CvMoments 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) $ \res -> do+ c'cvMoments c_img res 0+ peek res++getSpatialMoment :: (Int,Int) -> Moments -> Double+getSpatialMoment (x,y) m = realToFrac $+ unsafePerformIO $+ with m $ \c_m ->+ c'cvGetSpatialMoment c_m (fromIntegral x) (fromIntegral y)++getCentralMoment :: (Int,Int) -> Moments -> Double+getCentralMoment (x,y) m = realToFrac $+ unsafePerformIO $+ with m $ \c_m ->+ c'cvGetCentralMoment c_m (fromIntegral x) (fromIntegral y)++getNormalizedCentralMoment :: (Int,Int) -> Moments -> Double+getNormalizedCentralMoment (x,y) m = realToFrac $+ unsafePerformIO $+ with m $ \c_m ->+ c'cvGetNormalizedCentralMoment c_m (fromIntegral x) (fromIntegral y)
CV/Filters.chs view
@@ -1,5 +1,7 @@ {-#LANGUAGE ForeignFunctionInterface, TypeFamilies, FlexibleInstances#-} #include "cvWrapLEO.h"+{-#OPTIONS_GHC -fwarn-unused-imports#-}+ -- | This module is a collection of various image filters module CV.Filters(gaussian,gaussianOp ,blurOp,blur,blurNS@@ -9,16 +11,19 @@ ,secondMomentAdaptiveBinarize,secondMomentAdaptiveBinarizeOp ,selectiveAvg,convolve2D,convolve2DI,haar,haarAt ,IntegralImage(),integralImage,verticalAverage) where+ import Foreign.C.Types-import Foreign.C.String-import Foreign.ForeignPtr import Foreign.Ptr+import Foreign.Marshal.Utils+import CV.Bindings.ImgProc -import CV.Image +import Utils.GeometryClass+import CV.Matrix (Matrix,withMatPtr) import CV.ImageOp-import Debug.Trace -import C2HSTools+import System.IO.Unsafe++--import C2HSTools {#import CV.Image#} -- Low level wrapper for Susan filtering:@@ -145,13 +150,17 @@ -- Convolve image with specified kernel stored in flat list. -- Kernel must have dimensions (w,h) and specified anchor point -- (x,y) within (0,0) and (w,h)-convolve2D (w,h) (x,y) kernel image = unsafePerformIO $ - withImage image $ \img->- withArray kernel $ \k ->- creatingImage $- {#call wrapFilter2D#} - img x y w h k-+convolve2D :: (Point2D anchor, ELP anchor ~ Int) => + Matrix D32 -> anchor -> Image GrayScale D32 -> Image GrayScale D32+convolve2D kernel anchor image = unsafePerformIO $ + let result = emptyCopy image+ in withGenImage image $ \c_img->+ withGenImage result $ \c_res->+ withMatPtr kernel $ \c_mat ->+ with (convertPt anchor) $ \c_pt ->+ c'wrapFilter2 c_img c_res c_mat c_pt+ >> return result+ convolve2DI (x,y) kernel image = unsafePerformIO $ withImage image $ \img-> withImage kernel $ \k ->
+ CV/Fitting.hs view
@@ -0,0 +1,103 @@+{-#LANGUAGE TypeFamilies#-}+module CV.Fitting where++import CV.Bindings.Fittings+import CV.Bindings.Types+import CV.Matrix+import CV.Image(getSize)+import Control.Applicative+import Foreign.C.Types+import Foreign.Marshal.Alloc+import Foreign.Marshal.Array+import Foreign.Marshal.Utils+import Foreign.Ptr+import Foreign.Storable+import System.IO.Unsafe+import Utils.GeometryClass++data Ellipse = Ellipse {center::(Float,Float)+ ,width,height::Float+ ,angle :: Float} deriving (Eq,Show)++-- | Given a (1,n) or (n,1) matrix of points, calculate+-- (in the least squares sense) the best ellipse around the+-- points+fitEllipse :: Matrix (Float,Float) -> Ellipse+fitEllipse pts = unsafePerformIO $+ withMatPtr pts $ \cMat ->+ alloca $ \result -> do+ c'wrapFitEllipse+ (castPtr cMat)+ result+ C'CvBox2D (C'CvPoint2D32f x y)+ (C'CvSize2D32f w h)+ a <- peek result+ return (Ellipse (realToFrac x,realToFrac y)+ (realToFrac w)+ (realToFrac h)+ (realToFrac a))++-- | Fit a line to set of points.+fitLine2D :: Dist -> Double -> Double -> Double+ -> Matrix (Float,Float)+ -> ((Float,Float),(Float,Float))+fitLine2D dist_type param reps aeps pts = unsafePerformIO $+ withMatPtr pts $ \cMat ->+ allocaArray 4 $ \result -> do+ c'cvFitLine+ (castPtr cMat)+ (toNum dist_type) param reps aeps result+ [x,y,dx,dy] <- peekArray 4 result+ return ((x,y),(dx,dy))++-- | Fit a minimum area rectangle over a set of points+minAreaRect :: Matrix (Float,Float) -> C'CvBox2D+minAreaRect pts = unsafePerformIO $ + withMatPtr pts $ \cMat ->+ with (C'CvBox2D (C'CvPoint2D32f 0 0) (C'CvSize2D32f 0 0) 0) $ \result -> do+ c'wrapMinAreaRect2 (castPtr cMat) nullPtr result+ peek result++-- | Calculate the minimum axis-aligned bounding rectangle of given points.+boundingRect :: Matrix (Float,Float) -> C'CvRect+boundingRect pts = unsafePerformIO $ + withMatPtr pts $ \cMat ->+ with (C'CvRect 0 0 0 0) $ \result -> do+ c'wrapBoundingRect (castPtr cMat) 0 result+ peek result++-- | Calculate the minimum enclosing circle of a point set.+boundingCircle :: (ELP a ~ Double, Point2D a) => Matrix (Float,Float) -> (a, Double)+boundingCircle pts = unsafePerformIO $ + withMatPtr pts $ \cMat ->+ with 0 $ \cRadius -> + with (C'CvPoint2D32f 0 0 ) $ \result -> do+ c'cvMinEnclosingCircle (castPtr cMat) result cRadius+ (,) <$> (convertPt <$> peek result) <*> (realToFrac <$> peek cRadius)++-- | Calculcate the clockwise convex hull of a point set+convexHull :: Matrix (Float,Float) -> Matrix (Float,Float)+convexHull pts = + let res = create (getSize pts) :: Matrix (Float,Float)+ in unsafePerformIO $+ withMatPtr pts $ \cMat ->+ withMatPtr res $ \cRes ->+ withNewMemory $ \ptr_mem -> do+ with (C'CvPoint2D32f 0 0 ) $ \result -> do+ c'cvConvexHull2 (castPtr cMat) (castPtr cRes) c'CV_CLOCKWISE 1+ return res++-- | Calculate convexity defects of a contour.+convexityDefects :: Matrix (Int,Int) -> [(C'CvPoint, C'CvPoint, C'CvPoint,CFloat)]+convexityDefects pts = unsafePerformIO $+ withMatPtr pts $ \cMat ->+ withNewMemory $ \ptr_mem -> do+ ptr_hull_seq <- c'cvConvexHull2 (castPtr cMat) (castPtr ptr_mem) c'CV_CLOCKWISE 0+ ptr_seq <- c'cvConvexityDefects (castPtr cMat) (castPtr ptr_hull_seq) (castPtr ptr_mem)+ pts <- cvSeqToList ptr_seq+ sequence [(,,,) <$> peek (c'CvConvexityDefect'start x )+ <*> peek (c'CvConvexityDefect'end x )+ <*> peek (c'CvConvexityDefect'depth_point x )+ <*> return (c'CvConvexityDefect'depth x)+ | x <- pts ]+
CV/HighGUI.chs view
@@ -6,8 +6,6 @@ import Foreign.ForeignPtr import Foreign.Ptr -import C2HSTools- import CV.Image {#import CV.Image#} import CV.ImageOp
CV/Histogram.chs view
@@ -1,4 +1,4 @@-{-#LANGUAGE ForeignFunctionInterface#-}+{-#LANGUAGE ForeignFunctionInterface,DatatypeContexts#-} #include "cvWrapLEO.h" module CV.Histogram where @@ -10,36 +10,75 @@ import Data.Array.ST import Foreign.C.Types import Foreign.ForeignPtr+import Foreign.Marshal.Array+import Foreign.Marshal.Alloc import Foreign.Ptr-import C2HSTools-+import CV.Bindings.Types+import qualified CV.Bindings.ImgProc as I import System.IO.Unsafe+import Utils.Pointer -- import Utils.List newtype (Num a) => HistogramData a = HGD [(a,a)] --- Assume [0,1] distribution and calculate skewness-skewness bins image = do- hg <- buildHistogram cbins image- bins <- mapM (getBin hg) [0..cbins-1]- let avg = sum bins / (fromIntegral.length) bins- let u3 = sum.map (\(value,bin) -> - (value-avg)*(value-avg)*(value-avg)- *bin) $- zip binValues bins - let u2 = sum.map (\(value,bin) -> - (value-avg)*(value-avg)- *bin) $- zip binValues bins - - return (u3 / (sqrt u2*sqrt u2*sqrt u2))- where- cbins :: CInt- cbins = fromIntegral bins- binValues = [0,fstep..1]- fstep = 1/(fromIntegral bins)+-- | Given a set of images, such as the color channels of color image, and+-- a histogram with corresponding number of channels, replace the pixels of+-- the image with the likelihoods from the histogram+backProjectHistogram :: [Image GrayScale D8] -> I.Histogram -> Image GrayScale D8+backProjectHistogram images@(img:_) (I.Histogram hist) = unsafePerformIO $ do+ r <- cloneImage img+ withImage r $ \c_r ->+ withPtrList (map imageFPTR images) $ \ptrs ->+ withForeignPtr hist $ \c_hist ->+ I.c'cvCalcArrBackProject (castPtr ptrs) (castPtr c_r) c_hist+ return r+backProjectHistogram _ _ = error "Empty list of images" +-- | Calculate an opencv histogram object from set of images, each with it's+-- own number of bins.+histogram :: [(Image GrayScale D8, Int)] -> Bool -> Maybe (Image GrayScale D8)+ -> I.Histogram++histogram imageBins accumulate mask = unsafePerformIO $+ I.creatingHistogram $ do+ hist <- I.emptyUniformHistogramND ds+ withPtrList (map imageFPTR images) $ \ptrs ->+ case mask of+ Just m -> do+ withImage m $ \c_mask -> do+ I.c'cvCalcArrHist (castPtr ptrs) hist c_accumulate (castPtr c_mask)+ return hist+ Nothing -> do+ I.c'cvCalcArrHist (castPtr ptrs) hist c_accumulate (nullPtr)+ return hist+ where+ (images,ds) = unzip imageBins+ c_accumulate = 0++-- getHistogramBin (I.Histogram hs) n = unsafePerformIO $ withForeignPtr hs (\h -> I.c'cvGetHistValue_1D (castPtr h) n)++---- Assume [0,1] distribution and calculate skewness+--skewness bins image = do+-- hg <- buildHistogram cbins image+-- bins <- mapM (getBin hg) [0..cbins-1]+-- let avg = sum bins / (fromIntegral.length) bins+-- let u3 = sum.map (\(value,bin) ->+-- (value-avg)*(value-avg)*(value-avg)+-- *bin) $+-- zip binValues bins+-- let u2 = sum.map (\(value,bin) ->+-- (value-avg)*(value-avg)+-- *bin) $+-- zip binValues bins+----+-- return (u3 / (sqrt u2*sqrt u2*sqrt u2))+-- where+-- cbins :: CInt+-- cbins = fromIntegral bins+-- binValues = [0,fstep..1]+-- fstep = 1/(fromIntegral bins)+ values (HGD a) = snd.unzip $ a -- This does not make any sense!@@ -50,7 +89,7 @@ cmpEuclidian a b = sum $ (zipWith (\x y -> (x-y)^2) a b) cmpAbs a b = sum $ (zipWith (\x y -> abs (x-y)) a b) -chiSqrHG a b = chiSqr (values a) (values b) +chiSqrHG a b = chiSqr (values a) (values b) chiSqr a b = sum $ zipWith (calc) a b where calc a b = (a-b)*(a-b) `divide` (a+b)@@ -63,99 +102,82 @@ liftValues op (HGD a) = zip bins (op values) where (bins,values) = unzip a -sub (HGD a) (HGD b) | bins a == bins b +sub (HGD a) (HGD b) | bins a == bins b = HGD $ zip (bins a) values where bins a = map fst a msnd = map snd values = zipWith (-) (msnd a) (msnd b)- + noBins (HGD a) = length a getPositivePart (HGD a) = HGD $ dropWhile ((<0).fst) a tcumulate [] = [] tcumulate values = tail $ scanl (+) 0 values -getCumulativeNormalHistogram binCount image - = HGD $ zip bins $ tcumulate values- where- HGD lst = getNormalHistogram binCount image- bins :: [Double]- values :: [Double]- (bins,values) = unzip lst+--getCumulativeNormalHistogram binCount image+-- = HGD $ zip bins $ tcumulate values+-- where+-- HGD lst = getNormalHistogram binCount image+-- bins :: [Double]+-- values :: [Double]+-- (bins,values) = unzip lst -weightedHistogram img weights start end binCount = unsafePerformIO $ - withImage img $ \i -> +weightedHistogram img weights start end binCount = unsafePerformIO $+ withImage img $ \i -> withImage weights $ \w -> do bins <- mallocArray (fromIntegral binCount)- {#call get_weighted_histogram#} i w (realToFrac start) - (realToFrac end) + {#call get_weighted_histogram#} i w (realToFrac start)+ (realToFrac end) (fromIntegral binCount) bins r <- peekArray binCount bins >>= return.map realToFrac free bins return r -- TODO: Add binary images-simpleGetHistogram :: Image GrayScale D32 -> Maybe (Image GrayScale D8) +simpleGetHistogram :: Image GrayScale D32 -> Maybe (Image GrayScale D8) -> D32 -> D32 -> Int -> Bool -> [D32] simpleGetHistogram img mask start end binCount cumulative = unsafePerformIO $ withImage img $ \i -> do- bins <- mallocArray binCount + bins <- mallocArray binCount let isCum | cumulative == True = 1 | cumulative == False = 0- + case mask of (Just msk) -> do withImage msk $ \m -> do- {#call get_histogram#} i m (realToFrac start) (realToFrac end) + {#call get_histogram#} i m (realToFrac start) (realToFrac end) isCum (fromIntegral binCount) bins- Nothing -> {#call get_histogram#} i (nullPtr) - (realToFrac start) (realToFrac end) + Nothing -> {#call get_histogram#} i (nullPtr)+ (realToFrac start) (realToFrac end) isCum (fromIntegral binCount) bins r <- peekArray binCount bins >>= return.map realToFrac free bins- return r + return r - - - -getNormalHistogram bins image = HGD new- where- (HGD lst) = getHistogram bins image - value :: [Double]- bin :: [Double]- (bin,value) = unzip lst- new = zip bin $ map (/size) value- size = fromIntegral $ uncurry (*) $ getSize image -getHistogram :: Int -> Image GrayScale D32 -> HistogramData Double-getHistogram bins image = unsafePerformIO $ do - h <- buildHistogram cbins image - values <- mapM (getBin h) - [0..fromIntegral bins-1] - return.HGD $ - zip [-1,-1+2/(realToFrac bins)..1] values- where- cbins = fromIntegral bins +--getNormalHistogram bins image = HGD new+-- where+-- (HGD lst) = getHistogram bins image+----+---- value :: [Double]+-- bin :: [Double]+-- (bin,value) = unzip lst+-- new = zip bin $ map (/size) value+-- size = fromIntegral $ uncurry (*) $ getSize image ----- Low level interaface:+--getHistogram :: Int -> Image GrayScale D32 -> HistogramData Double+--getHistogram bins image = unsafePerformIO $ do+-- h <- buildHistogram cbins image+-- values <- mapM (getBin h)+-- [0..fromIntegral bins-1]+-- return.HGD $+-- zip [-1,-1+2/(realToFrac bins)..1] values+-- where+-- cbins = fromIntegral bins -{#pointer *CvHistogram as Histogram foreign newtype#} -foreign import ccall "& wrapReleaseHist" releaseHistogram :: FinalizerPtr Histogram-creatingHistogram fun = do- iptr <- fun- fptr <- newForeignPtr releaseHistogram iptr- return.Histogram $ fptr--buildHistogram bins image = withGenImage image $ \ i ->- creatingHistogram - ({#call calculateHistogram#} i bins)--getBin :: Histogram -> CInt -> IO Double-getBin hist bin = withHistogram hist $ \h ->- ({#call getHistValue#} h bin) >>= return.realToFrac
+ CV/HoughTransform.hs view
@@ -0,0 +1,91 @@+{-#LANGUAGE ScopedTypeVariables, TypeOperators#-}+module CV.HoughTransform where++import CV.Bindings.ImgProc+import CV.Matrix+import CV.Image (withImage, D8, GrayScale, Image, getSize)+import System.IO.Unsafe+import Foreign.C.Types+import Foreign.Ptr++type HoughDesc = Int++data Segment = Segment+ { start :: (Int,Int)+ , end :: (Int,Int)+ } deriving (Eq,Show)++data Line = Line+ {bias :: Double+ ,θ :: Double+ } deriving (Eq,Show)++data With a b = a `With` b++type ImageWithLines = Image GrayScale D8 `With` [Line]+type ImageWithSegments = Image GrayScale D8 `With` [Segment]++image :: Image c d `With` e -> Image c d+image (a `With` _) = a++lines :: a `With` [Line] -> [Line]+lines (_ `With` b) = b++segments :: a `With` [Segment] -> [Segment]+segments (_ `With` b) = b++lineToSegment (w,h) (Line y k) = (Segment (0,round y)+ (w,round $ y + (fromIntegral w)*negate (tan (pi/2-k))))++houghProbabilisticToLine d (x,y) (u,v) = Segment (x,y) (u,v)++rho1pix :: Double = 1.0+rho5pix :: Double = 5+theta1deg :: Double = pi/180+theta2deg :: Double = pi/90++imageHoughLinesStandard :: Int -> Double -> Double -> Int -> Image GrayScale D8 -> ImageWithLines+imageHoughLinesStandard n ρ θ t img =+ (img `With` [Line (realToFrac y) (realToFrac k) | (y,k) <- hough])+ where+ hough = houghLinesStandard img n ρ θ t++imageHoughLinesProbabilistic :: Int -> Double -> Double -> Int -> Double -> Double -> Image GrayScale D8 -> ImageWithSegments+imageHoughLinesProbabilistic n ρ θ t minLength maxGap img =+ (img `With` [Segment (fromIntegral x,fromIntegral y) (fromIntegral u,fromIntegral v) | (x,y,u,v) <- hough])+ where+ (w,h) = getSize img+ hough = houghLinesProbabilistic img n ρ θ t minLength maxGap++imageHoughLinesMultiScale :: Int -> Double -> Double -> Int -> Double -> Double -> Image GrayScale D8 -> ImageWithLines+imageHoughLinesMultiScale n ρ θ t distDiv angleDiv img =+ (img `With` [Line (realToFrac y)(realToFrac k) | (y,k) <- hough])+ where+ (w,h) = getSize img+ hough = houghLinesMultiscale img n ρ θ t distDiv angleDiv++houghLinesStandard :: Image GrayScale D8 -> Int -> Double -> Double -> Int -> [(CFloat,CFloat)]+houghLinesStandard img n ρ θ t = unsafePerformIO $ do+ let m :: Matrix (CFloat,CFloat) = create (1,n)+ withMatPtr m $ \c_m ->+ withImage img $ \c_img ->+ c'cvHoughLines2 (castPtr c_img) (castPtr c_m) c'CV_HOUGH_STANDARD ρ θ t 0 0+ return $ toList m++houghLinesProbabilistic :: Image GrayScale D8 -> Int -> Double -> Double -> Int -> Double -> Double+ -> [(CInt,CInt,CInt,CInt)]+houghLinesProbabilistic img n ρ θ t minLength maxGap = unsafePerformIO $ do+ let m :: Matrix (CInt,CInt,CInt,CInt) = create (1,n)+ withMatPtr m $ \c_m ->+ withImage img $ \c_img ->+ c'cvHoughLines2 (castPtr c_img) (castPtr c_m) c'CV_HOUGH_PROBABILISTIC ρ θ t minLength maxGap+ return $ toList m++houghLinesMultiscale :: Image GrayScale D8 -> Int -> Double -> Double -> Int -> Double -> Double+ -> [(CFloat,CFloat)]+houghLinesMultiscale img n ρ θ t distDiv angleDiv = unsafePerformIO $ do+ let m :: Matrix (CFloat,CFloat) = create (1,n)+ withMatPtr m $ \c_m ->+ withImage img $ \c_img ->+ c'cvHoughLines2 (castPtr c_img) (castPtr c_m) c'CV_HOUGH_MULTI_SCALE ρ θ t distDiv angleDiv+ return $ toList m
CV/Image.chs view
@@ -1,90 +1,94 @@ {-#LANGUAGE ForeignFunctionInterface, ViewPatterns,ParallelListComp, FlexibleInstances, FlexibleContexts, TypeFamilies, EmptyDataDecls, ScopedTypeVariables, StandaloneDeriving #-} #include "cvWrapLEO.h" module CV.Image (--- * Basic types - Image(..) +-- * Basic types+ Image(..) , create , empty , emptyCopy -, emptyCopy' , cloneImage-, withClone -, withCloneValue -, CreateImage +, withClone+, withCloneValue+, CreateImage -- * Colour spaces-, ChannelOf +, ChannelOf , GrayScale+, DFT , RGB , RGBA-, RGB_Channel(..) +, RGB_Channel(..) , LAB-, LAB_Channel(..) -, D32 -, D64 -, D8 -, Tag -, lab -, rgba -, rgb -, composeMultichannelImage +, LAB_Channel(..)+, D32+, D64+, D8+, Tag+, lab+, rgba+, rgb+, composeMultichannelImage -- * IO operations-, Loadable(..) -, saveImage -, loadColorImage -, loadImage +, Loadable(..)+, saveImage+, loadColorImage+, loadImage --- * Pixel level access +-- * Pixel level access , GetPixel(..)-, getAllPixels -, getAllPixelsRowMajor -, setPixel -, setPixel8U -, mapImageInplace +, getAllPixels+, getAllPixelsRowMajor+, setPixel+, setPixel8U+, mapImageInplace -- * Image information , ImageDepth , Sized(..)-, getArea +, getArea , getChannel-, getImageChannels -, getImageDepth -, getImageInfo +, getImageChannels+, getImageDepth+, getImageInfo -- * ROI's, COI's and subregions-, setCOI -, setROI -, resetROI -, getRegion -, withIOROI -, withROI +, setCOI+, setROI+, resetROI+, getRegion+, withIOROI+, withROI -- * Blitting-, blendBlit -, blit -, blitM -, subPixelBlit -, safeBlit -, montage -, tileImages +, blendBlit+, blit+, blitM+, subPixelBlit+, safeBlit+, montage+, tileImages -- * Conversions , rgbToGray +, grayToRGB , rgbToLab +, bgrToRgb+, rgbToBgr , unsafeImageTo32F , unsafeImageTo8Bit -- * Low level access operations , BareImage(..)-, creatingImage -, unImage -, unS -, withGenBareImage -, withBareImage +, creatingImage+, unImage+, unS+, withGenBareImage+, withBareImage , creatingBareImage-, withGenImage -, withImage +, withGenImage+, withImage+, imageFPTR , ensure32F ) where@@ -95,19 +99,18 @@ import Foreign.C.Types import Foreign.C.String import Foreign.Marshal.Utils-import Foreign.ForeignPtr hiding (newForeignPtr)+import Foreign.ForeignPtr hiding (newForeignPtr,unsafeForeignPtrToPtr) import Foreign.Concurrent import Foreign.Ptr import Control.Parallel.Strategies import Control.DeepSeq --- import C2HSTools- import Data.Maybe(catMaybes) import Data.List(genericLength) import Foreign.Marshal.Array import Foreign.Marshal.Alloc import Foreign.Ptr+import Foreign.ForeignPtr (unsafeForeignPtrToPtr) import Foreign.Storable import System.IO.Unsafe import Data.Word@@ -116,12 +119,21 @@ -- Colorspaces++-- | Single channel grayscale image data GrayScale++data DFT data RGB data RGB_Channel = Red | Green | Blue deriving (Eq,Ord,Enum)-data RGBA++data BGR+ data LAB+data RGBA data LAB_Channel = LAB_L | LAB_A | LAB_B deriving (Eq,Ord,Enum)++-- | Type family for expressing which channels a colorspace contains. This needs to be fixed wrt. the BGR color space. type family ChannelOf a :: * type instance ChannelOf RGB_Channel = RGB type instance ChannelOf LAB_Channel = LAB@@ -131,10 +143,15 @@ type D32 = Float type D64 = Double +-- | The type for Images newtype Image channels depth = S BareImage +-- | Remove typing info from an image unS (S i) = i -- Unsafe and ugly +imageFPTR :: Image c d -> ForeignPtr BareImage+imageFPTR (S (BareImage fptr)) = fptr+ withImage :: Image c d -> (Ptr BareImage ->IO a) -> IO a withImage (S i) op = withBareImage i op --withGenNewImage (S i) op = withGenImage i op@@ -195,17 +212,7 @@ withMaybe (Nothing) op = op nullPtr size = getSize . head . catMaybes $ [c1,c2,c3,c4] --- Load Image as grayscale image. ---loadImage n = do--- exists <- fileExist n--- if not exists then return Nothing--- else do--- i <- withCString n $ \name ->--- creatingImage ({#call cvLoadImage #} name (0))--- bw <- imageTo32F i--- return $ Just bw- class Loadable a where readFromFile :: FilePath -> IO a @@ -219,16 +226,16 @@ instance Loadable ((Image RGB D32)) where readFromFile fp = do- e <- loadColorImage fp+ e <- loadColorImage8 fp case e of- Just i -> return i+ Just i -> return $ unsafeImageTo32F $ bgrToRgb i Nothing -> fail $ "Could not load "++fp instance Loadable ((Image RGB D8)) where readFromFile fp = do e <- loadColorImage8 fp case e of- Just i -> return i+ Just i -> return $ bgrToRgb i Nothing -> fail $ "Could not load "++fp instance Loadable ((Image GrayScale D8)) where@@ -255,9 +262,9 @@ loadImage = unsafeloadUsing imageTo32F 0 loadImage8 :: FilePath -> IO (Maybe (Image GrayScale D8)) loadImage8 = unsafeloadUsing imageTo8Bit 0-loadColorImage :: FilePath -> IO (Maybe (Image RGB D32))+loadColorImage :: FilePath -> IO (Maybe (Image BGR D32)) loadColorImage = unsafeloadUsing imageTo32F 1-loadColorImage8 :: FilePath -> IO (Maybe (Image RGB D8))+loadColorImage8 :: FilePath -> IO (Maybe (Image BGR D8)) loadColorImage8 = unsafeloadUsing imageTo8Bit 1 class Sized a where@@ -281,13 +288,176 @@ cvRGBtoLAB = 45 :: CInt-- NOTE: This will break. +#c+enum CvtFlags {+ CvtFlip = CV_CVTIMG_FLIP,+ CvtSwapRB = CV_CVTIMG_SWAP_RB+ };+#endc++#c+enum CvtCodes {+ CV_BGR2BGRA =0,+ CV_RGB2RGBA =CV_BGR2BGRA,++ CV_BGRA2BGR =1,+ CV_RGBA2RGB =CV_BGRA2BGR,++ CV_BGR2RGBA =2,+ CV_RGB2BGRA =CV_BGR2RGBA,++ CV_RGBA2BGR =3,+ CV_BGRA2RGB =CV_RGBA2BGR,++ CV_BGR2RGB =4,+ CV_RGB2BGR =CV_BGR2RGB,++ CV_BGRA2RGBA =5,+ CV_RGBA2BGRA =CV_BGRA2RGBA,++ CV_BGR2GRAY =6,+ CV_RGB2GRAY =7,+ CV_GRAY2BGR =8,+ CV_GRAY2RGB =CV_GRAY2BGR,+ CV_GRAY2BGRA =9,+ CV_GRAY2RGBA =CV_GRAY2BGRA,+ CV_BGRA2GRAY =10,+ CV_RGBA2GRAY =11,++ CV_BGR2BGR565 =12,+ CV_RGB2BGR565 =13,+ CV_BGR5652BGR =14,+ CV_BGR5652RGB =15,+ CV_BGRA2BGR565 =16,+ CV_RGBA2BGR565 =17,+ CV_BGR5652BGRA =18,+ CV_BGR5652RGBA =19,++ CV_GRAY2BGR565 =20,+ CV_BGR5652GRAY =21,++ CV_BGR2BGR555 =22,+ CV_RGB2BGR555 =23,+ CV_BGR5552BGR =24,+ CV_BGR5552RGB =25,+ CV_BGRA2BGR555 =26,+ CV_RGBA2BGR555 =27,+ CV_BGR5552BGRA =28,+ CV_BGR5552RGBA =29,++ CV_GRAY2BGR555 =30,+ CV_BGR5552GRAY =31,++ CV_BGR2XYZ =32,+ CV_RGB2XYZ =33,+ CV_XYZ2BGR =34,+ CV_XYZ2RGB =35,++ CV_BGR2YCrCb =36,+ CV_RGB2YCrCb =37,+ CV_YCrCb2BGR =38,+ CV_YCrCb2RGB =39,++ CV_BGR2HSV =40,+ CV_RGB2HSV =41,++ CV_BGR2Lab =44,+ CV_RGB2Lab =45,++ CV_BayerBG2BGR =46,+ CV_BayerGB2BGR =47,+ CV_BayerRG2BGR =48,+ CV_BayerGR2BGR =49,++ CV_BayerBG2RGB =CV_BayerRG2BGR,+ CV_BayerGB2RGB =CV_BayerGR2BGR,+ CV_BayerRG2RGB =CV_BayerBG2BGR,+ CV_BayerGR2RGB =CV_BayerGB2BGR,++ CV_BGR2Luv =50,+ CV_RGB2Luv =51,+ CV_BGR2HLS =52,+ CV_RGB2HLS =53,++ CV_HSV2BGR =54,+ CV_HSV2RGB =55,++ CV_Lab2BGR =56,+ CV_Lab2RGB =57,+ CV_Luv2BGR =58,+ CV_Luv2RGB =59,+ CV_HLS2BGR =60,+ CV_HLS2RGB =61,++ CV_BayerBG2BGR_VNG =62,+ CV_BayerGB2BGR_VNG =63,+ CV_BayerRG2BGR_VNG =64,+ CV_BayerGR2BGR_VNG =65,+ + CV_BayerBG2RGB_VNG =CV_BayerRG2BGR_VNG,+ CV_BayerGB2RGB_VNG =CV_BayerGR2BGR_VNG,+ CV_BayerRG2RGB_VNG =CV_BayerBG2BGR_VNG,+ CV_BayerGR2RGB_VNG =CV_BayerGB2BGR_VNG,+ + CV_BGR2HSV_FULL = 66,+ CV_RGB2HSV_FULL = 67,+ CV_BGR2HLS_FULL = 68,+ CV_RGB2HLS_FULL = 69,+ + CV_HSV2BGR_FULL = 70,+ CV_HSV2RGB_FULL = 71,+ CV_HLS2BGR_FULL = 72,+ CV_HLS2RGB_FULL = 73,+ + CV_LBGR2Lab = 74,+ CV_LRGB2Lab = 75,+ CV_LBGR2Luv = 76,+ CV_LRGB2Luv = 77,+ + CV_Lab2LBGR = 78,+ CV_Lab2LRGB = 79,+ CV_Luv2LBGR = 80,+ CV_Luv2LRGB = 81,+ + CV_BGR2YUV = 82,+ CV_RGB2YUV = 83,+ CV_YUV2BGR = 84,+ CV_YUV2RGB = 85,+ + CV_COLORCVT_MAX =100+};+#endc++{#enum CvtCodes {}#}++{#enum CvtFlags {}#}++ rgbToLab :: Image RGB D32 -> Image LAB D32 rgbToLab = S . convertTo cvRGBtoLAB 3 . unS rgbToGray :: Image RGB D32 -> Image GrayScale D32 rgbToGray = S . convertTo cvRGBtoGRAY 1 . unS +grayToRGB :: Image GrayScale D32 -> Image RGB D32+grayToRGB = S . convertTo (fromIntegral . fromEnum $ CV_GRAY2BGR) 3 . unS ++bgrToRgb :: Image BGR depth -> Image RGB depth+bgrToRgb = S . swapRB . unS++rgbToBgr :: Image BGR depth -> Image RGB depth+rgbToBgr = S . swapRB . unS++swapRB :: BareImage -> BareImage+swapRB img = unsafePerformIO $ do+ res <- cloneBareImage img+ withBareImage img $ \cimg ->+ withBareImage res $ \cres ->+ {#call cvConvertImage#} (castPtr cimg) (castPtr cres) (fromIntegral . fromEnum $ CvtSwapRB)+ return res++ class GetPixel a where type P a :: * getPixel :: (Int,Int) -> a -> P a@@ -306,6 +476,19 @@ getPixelOld (fromIntegral -> x, fromIntegral -> y) image = realToFrac $ unsafePerformIO $ withGenImage image $ \img -> {#call wrapGet32F2D#} img y x +instance GetPixel (Image DFT D32) where+ type P (Image DFT D32) = (D32,D32)+ {-#INLINE getPixel#-}+ getPixel (x,y) i = unsafePerformIO $+ withGenImage i $ \c_i -> do+ d <- {#get IplImage->imageData#} c_i+ s <- {#get IplImage->widthStep#} c_i+ let cs = fromIntegral s+ fs = sizeOf (undefined :: Float)+ re <- peek (castPtr (d`plusPtr` (y*cs + x*2*fs)))+ im <- peek (castPtr (d`plusPtr` (y*cs +(x*2+1)*fs)))+ return (re,im)+ -- #define UGETC(img,color,x,y) (((uint8_t *)((img)->imageData + (y)*(img)->widthStep))[(x)*3+(color)]) instance GetPixel (Image RGB D32) where type P (Image RGB D32) = (D32,D32,D32)@@ -369,12 +552,16 @@ where (fromIntegral -> w,fromIntegral -> h) = getSize img +-- | Class for images that exist. class CreateImage a where+ -- | Create an image from size create :: (Int,Int) -> IO a instance CreateImage (Image GrayScale D32) where create (w,h) = creatingImage $ {#call wrapCreateImage32F#} (fromIntegral w) (fromIntegral h) 1+instance CreateImage (Image DFT D32) where+ create (w,h) = creatingImage $ {#call wrapCreateImage32F#} (fromIntegral w) (fromIntegral h) 2 instance CreateImage (Image LAB D32) where create (w,h) = creatingImage $ {#call wrapCreateImage32F#} (fromIntegral w) (fromIntegral h) 3 instance CreateImage (Image RGB D32) where@@ -402,14 +589,13 @@ +-- | Allocate a new empty image empty :: (CreateImage (Image a b)) => (Int,Int) -> (Image a b) empty size = unsafePerformIO $ create size -emptyCopy :: (CreateImage (Image a b)) => Image a b -> IO (Image a b)-emptyCopy img = create (getSize img)--emptyCopy' :: (CreateImage (Image a b)) => Image a b -> (Image a b)-emptyCopy' img = unsafePerformIO $ create (getSize img)+-- | Allocate a new image that of the same size and type as the exemplar image given.+emptyCopy :: (CreateImage (Image a b)) => Image a b -> (Image a b)+emptyCopy img = unsafePerformIO $ create (getSize img) -- | Save image. This will convert the image to 8 bit one before saving saveImage :: FilePath -> Image c d -> IO ()@@ -493,9 +679,16 @@ ({#call alphaBlit#} i1 i1a i2 i2a x y) +-- | Create a copy of an image+cloneImage :: Image a b -> IO (Image a b) cloneImage img = withGenImage img $ \image -> creatingImage ({#call cvCloneImage #} image) +-- | Create a copy of a non-types image+cloneBareImage :: BareImage -> IO BareImage+cloneBareImage img = withGenBareImage img $ \image ->+ creatingBareImage ({#call cvCloneImage #} image)+ withClone :: Image channels depth -> (Image channels depth -> IO ())@@ -523,6 +716,13 @@ unsafeImageTo8Bit img = unsafePerformIO $ withGenImage img $ \image -> creatingImage ({#call ensure8U #} image)++--toD32 :: Image c d -> Image c D32+--toD32 i =+-- unsafePerformIO $+-- withImage i $ \i_ptr ->+-- creatingImage+ imageTo32F img = withGenBareImage img $ \image -> creatingBareImage
CV/ImageMath.chs view
@@ -6,26 +6,27 @@ import Foreign.ForeignPtr import Foreign.Ptr -import CV.Image +import CV.Bindings.Types+import CV.Bindings.Core+import CV.Image import CV.ImageOp -- import C2HSTools {#import CV.Image#} import Foreign.Marshal+import Foreign.Storable import Foreign.Ptr import System.IO.Unsafe import Control.Applicative ((<$>)) -import C2HS--mkBinaryImageOpIO f = \a -> \b -> - withGenImage a $ \ia -> +mkBinaryImageOpIO f = \a -> \b ->+ withGenImage a $ \ia -> withGenImage b $ \ib -> withCloneValue a $ \clone -> withGenImage clone $ \cl -> do- f ia ib cl + f ia ib cl return clone- + mkBinaryImageOp :: (Ptr () -> Ptr () -> Ptr () -> IO a) -> CV.Image.Image c1 d1@@ -33,11 +34,11 @@ -> CV.Image.Image c1 d1 mkBinaryImageOp f = \a -> \b -> unsafePerformIO $- withGenImage a $ \ia -> + withGenImage a $ \ia -> withGenImage b $ \ib -> withCloneValue a $ \clone -> withGenImage clone $ \cl -> do- f ia ib cl + f ia ib cl return clone @@ -45,14 +46,14 @@ -- Friday Evening abcNullPtr f = \a b c -> f a b c nullPtr addOp imageToBeAdded = ImgOp $ \target ->- withGenImage target $ \ctarget -> + withGenImage target $ \ctarget -> withGenImage imageToBeAdded $ \cadd -> {#call cvAdd#} ctarget cadd ctarget nullPtr add = mkBinaryImageOp $ abcNullPtr {#call cvAdd#} sub = mkBinaryImageOp $ abcNullPtr {#call cvSub#} subFrom what = ImgOp $ \from ->- withGenImage from $ \ifrom -> + withGenImage from $ \ifrom -> withGenImage what $ \iwhat -> {#call cvSub#} ifrom iwhat ifrom nullPtr @@ -64,16 +65,16 @@ sqrt = unsafeOperate sqrtOp limitToOp what = ImgOp $ \from ->- withGenImage from $ \ifrom -> + withGenImage from $ \ifrom -> withGenImage what $ \iwhat -> {#call cvMin#} ifrom iwhat ifrom -limitTo x y = unsafeOperate (limitToOp x) y +limitTo x y = unsafeOperate (limitToOp x) y -mul = mkBinaryImageOp +mul = mkBinaryImageOp (\a b c -> {#call cvMul#} a b c 1) -div = mkBinaryImageOp +div = mkBinaryImageOp (\a b c -> {#call cvDiv#} a b c 1) min = mkBinaryImageOp {#call cvMin#}@@ -85,32 +86,32 @@ atan :: Image GrayScale D32 -> Image GrayScale D32 atan i = unsafePerformIO $ do let (w,h) = getSize i- res <- create (w,h) - withImage i $ \s -> + res <- create (w,h)+ withImage i $ \s -> 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 a $ \c_a ->+ withImage b $ \c_b -> withImage res $ \c_res -> do- {#call calculateAtan2#} c_a c_b c_res + {#call calculateAtan2#} c_a c_b c_res return res- + -- Operation that subtracts image mean from image subtractMeanAbsOp = ImgOp $ \image -> do av <- average' image- withGenImage image $ \i -> + withGenImage image $ \i -> {#call wrapAbsDiffS#} i (realToFrac av) i -- TODO: check C datatype sizes -- Logical inversion of image (Ie. invert, but stay on [0..1] range) invert i = addS 1 $ mulS (-1) i absOp = ImgOp $ \image -> do- withGenImage image $ \i -> + withGenImage image $ \i -> {#call wrapAbsDiffS#} i 0 i abs = unsafeOperate absOp@@ -123,41 +124,39 @@ subop image subRSOp :: D32 -> ImageOperation GrayScale D32-subRSOp scalar = ImgOp $ \a -> +subRSOp scalar = ImgOp $ \a -> withGenImage a $ \ia -> do- {#call wrapSubRS#} ia (realToFrac scalar) ia + {#call wrapSubRS#} ia (realToFrac scalar) ia subRS s a= unsafeOperate (subRSOp s) a -subSOp scalar = ImgOp $ \a -> +subSOp scalar = ImgOp $ \a -> withGenImage a $ \ia -> do- {#call wrapSubS#} ia (realToFrac scalar) ia + {#call wrapSubS#} ia (realToFrac scalar) ia subS a s = unsafeOperate (subSOp s) a --- Multiply the image with scalar +-- Multiply the image with scalar mulSOp :: D32 -> ImageOperation GrayScale D32-mulSOp scalar = ImgOp $ \a -> +mulSOp scalar = ImgOp $ \a -> withGenImage a $ \ia -> do- {#call cvConvertScale#} ia ia s 0 + {#call cvConvertScale#} ia ia s 0 return ()- where s = realToFrac scalar + where s = realToFrac scalar -- I've heard this will lose information mulS s = unsafeOperate $ mulSOp s -mkImgScalarOp op scalar = ImgOp $ \a -> +mkImgScalarOp op scalar = ImgOp $ \a -> withGenImage a $ \ia -> do- op ia (realToFrac scalar) ia + op ia (realToFrac scalar) ia return ()- -- where s = realToFrac scalar - -- I've heard this will lose information -- TODO: Relax the addition so it works on multiple image depths addSOp :: D32 -> ImageOperation GrayScale D32 addSOp = mkImgScalarOp $ {#call wrapAddS#} addS s = unsafeOperate $ addSOp s -minSOp = mkImgScalarOp $ {#call cvMinS#} +minSOp = mkImgScalarOp $ {#call cvMinS#} minS s = unsafeOperate $ minSOp s maxSOp = mkImgScalarOp $ {#call cvMaxS#}@@ -174,7 +173,7 @@ -- TODO: For some reason the below was going through 8U images. Investigate mkCmpOp :: CInt -> D32 -> (Image GrayScale D32 -> Image GrayScale D8)-mkCmpOp cmp = \scalar a -> unsafePerformIO $ do+mkCmpOp cmp = \scalar a -> unsafePerformIO $ withGenImage a $ \ia -> do new <- create (getSize a) --8UC1 withGenImage new $ \cl -> do@@ -183,7 +182,7 @@ return new -- TODO: For some reason the below was going through 8U images. Investigate-mkCmp2Op :: (CreateImage (Image GrayScale d)) => +mkCmp2Op :: (CreateImage (Image GrayScale d)) => CInt -> (Image GrayScale d -> Image GrayScale d -> Image GrayScale D8) mkCmp2Op cmp = \imgA imgB -> unsafePerformIO $ do withGenImage imgA $ \ia -> do@@ -200,17 +199,23 @@ lessThan = mkCmpOp cmpLT moreThan = mkCmpOp cmpGT -less2Than,lessEq2Than,more2Than :: (CreateImage (Image GrayScale d)) => Image GrayScale d - -> Image GrayScale d -> Image GrayScale D8 +less2Than,lessEq2Than,more2Than :: (CreateImage (Image GrayScale d)) => Image GrayScale d+ -> Image GrayScale d -> Image GrayScale D8 less2Than = mkCmp2Op cmpLT lessEq2Than = mkCmp2Op cmpLE more2Than = mkCmp2Op cmpGT -- Statistics-average' :: Image GrayScale a -> IO D32-average' img = withGenImage img $ \image -> -- TODO: Check c datatype size- {#call wrapAvg#} image >>= return . realToFrac +averageMask :: Image GrayScale D32 -> Image GrayScale D8 -> D32+averageMask img mask = unsafePerformIO $+ withGenImage img $ \c_image -> + withGenImage mask $ \c_mask -> + {#call wrapAvg#} c_image c_mask >>= return . realToFrac +average' :: Image GrayScale D32 -> IO D32+average' img = withGenImage img $ \image -> + {#call wrapAvg#} image nullPtr >>= return . realToFrac+ average :: Image GrayScale D32 -> D32 average = realToFrac.unsafePerformIO.average' @@ -225,29 +230,29 @@ -- sum img = unsafePerformIO $ withGenImage img $ \image -> -- {#call wrapSum#} image -stdDeviation' img = withGenImage img {#call wrapStdDev#} +stdDeviation' img = withGenImage img {#call wrapStdDev#} stdDeviation :: Image GrayScale D32 -> D32-stdDeviation = realToFrac . unsafePerformIO . stdDeviation' +stdDeviation = realToFrac . unsafePerformIO . stdDeviation' -stdDeviationMask img mask = unsafePerformIO $ +stdDeviationMask img mask = unsafePerformIO $ withGenImage img $ \i -> withGenImage mask $ \m -> {#call wrapStdDevMask#} i m -averageMask img mask = unsafePerformIO $ - withGenImage img $ \i ->- withGenImage mask $ \m ->- {#call wrapStdDevMask#} i m -{#fun wrapMinMax as findMinMax' +peekFloatConv :: (Storable a, RealFloat a, RealFloat b) => Ptr a -> IO b+peekFloatConv a = fmap realToFrac (peek a)+++{#fun wrapMinMax as findMinMax' { withGenBareImage* `BareImage' , withGenBareImage* `BareImage' , alloca- `D32' peekFloatConv* , alloca- `D32' peekFloatConv*} -- TODO: Check datatype sizes used in C! -> `()'#} -findMinMaxLoc img = unsafePerformIO $ +findMinMaxLoc img = unsafePerformIO $ alloca $ \(ptrintmaxx :: Ptr CInt)-> alloca $ \(ptrintmaxy :: Ptr CInt)-> alloca $ \(ptrintminx :: Ptr CInt)->@@ -264,12 +269,39 @@ minval <- realToFrac <$> peek ptrintmin; return (((minx,miny),minval),((maxx,maxy),maxval));} +imageMinMax i = unsafePerformIO $ do+ withImage i $ \i_ptr -> do+ let+ minval :: CDouble+ minval = 0+ maxval :: CDouble+ maxval = 0+ with minval $ \cminval ->+ with maxval $ \cmaxval -> do+ c'cvMinMaxLoc (castPtr i_ptr) cminval cmaxval nullPtr nullPtr nullPtr+ imin <- peek cminval+ imax <- peek cmaxval+ return ((realToFrac imin), (realToFrac imax))++imageAvgSdv i = unsafePerformIO $ do+ withImage i $ \i_ptr -> do+ let+ avg = (C'CvScalar 0 0 0 0)+ sdv = (C'CvScalar 0 0 0 0)+ with avg $ \avg_ptr ->+ with sdv $ \sdv_ptr -> do+ c'cvAvgSdv (castPtr i_ptr) avg_ptr sdv_ptr nullPtr+ (C'CvScalar a1 a2 a3 a4) <- peek avg_ptr+ (C'CvScalar s1 s2 s3 s4) <- peek sdv_ptr+ return ((realToFrac a1, realToFrac a2, realToFrac a3, realToFrac a4),+ (realToFrac s1, realToFrac s2, realToFrac s3, realToFrac s4))+ findMinMax i = unsafePerformIO $ do nullp <- newForeignPtr_ nullPtr- (findMinMax' (unS i) (BareImage nullp)) + (findMinMax' (unS i) (BareImage nullp)) -- |Find minimum and maximum value of image i in area specified by the mask.-findMinMaxMask i mask = unsafePerformIO (findMinMax' i mask) +findMinMaxMask i mask = unsafePerformIO (findMinMax' i mask) -- let a = getAllPixels i in (minimum a,maximum a) maxValue,minValue :: Image GrayScale D32 -> D32@@ -308,12 +340,12 @@ -- | Given a distance map and a circle, return the biggest circle with radius less -- than given in the distance map that fully covers the previous one -maximalCoveringCircle distMap (x,y,r) - = unsafePerformIO $ +maximalCoveringCircle distMap (x,y,r)+ = unsafePerformIO $ withImage distMap $ \c_distmap -> alloca $ \(ptr_int_max_x :: Ptr CInt) -> alloca $ \(ptr_int_max_y :: Ptr CInt) ->- alloca $ \(ptr_double_max_r :: Ptr CDouble) -> + alloca $ \(ptr_double_max_r :: Ptr CDouble) -> do {#call maximal_covering_circle#} x y r c_distmap ptr_int_max_x ptr_int_max_y ptr_double_max_r max_x <- fromIntegral <$> peek ptr_int_max_x@@ -321,6 +353,6 @@ max_r <- realToFrac <$> peek ptr_double_max_r return (max_x,max_y,max_r) - - ++
CV/ImageOp.hs view
@@ -1,6 +1,6 @@ module CV.ImageOp where -import Foreign+import System.IO.Unsafe (unsafePerformIO) import CV.Image import Control.Monad ((>=>)) import Data.Monoid@@ -14,16 +14,16 @@ (#>) :: 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) +-- >>> hop i = stretchHistogram $ i #- gaussian (5,5) -- allocates two extra images--- >>> hop = (gaussian (5,5) &#& id) #> subtract #> stretchHistogram +-- >>> 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) @@ -35,7 +35,7 @@ (&#&) :: 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 + where op i = withCloneValue i $ \cl -> (f i >> g cl >> return (i,cl)) unsafeOperate op img = unsafePerformIO $ operate op img@@ -49,16 +49,16 @@ operate ::ImageOperation c d -> Image c d -> IO (Image c d)-operate (ImgOp op) img = withCloneValue img $ \clone -> +operate (ImgOp op) img = withCloneValue img $ \clone -> op clone >> return clone operateOn = flip operate -- |Iterate an operation N times-times n op = foldl (#>) nonOp (replicate n op) +times n op = foldl (#>) nonOp (replicate n op) directOp i (ImgOp op) = op i-operateInPlace (ImgOp op) img = op img +operateInPlace (ImgOp op) img = op img unsafeOperateOn img op = unsafePerformIO $ operate op img
+ CV/Iterators.hs view
@@ -0,0 +1,72 @@+{-#LANGUAGE TypeFamilies, TypeSynonymInstances, ParallelListComp,+ FlexibleContexts, FlexibleInstances #-}+module CV.Iterators+( ImageContext(..)+, F32I+, filterPixels+, filterPixelsSlow+) where++import Data.Maybe+import Foreign.Ptr+import Foreign.ForeignPtr+import Foreign.Storable+import CV.Bindings.Types+import CV.Bindings.Iterators+import CV.Image+import System.IO.Unsafe++type F32I = Ptr C'F32_image_iterator++class ImageContext c where+ type V c :: *+ getPos :: c -> (Int,Int)+ getVal :: c -> Maybe (V c)+ evolve :: c -> c++instance ImageContext F32I where+ type V F32I = Float+ getPos c = unsafePerformIO $ do+ (C'CvPoint x y) <- peek p+ return $! (fromIntegral x, fromIntegral y)+ where+ p = c'F32_rowwise_pos c+ getVal c+ | p == nullPtr = Nothing+ | otherwise = unsafePerformIO $ do+ v <- peek p+ return $! Just (realToFrac v)+ where+ p = c'F32_val c+ evolve c = unsafePerformIO $ c'F32_next c++addPixelIf :: (Float -> Bool) -> [((Int,Int),Float)] -> F32I -> [((Int,Int),Float)]+addPixelIf cond ps c+ | isNothing v = ps+ | cond (fromJust v) = pair `seq` addPixelIf cond (pair : ps) $! evolve c+ | otherwise = addPixelIf cond ps $! evolve c+ where+ pos = getPos c+ pair = pos `seq` (pos, (fromJust v))+ v = getVal c++filterPixels :: (Float -> Bool) -> Image GrayScale D32 -> [((Int,Int),Float)]+filterPixels cond img =+ unsafePerformIO $+ withImage img $ \cimg -> do+ ptr <- c'alloc_F32_image_iterator+ if ptr == nullPtr+ then+ return []+ else do+ fptr <- newForeignPtr p'free_F32_image_iterator ptr+ withForeignPtr fptr $ \i -> do+ r <- c'F32_create_rowwise_iterator i cimg+ return $! addPixelIf cond [] i++-- slow method using list comprehensions, to verify iterator result...+filterPixelsSlow :: (Float -> Bool) -> Image GrayScale D32 -> [((Int,Int),Float)]+filterPixelsSlow cond img = filter (cond . snd) $ concat $ [ [((i,j),(v i j)) | j<-[0..height-1] ] | i <- [0..width-1] ]+ where+ v x y = getPixel (x,y) img+ (width,height) = getSize img
CV/LightBalance.chs view
@@ -5,8 +5,9 @@ import Foreign.C.Types import Foreign.Ptr -import C2HSTools+import System.IO.Unsafe {#import CV.Image#}+ f::Int -> CInt f = fromIntegral x2cylinder (f->w,f->h) m s c = unsafePerformIO $ creatingImage ({#call vignettingModelX2Cyl#} w h
CV/Marking.hs view
@@ -10,53 +10,54 @@ import CV.ColourUtils import Foreign.C.Types import CV.ImageMathOp+import Utils.Rectangle -- For easy marking of detected flaws boxFlaws i = Edges.laplace Edges.l1 $ dilate basicSE 5 (i)-highLightFlaws image flaws = displayFlaws +highLightFlaws image flaws = displayFlaws ((0.2 |* flaws) #+ (0.8 |* image)) flaws-displayFlaws image = IM.sub image . IM.mulS 0.6 . boxFlaws -displayLargeFlaws image = IM.sub image . IM.mulS 0.6 . Edges.laplace l1 +displayFlaws image = IM.sub image . IM.mulS 0.6 . boxFlaws+displayLargeFlaws image = IM.sub image . IM.mulS 0.6 . Edges.laplace l1 type Marker c d = (Int,Int) -> (Int,Int) -> ImageOperation c d -condMarker condition m size t place = if condition t +condMarker condition m size t place = if condition t then m size t place else nonOp -getCoordsForMarkedTiles tileSize overlap marks image = +getCoordsForMarkedTiles tileSize overlap marks image = map fst $ filter (snd) $ zip coords marks where coords = getOverlappedTileCoords tileSize overlap image -cuteDot (x,y) = +cuteDot (x,y) = circleOp 1- (x,y) (w*2) (Stroked 1) ImageOp.#> circleOp 0 (x,y) (w*2-1) (Stroked 1) - where w = 2 + (x,y) (w*2) (Stroked 1) ImageOp.#> circleOp 0 (x,y) (w*2-1) (Stroked 1)+ where w = 2 -cuteCircle1 (x,y) = - circleOp 1 - (x+w,y+w) (w*2) (Stroked 1) ImageOp.#> circleOp 0 (x+w,y+w) (w*2-1) (Stroked 1) - where w = 6 +cuteCircle1 (x,y) =+ circleOp 1+ (x+w,y+w) (w*2) (Stroked 1) ImageOp.#> circleOp 0 (x+w,y+w) (w*2-1) (Stroked 1)+ where w = 6 -cuteRect (w,h) (x,y) = - rectOp 0.1 1 (x,y) (x+w,y+h) ImageOp.#> - rectOp 1 1 (x+1,y+1) (x+w-1,y+h-1) +cuteRect (w,h) (x,y) =+ rectOp 0.1 1 (Rectangle x y (x+w) (y+h)) ImageOp.#>+ rectOp 1 1 (Rectangle (x+1) (y+1) (x+w-1) (y+h-1)) cuteCircle :: Marker GrayScale D32-cuteCircle (tw,th) (x,y) = +cuteCircle (tw,th) (x,y) = (circleOp 1- (x+tw`div`2,y+tw`div`2) (w) (Stroked 1) ) ImageOp.#> circleOp 0 (x+tw`div`2,y+tw`div`2) (w-1) (Stroked 1) + (x+tw`div`2,y+tw`div`2) (w) (Stroked 1) ) ImageOp.#> circleOp 0 (x+tw`div`2,y+tw`div`2) (w-1) (Stroked 1) where w = tw`div`2 markTiles image size overlap marker lst = marked where tileCoords = getOverlappedTileCoords size overlap image markers = map (\(t,c) -> marker size t c) $ zip lst tileCoords- marked = unsafeOperate (foldl (ImageOp.#>) nonOp markers) image - - + marked = unsafeOperate (foldl (ImageOp.#>) nonOp markers) image++
CV/Matrix.hs view
@@ -1,9 +1,9 @@ {-#LANGUAGE ParallelListComp, TypeFamilies, FlexibleInstances, FlexibleContexts, ScopedTypeVariables#-} -- | This module provides wrappers for CvMat type. This is still preliminary as the type of the -- matrix isn't coded in the haskell type.-module CV.Matrix +module CV.Matrix (- Exists,Exists(..),+ Exists(..), Matrix, emptyMatrix ,fromList,toList,toRows,toCols,get,put,withMatPtr , transpose, mxm, rodrigues2 )where@@ -17,8 +17,9 @@ import Foreign.C.String import Foreign.Marshal.Utils import Foreign.ForeignPtr hiding (newForeignPtr)-import Foreign.Concurrent +import Foreign.Concurrent import Foreign.Ptr+import Foreign.Storable.Tuple import Control.Parallel.Strategies import Control.DeepSeq @@ -35,6 +36,7 @@ import Control.Monad import CV.Bindings.Matrix+import CV.Bindings.Types import CV.Image hiding (create) -- #define CV_MAT_ELEM_PTR_FAST( mat, row, col, pix_size ) \@@ -56,43 +58,67 @@ instance Exists (Matrix Float) where type Args (Matrix Float) = (Int,Int)- create (r,c) = unsafePerformIO $ creatingMat (c'cvCreateMat r c c'CV_32FC1) + create (r,c) = unsafePerformIO $ creatingMat (c'cvCreateMat r c c'CV_32FC1) instance Exists (Matrix Int) where type Args (Matrix Int) = (Int,Int)- create (r,c) = unsafePerformIO $ creatingMat (c'cvCreateMat r c c'CV_32SC1) + create (r,c) = unsafePerformIO $ creatingMat (c'cvCreateMat r c c'CV_32SC1) +instance Exists (Matrix (Int,Int)) where+ type Args (Matrix (Int,Int)) = (Int,Int)+ create (r,c) = unsafePerformIO $ creatingMat (c'cvCreateMat r c c'CV_32SC2)++instance Exists (Matrix (Float,Float)) where+ type Args (Matrix (Float,Float)) = (Int,Int)+ create (r,c) = unsafePerformIO $ creatingMat (c'cvCreateMat r c c'CV_32FC2)++instance Exists (Matrix (CFloat,CFloat)) where+ type Args (Matrix (CFloat,CFloat)) = (Int,Int)+ create (r,c) = unsafePerformIO $ creatingMat (c'cvCreateMat r c c'CV_32FC2)++instance Exists (Matrix (Float,Float,Float)) where+ type Args (Matrix (Float,Float,Float)) = (Int,Int)+ create (r,c) = unsafePerformIO $ creatingMat (c'cvCreateMat r c c'CV_32FC3)++instance Exists (Matrix (Int,Int,Int,Int)) where+ type Args (Matrix (Int,Int,Int,Int)) = (Int,Int)+ create (r,c) = unsafePerformIO $ creatingMat (c'cvCreateMat r c c'CV_32SC4)++instance Exists (Matrix (CInt,CInt,CInt,CInt)) where+ type Args (Matrix (CInt,CInt,CInt,CInt)) = (Int,Int)+ create (r,c) = unsafePerformIO $ creatingMat (c'cvCreateMat r c c'CV_32SC4)+ instance Exists (Matrix Double) where type Args (Matrix Double) = (Int,Int)- create (r,c) = unsafePerformIO $ creatingMat (c'cvCreateMat r c c'CV_64FC1) + create (r,c) = unsafePerformIO $ creatingMat (c'cvCreateMat r c c'CV_64FC1) instance Sized (Matrix a) where type Size (Matrix a) = (Int,Int) getSize (Matrix e) = unsafePerformIO $ withForeignPtr e $ \mat -> do mat' <- peek mat- return (fromIntegral $ c'CvMat'rows mat', + return (fromIntegral $ c'CvMat'rows mat', fromIntegral $ c'CvMat'cols mat') -- | Create an empty matrix of given dimensions emptyMatrix :: Exists (Matrix a) => Args (Matrix a) -> Matrix a emptyMatrix a = create a -identity :: (Num a, Sized (Matrix a), Args (Matrix a) ~ (Int,Int), Size (Matrix a) ~ (Int,Int), Storable a, Exists (Matrix a)) => +identity :: (Num a, Sized (Matrix a), Args (Matrix a) ~ (Int,Int), Size (Matrix a) ~ (Int,Int), Storable a, Exists (Matrix a)) => (Matrix a) -> Matrix a identity a = unsafePerformIO $ do- let res = create (getSize a) + let res = create (getSize a) (rows,cols) = getSize a- sequence_ [put res row col 1 + sequence_ [put res row col 1 | row <- [0..rows-1] | col <- [0..cols-1]] return res --- | Transpose a matrix. Does not do complex conjugation for complex matrices +-- | Transpose a matrix. Does not do complex conjugation for complex matrices transpose :: (Exists (Matrix a), Args (Matrix a) ~ Size (Matrix a)) => Matrix a -> Matrix a transpose m@(Matrix f_m) = unsafePerformIO $ do let res@(Matrix f_c) = create (getSize m) withForeignPtr f_m $ \c_m ->- withForeignPtr f_c $ c'cvTranspose c_m + withForeignPtr f_c $ c'cvTranspose c_m return res -- | Convert a rotation vector to a rotation matrix (1x3 -> 3x3)@@ -110,7 +136,7 @@ let (w1,h1) = getSize m1 (w2,h2) = getSize m2 res@(Matrix f_c) = create (w1,h2)- when (h1 /= w2) . error $ + when (h1 /= w2) . error $ "Matrix dimensions do not match for multiplication: " ++show (w1,h1) ++" vs. "@@ -121,10 +147,10 @@ return res withMatPtr :: Matrix x -> (Ptr C'CvMat -> IO a) -> IO a-withMatPtr (Matrix m) op = withForeignPtr m op +withMatPtr (Matrix m) op = withForeignPtr m op -- | Convert a list of floats into Matrix-fromList :: forall t . (Storable t, Exists (Matrix t), Args (Matrix t) ~ (Int,Int)) +fromList :: forall t . (Storable t, Exists (Matrix t), Args (Matrix t) ~ (Int,Int)) => (Int,Int) -> [t] -> Matrix t fromList (w,h) lst = unsafePerformIO $ do let m@(Matrix e) = emptyMatrix (w,h)@@ -133,18 +159,19 @@ let d :: Ptr t d = castPtr $ c'CvMat'data'ptr mat' s = c'CvMat'step mat'- sequence_ [putRaw d s row col v + size = sizeOf (undefined :: t)+ sequence_ [putRaw d s size row col v | (row,col) <- [(r,c) | c <- [0..h-1], r <- [0..w-1]] | v <- lst ] return $ m -- | Convert a matrix to flat list (row major order)-toList :: (Storable a) => Matrix a -> [a] +toList :: (Storable a) => Matrix a -> [a] toList = concat . toRows -- | Convert matrix to rows represented as nested lists-toRows :: forall t . (Storable t) => Matrix t -> [[t]] +toRows :: forall t . (Storable t) => Matrix t -> [[t]] toRows (Matrix e) = unsafePerformIO $ do withForeignPtr e $ \mat -> do mat' <- peek mat@@ -157,7 +184,7 @@ ] -- | Convert matrix to cols represented as nested lists-toCols :: forall t . (Storable t) => Matrix t -> [[t]] +toCols :: forall t . (Storable t) => Matrix t -> [[t]] toCols (Matrix e) = unsafePerformIO $ do withForeignPtr e $ \mat -> do mat' <- peek mat@@ -185,7 +212,7 @@ {-#INLINE getRaw#-} getRaw :: forall t . (Storable t) => Ptr t -> Int -> Int -> Int -> IO t-getRaw d s col row = +getRaw d s col row = peek (castPtr (d `plusPtr` (col*s+row*sizeOf (undefined::t))):: Ptr t) {-#INLINE put#-}@@ -193,15 +220,15 @@ put :: forall t . (Storable t) => (Matrix t) -> Int -> Int -> t -> IO () put (Matrix m) row col v = withForeignPtr m $ \mat -> do mat' <- peek mat- let + let d :: Ptr t d = castPtr $ c'CvMat'data'ptr mat' s = c'CvMat'step mat'- putRaw d s row col v+ size = sizeOf (undefined :: t)+ putRaw d s size row col v {-#INLINE putRaw#-}-putRaw :: forall t. (Storable t) => Ptr t -> CInt -> Int -> Int -> t -> IO ()-putRaw d s col row v = - poke (castPtr (d `plusPtr` (col*(fromIntegral s)+row*sizeOf (undefined::t))):: Ptr t)- v+putRaw :: forall t. (Storable t) => Ptr t -> CInt -> Int -> Int -> Int -> t -> IO ()+putRaw d step eltSize col row v =+ poke (castPtr (d `plusPtr` (col*(fromIntegral step)+row*eltSize))) v
CV/Morphology.chs view
@@ -24,7 +24,7 @@ import CV.ImageOp import qualified CV.ImageMath as IM -import C2HSTools+import System.IO.Unsafe -- Morphological opening openOp :: StructuringElement -> ImageOperation GrayScale D32
+ CV/Operations.hs view
@@ -0,0 +1,80 @@+module CV.Operations+( clear+, set+, NormType(..)+, normalize+, unitNormalize+, unitStretch+, logNormalize+) where++import CV.Bindings.Core+import CV.Bindings.Types+import CV.Image+import CV.ImageMath as IM+import CV.ImageMathOp+import Foreign.Marshal.Utils (with)+import Foreign.Ptr (nullPtr,castPtr)+import System.IO.Unsafe++clear :: Image c d -> Image c d+clear i = unsafePerformIO $ do+ withImage i $ \i_ptr ->+ c'cvSetZero (castPtr i_ptr)+ return i++set :: Double -> Image c d -> Image c d+set v i = unsafePerformIO $ do+ withImage i $ \i_ptr ->+ c'wrapSetAll (castPtr i_ptr) (realToFrac v) nullPtr+ return i++data NormType =+ NormC |+ NormL1 |+ NormL2 |+ NormMask |+ NormRelative |+ NormDiff |+ NormMinMax |+ NormDiffC |+ NormDiffL1 |+ NormDiffL2 |+ NormDiffRelativeC |+ NormDiffRelativeL1 |+ NormDiffRelativeL2++cNormType t =+ case t of+ NormC -> c'CV_C+ NormL1 -> c'CV_L1+ NormL2 -> c'CV_L2+ NormMask -> c'CV_NORM_MASK+ NormRelative -> c'CV_RELATIVE+ NormDiff -> c'CV_DIFF+ NormMinMax -> c'CV_MINMAX+ NormDiffC -> c'CV_DIFF_C+ NormDiffL1 -> c'CV_DIFF_L1+ NormDiffL2 -> c'CV_DIFF_L2+ NormDiffRelativeC -> c'CV_RELATIVE_C+ NormDiffRelativeL1 -> c'CV_RELATIVE_L1+ NormDiffRelativeL2 -> c'CV_RELATIVE_L2++normalize :: Double -> Double -> NormType -> Image c d -> Image c d+normalize a b t src =+ unsafePerformIO $ do+ withCloneValue src $ \clone ->+ withImage src $ \si ->+ withImage clone $ \ci -> do+ c'cvNormalize (castPtr si) (castPtr ci) (realToFrac a) (realToFrac b) (cNormType t) nullPtr+ return clone++unitNormalize i+ | minval >= 0 && minval <= 1 && maxval >= 0 && maxval <= 1 = i+ | otherwise = normalize 0 1 NormMinMax i+ where+ m@(minval, maxval) = IM.imageMinMax i++unitStretch i = normalize 0 1 NormMinMax i++logNormalize = unitNormalize . IM.log . (1 |+)
CV/Pixelwise.hs view
@@ -27,6 +27,25 @@ pure x = MkP maxBound (pure x) MkP i f <*> MkP j g = MkP (min i j) (f <*> g) +instance (Eq a) => Eq (Pixelwise a) where+ (MkP (s1@(w1,h1)) e1) == (MkP s2 e2) + = s1==s2 && and [e1 (i,j) == e2 (i,j) | i <- [0..w1-1] , j <- [0..h1-1]] ++instance Show (Pixelwise a) where+ show (MkP s1 e1) + = "MkP "++show (s1)++" <image-data>" ++instance (Num a) => Num (Pixelwise a) where+ a + b = (+) <$> a <*> b + a * b = (*) <$> a <*> b + a - b = (-) <$> a <*> b + negate = fmap negate+ abs = fmap abs + signum = error "Signum is undefined for images"+ fromInteger i = MkP{sizeOf = (1,1),eltOf=const (fromIntegral i)}++withPixels x = toImage . x . fromImage+ -- | Re-arrange pixel positions and values remap :: (((Int,Int) -> b) -> ((Int,Int) -> x)) -> Pixelwise b -> Pixelwise x remap f (MkP s e) = MkP s (f e)
CV/TemplateMatching.chs view
@@ -4,6 +4,8 @@ import Foreign.C.Types import Foreign.Ptr+import Foreign.Storable+import Foreign.Marshal.Alloc import CV.Image import CV.Transforms@@ -13,7 +15,7 @@ import Utils.Rectangle hiding (scale) {#import CV.Image#}-import C2HSTools+import System.IO.Unsafe getTemplateMap image template = unsafePerformIO $ withImage image $ \cvimg ->
CV/Textures.chs view
@@ -1,4 +1,4 @@-{-#LANGUAGE ForeignFunctionInterface, ParallelListComp#-}+{-#LANGUAGE ForeignFunctionInterface, ParallelListComp, BangPatterns#-} #include "cvWrapLEO.h" -- |This module provides implementations for basic versions of Local Binary Pattern texture features introduced in -- T. Ojala, M. Pietikäinen, and D. Harwood (1994), "Performance evaluation of texture measures with classification@@ -11,15 +11,20 @@ import Foreign.Ptr import Foreign.Marshal.Array +import System.IO.Unsafe+ import CV.Image import CV.ImageOp import Data.List-import C2HSTools+--import C2HSTools import qualified Data.Vector as V import Data.Vector (Vector) import Data.Maybe (fromMaybe)+import Data.Word+import Data.Bits (rotateL) {#import CV.Image#}+ -- * Rotation invariance
CV/Thresholding.hs view
@@ -39,13 +39,13 @@ flat = i #- gaussian (w,h) i --- TODO: Convert Histograms from Doubles to Floats..-otsu bs image = IM.moreThan (realToFrac threshold) image- where- histogram = getHistogram bs $ image- partitions = histogramPartitions histogram - (threshold,_,_) = maximumBy (comparing otsuCmp) partitions - otsuCmp (t,as,bs) = betweenClassVariance (as) (bs)+---- TODO: Convert Histograms from Doubles to Floats..+--otsu bs image = IM.moreThan (realToFrac threshold) image+-- where+-- histogram = getHistogram bs $ image+-- partitions = histogramPartitions histogram +-- (threshold,_,_) = maximumBy (comparing otsuCmp) partitions +-- otsuCmp (t,as,bs) = betweenClassVariance (as) (bs) -- This is excruciatingly slow means of finding kittler-illingworth threshold -- for an image@@ -67,9 +67,9 @@ fgDev = realToFrac $ IM.stdDeviationMask image (IM.invert thresholded) -histogramPartitions (HGD a) = zip3 (head.tails.map fst $ a) - (tail.inits.map snd $ a) - (reverse.tail.reverse.tails.map snd $ a)+--histogramPartitions (HGD a) = zip3 (head.tails.map fst $ a) +-- (tail.inits.map snd $ a) +-- (reverse.tail.reverse.tails.map snd $ a) betweenClassVariance as bs = sum as * sum bs * (average bs - average as)^2
+ CV/Tracking.hs view
@@ -0,0 +1,43 @@+{-#LANGUAGE FlexibleContexts, TypeFamilies#-}+module CV.Tracking where+import CV.Bindings.Tracking+import CV.Bindings.Types+import CV.Image+import Utils.GeometryClass+import Utils.Rectangle+import Foreign.Marshal+import Foreign.Ptr+import Foreign.Storable+import Foreign.Marshal.Array+import Foreign.Marshal.Utils+import System.IO.Unsafe++meanShift :: (BoundingBox a, Integral (ELBB a), ELBB a~Int) => Image GrayScale D32 -> a -> TermCriteria+ -> (Double,Rectangle Int)+meanShift image window crit = unsafePerformIO $+ withGenImage image $ \c_img ->+ with (convertBounds window) $ \c_window ->+ with (toCvTCrit crit) $ \c_crit ->+ with (C'CvConnectedComp 0 (C'CvScalar 0 0 0 0) (C'CvRect 0 0 0 0) nullPtr) $ \c_conn -> do+ c'wrapMeanShift c_img c_window c_crit c_conn+ C'CvConnectedComp area _ rect _ <- peek c_conn+ return (realToFrac area, bounds rect)++snake image initialPts α β γ (w,h) termcrit gradient = do+ with α $ \c_α ->+ with β $ \c_β ->+ with γ $ \c_γ ->+ with (C'CvSize w h) $ \ c_win ->+ with termcrit $ \ c_crit ->+ withArray (map toPt initialPts) $ \c_pts ->+ withImage image $ \c_image -> do+ c'cvSnakeImage (castPtr c_image)+ c_pts+ (fromIntegral (length initialPts))+ c_α c_β c_γ+ c'CV_VALUE+ c_win+ c_crit+ (fromBool gradient)+ peekArray (length initialPts) c_pts+
CV/Transforms.chs view
@@ -46,7 +46,7 @@ -- |Mirror an image over a cardinal axis flip :: CreateImage (Image c d) => MirrorAxis -> Image c d -> Image c d flip axis img = unsafePerformIO $ do- cl <- emptyCopy img+ let cl = emptyCopy img withGenImage img $ \cimg -> withGenImage cl $ \ccl -> do {#call cvFlip#} cimg ccl (if axis == Vertical then 0 else 1)@@ -66,7 +66,7 @@ -- |Simulate a radial distortion over an image radialDistort :: Image GrayScale D32 -> Double -> Image GrayScale D32 radialDistort img k = unsafePerformIO $ do- target <- emptyCopy img + let target = emptyCopy img withImage img $ \cimg -> withImage target $ \ctarget -> {#call radialRemap#} cimg ctarget (realToFrac k)
+ Utils/DrawingClass.hs view
@@ -0,0 +1,5 @@+{-#LANGUAGE TypeFamilies, MultiParamTypeClasses#-}+module Utils.DrawingClass where++class Draws a b where+ draw :: a -> b
+ Utils/GeometryClass.hs view
@@ -0,0 +1,53 @@+{-#LANGUAGE TypeFamilies,FlexibleInstances#-}+module Utils.GeometryClass where++import Utils.Rectangle+import Utils.Point++class Point2D a where+ type ELP a :: *+ pt :: a -> (ELP a, ELP a)+ toPt :: (ELP a,ELP a) -> a++instance Point2D (Int,Int) where+ type ELP (Int,Int) = Int+ pt = id+ toPt = id++instance Point2D (Double,Double) where+ type ELP (Double,Double) = Double+ pt = id+ toPt = id++convertPt :: (Point2D a, Point2D b, ELP a ~ ELP b) => a -> b+convertPt = toPt . pt++class BoundingBox a where+ type ELBB a :: *+ bounds :: a -> Rectangle (ELBB a)++class FromBounds a where+ type ELFB a :: *+ fromBounds :: Rectangle (ELFB a) -> a++instance BoundingBox (Rectangle a) where+ type ELBB (Rectangle a) = a+ bounds = id++instance FromBounds (Rectangle a) where+ type ELFB (Rectangle a) = a+ fromBounds = id++convertBounds :: (BoundingBox a, FromBounds b, ELBB a ~ ELFB b) => a -> b+convertBounds = fromBounds . bounds++-- type IntBounded a = (BoundingBox a,Integral (ELBB a))++class Line2D a where+ type ELL a :: *+ offsetAngle :: a -> (ELL a, Double)++class LineSegment a where+ type ELS a :: *+ startEnd :: a -> ((ELS a, ELS a),(ELS a, ELS a))+
Utils/Point.hs view
@@ -1,13 +1,15 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, TypeFamilies #-} module Utils.Point where ++ type Pt a = (a,a) instance Num a => Num (Pt a) where- (x1,x2) + (y1,y2) = (x1+y1,x2+y2) - (x1,x2) * (y1,y2) = (x1*y1,x2*y2) - (x1,x2) - (y1,y2) = (x1-y1,x2-y2) - negate (x1,x2) = (negate x1,negate x2) + (x1,x2) + (y1,y2) = (x1+y1,x2+y2)+ (x1,x2) * (y1,y2) = (x1*y1,x2*y2)+ (x1,x2) - (y1,y2) = (x1-y1,x2-y2)+ negate (x1,x2) = (negate x1,negate x2) abs (x1,x2) = (abs x1, abs x2) -- Not really mathematical, but the type must be same signum (x1,x2) = (signum x1, signum x2) -- Ditto fromInteger x = (fromInteger x,fromInteger x) -- As well
+ Utils/Pointer.hs view
@@ -0,0 +1,14 @@+module Utils.Pointer where +import Foreign.C.Types+import Foreign.ForeignPtr+import Foreign.Ptr+import Foreign.Marshal.Array++withPtrList :: [ForeignPtr a] -> (Ptr (Ptr a)-> IO b) -> IO b+withPtrList objs op = let+ ptrs = map unsafeForeignPtrToPtr objs+ in do+ r <- withArray ptrs op+ mapM_ touchForeignPtr objs + return r+
Utils/Rectangle.hs view
@@ -4,23 +4,24 @@ import Utils.Point import Control.DeepSeq -newtype Rectangle a = Rectangle ((a,a),(a,a)) deriving (Eq,Show)+data Rectangle a = Rectangle !a !a !a !a deriving (Eq,Show) -a `s` b = rnf a `seq` b +a `s` b = rnf a `seq` b+ instance (NFData a) => NFData (Rectangle a) where- rnf (Rectangle ((a,b),(c,d))) = (a `s` b `s` c `s` d) `seq` ()+ rnf (Rectangle a b c d) = (a `s` b `s` c `s` d) `seq` () -left (Rectangle ((x,y),(w,h))) = x-right (Rectangle ((x,y),(w,h))) = x+w-top (Rectangle ((x,y),(w,h))) = y-bottom (Rectangle ((x,y),(w,h))) = y+h-topLeft (Rectangle ((x,y),(w,h))) = (x,y)-topRight (Rectangle ((x,y),(w,h))) = (x+w,y) -bottomLeft (Rectangle ((x,y),(w,h))) = (x,y+h) -bottomRight (Rectangle ((x,y),(w,h))) = (x+w,y+h) +left (Rectangle x y w h) = x+right (Rectangle x y w h) = x+w+top (Rectangle x y w h) = y+bottom (Rectangle x y w h) = y+h+topLeft (Rectangle x y w h) = (x,y)+topRight (Rectangle x y w h) = (x+w,y)+bottomLeft (Rectangle x y w h) = (x,y+h)+bottomRight (Rectangle x y w h) = (x+w,y+h) vertices r = [topLeft r, topRight r, bottomLeft r, bottomRight r]-rSize (Rectangle ((x,y),(w,h))) = (w,h)+rSize (Rectangle x y w h) = (w,h) rArea r = let (w,h) = rSize r in (w*h) -- TODO: Add documentation #Cleanup@@ -29,17 +30,17 @@ series = cons4 $ \a b c d -> mkRectangle (a,b) (c,d) -- | Create rectangle around point (x,y)-around (x,y) (w,h) = mkRectangle (x', y') (w,h)+around (x,y) (w,h) = mkRectangle (x',y') (w,h) where (x',y') = (x-(w/2),y-(h/2)) -mkRectangle (x,y) (w,h) = Rectangle ((x-negW,y-negH),(abs w,abs h))+mkRectangle (x,y) (w,h) = Rectangle (x-negW) (y-negH) (abs w) (abs h) where negH | h<0 = abs h | h>=0 = 0 negW | w<0 = abs w | w>=0 = 0 -mkRectCorners (x1,y1) (x2,y2) = Rectangle ((x,y),(w,h))+mkRectCorners (x1,y1) (x2,y2) = Rectangle x y w h where x = min x1 x2 y = min y1 y2@@ -51,54 +52,56 @@ mkRec = uncurry mkRectangle +fromPtSize (x,y) (w,h) = Rectangle x y w h+ -- | Return rectangle r2 in coordinate system defined by r1-inCoords r1 r2@(Rectangle (pos,size)) = Rectangle (pos-topLeft r1,size )+inCoords r1 r2@(Rectangle x y w h) = fromPtSize ((x,y)-topLeft r1,(w,h) ) -- | Return a point in coordinates of given rectangle inCoords' r1 pt = pt - topLeft r1 -- | Adjust the size of the rectangle to be divisible by 2^n.-enlargeToNthPower n (Rectangle ((x,y),(w,h))) = Rectangle ((x,y),(w2,h2))+enlargeToNthPower n (Rectangle x y w h) = Rectangle x y w2 h2 where (w2,h2) = (pad w, pad h) pad x = x + (np - x `mod` np) np = 2^n -intersection r1 r2 +intersection r1 r2 = mkRectCorners (max (left r1) (left r2) ,max (top r1) (top r2)) (min (right r1) (right r2) ,min (bottom r1) (bottom r2)) -propIntersectionArea r1 r2 - = (intersects r1 r2) +propIntersectionArea r1 r2+ = (intersects r1 r2) ==> rArea (intersection r1 r2) <= rArea r1 && rArea (intersection r1 r2) <= rArea r2 -propIntersectionCommutes r1 r2 - = (intersects r1 r2) - ==> (intersection r1 r2) == (intersection r2 r1) +propIntersectionCommutes r1 r2+ = (intersects r1 r2)+ ==> (intersection r1 r2) == (intersection r2 r1) -intersects rect1 rect2 - = intersect1D (left rect1, right rect1) (left rect2, right rect2) && +intersects rect1 rect2+ = intersect1D (left rect1, right rect1) (left rect2, right rect2) && intersect1D (top rect1, bottom rect1) (top rect2, bottom rect2) -contains a b = left a <= left b - && top a <= top b +contains a b = left a <= left b+ && top a <= top b && bottom a >= bottom b && right a >= right b -intersect1D (x,y) (u,w) = - not $ (x < min u w && y < min u w) || (x > max u w && y > max u w) +intersect1D (x,y) (u,w) =+ not $ (x < min u w && y < min u w) || (x > max u w && y > max u w) -prop_intersect1DCommutes a b +prop_intersect1DCommutes a b = intersect1D a b == intersect1D b a -prop_intersectsCommutes sa@(_,(s1,s2)) sb@(b,(s3,s4)) +prop_intersectsCommutes sa@(_,(s1,s2)) sb@(b,(s3,s4)) = intersects (mkRec sa) (mkRec sb) == intersects (mkRec sb) (mkRec sa) --- | Create a tiling of a rectangles. -tile tilesize overlap r = [mkRectangle ((x,y)-overlap) tilesize +-- | Create a tiling of a rectangles.+tile tilesize overlap r = [mkRectangle ((x,y)-overlap) tilesize | x <- [startx,startx+fst tilesize..endx] , y <- [starty,starty+fst tilesize..endy] ] where@@ -108,13 +111,12 @@ endy = bottom r+snd overlap -- | Scale a rectangle-scale (a,b) (Rectangle ((x,y),(s1,s2))) +scale (a,b) (Rectangle x y s1 s2) = mkRectangle (round (a*fromIntegral x),round (b*fromIntegral y)) (round (a*fromIntegral s1),round (b*fromIntegral s2)) -toInt (Rectangle (p, s)) - = Rectangle (both round p - ,both round s)- where both f (a,b) = (f a , f b)+toInt (Rectangle a b c d)+ = Rectangle (f a) (f b) (f c) (f d)+ where f = fromIntegral
Utils/Stream.hs view
@@ -12,7 +12,7 @@ sideEffect :: (Monad m) => (a -> m ()) -> Stream m a -> Stream m a sideEffect p Terminated = Terminated sideEffect p (Value next) = Value renext- where + where renext = do (r,n) <- next p r@@ -22,13 +22,13 @@ listToStream [] = Terminated listToStream (l:lst) = Value (return (l,listToStream lst)) repeatS x = Value (return (x,repeatS x))-repeatSM x = sequenceS (repeatS x) +repeatSM x = sequenceS (repeatS x) -- | Create a stream by iterating a monadic action iterateS op n = Value cont- where + where cont = do r <- op n- return $ (n,iterateS op r) + return $ (n,iterateS op r) -- | Pure and monadic left fold over a stream foldS op i Terminated = return i@@ -46,7 +46,6 @@ mergeS Terminated _ = Terminated mergeS _ Terminated = Terminated-mergeS _ Terminated = Terminated mergeS (Value xs) (Value ys) = Value renext where renext = do@@ -71,13 +70,13 @@ push x Terminated = Value (return (x,Terminated)) push x xs = Value (return (x,xs))- + -- | Map over a stream instance (Monad m) => Functor (Stream m) where fmap _ Terminated = Terminated fmap f (Value next) = Value renext- where + where renext = do (r,n) <- next return (f r,fmap f n)@@ -86,21 +85,21 @@ pure f = repeatS f Terminated <*> _ = Terminated _ <*> Terminated = Terminated- (Value a) <*> (Value b) = Value renext - where + (Value a) <*> (Value b) = Value renext+ where renext = do (fun,anext) <- a (br,bnext) <- b return (fun br,anext<*>bnext)- + zipS a b = (,) <$> a <*> b- + -- sequenceS :: (Monad m) => Stream m (m a) -> (Stream m a) sequenceS Terminated = Terminated sequenceS (Value next) = Value $ do (op,n) <- next- r <- op + r <- op return (r,sequenceS n) mapMS :: (Monad m) => (a -> m b) -> Stream m a -> Stream m b@@ -115,7 +114,7 @@ drop 0 s = return s drop _ Terminated = return Terminated drop n (Value next) = do- (r,ne) <- next + (r,ne) <- next drop (n-1) ne renext = do r <- drop n next@@ -182,4 +181,4 @@ runLast n next runLast1 s = runLast (error "Empty Stream") s- +
+ cbits/cvIterators.c view
@@ -0,0 +1,63 @@+#include "cvIterators.h"+#include <stdio.h>++F32_image_iterator *alloc_F32_image_iterator()+{+ return (F32_image_iterator *)malloc(sizeof(F32_image_iterator));+}++void free_F32_image_iterator(F32_image_iterator *i)+{+ free(i);+}++void F32_create_rowwise_iterator(F32_image_iterator *i, IplImage *image)+{+ i->image_data = (float *)image->imageData;+ i->pixel_offset = image->nChannels;+ i->line_offset = (image->widthStep / sizeof(float)) - (image->width * image->nChannels) + 1;+ i->line_counter = image->width - 1;+ i->end_counter = image->height - 1;+ i->line_length = image->width;+ i->line_count = image->height;+}++F32_image_iterator *F32_next(F32_image_iterator *i)+{+ if (i->line_counter--) {+ i->image_data += i->pixel_offset;+ }+ else {+ if (i->end_counter--) {+ i->line_counter = i->line_length - 1;+ i->image_data += i->line_offset;+ }+ else {+ i->image_data = NULL;+ /* a bit clumsy, but needed to avoid trouble in case this is */+ /* called again after reaching the end */+ i->line_counter = 0;+ i->end_counter = 0;+ }+ }+ return i;+}++float *F32_val(F32_image_iterator *i)+{+ return i->image_data;+}++CvPoint *F32_rowwise_pos(F32_image_iterator *i)+{+ /* store the pos to struct member, so we can pass pointers to haskell.. */+ /* getting the pos like this is expensive, but assume it is used rarely */+ i->pos.x = i->line_length - i->line_counter - 1;+ i->pos.y = i->line_count - i->end_counter - 1;+/*+ if (i->image_data != NULL) {+ printf("P((%d,%d),%0.2f)", i->pos.x, i->pos.y, *(i->image_data));+ }+*/+ return &i->pos;+}
+ cbits/cvIterators.h view
@@ -0,0 +1,56 @@+#ifndef __CVITERATORS__+#define __CVITERATORS__++#include <opencv/cv.h>++/*+Image Iterators.++Provides an 'image context' with+-a pointer to image data+-a scheme for updating the pointer in a manner to iterate over the image+-some iterators allow to change image content as well+-some iterators may provide access to a neighborhood+*/++typedef struct F32_image_iterator_t {+ /** pointer to current data position */+ float *image_data;+ /** offset to next pixel */+ int pixel_offset;+ /** offset to start of next col/row */+ int line_offset;+ /** counter to the end of current col/row */+ unsigned int line_counter;+ /** counter to the end of image */+ unsigned int end_counter;+ /** line length for resetting the line end counter */+ unsigned int line_length;+ /** total amount of lines */+ unsigned int line_count;+ /** current pixel position (updated only upon request) */+ CvPoint pos;+} F32_image_iterator;++F32_image_iterator *alloc_F32_image_iterator();++void free_F32_image_iterator(F32_image_iterator *i);++void F32_create_rowwise_iterator(F32_image_iterator *i, IplImage *image);++/**+ * Move the iterator to the next position+ */+F32_image_iterator *F32_next(F32_image_iterator *i);++/**+ * Acquire the pixel value+ */+float *F32_val(F32_image_iterator *i);++/**+ * Acquire the [x,y] position of this pixel+ */+CvPoint *F32_rowwise_pos(F32_image_iterator *i);++#endif
+ cbits/cvWrapCore.c view
@@ -0,0 +1,69 @@+#include "cvWrapCore.h"+#include <opencv2/core/core.hpp>++IplImage* wrapCreateImage(int width, int height, int depth, int channels)+{+ CvSize s;+ IplImage *r;+ s.width = width;+ s.height = height;+ r = cvCreateImage(s,depth,channels);+ cvSetZero(r);+ return r;+}++void wrapSet(CvArr* arr, CvScalar *value, CvArr* mask)+{+ cvSet(arr, *value, mask);+}++void wrapSetAll(CvArr* arr, double value, CvArr* mask)+{+ cvSet(arr, cvScalarAll(value), mask);+}++void wrapSet1(CvArr* arr, double value, CvArr* mask)+{+ cvSet(arr, cvRealScalar(value), mask);+}++void wrapSet2(CvArr* arr, double value1, double value2, CvArr* mask)+{+ cvSet(arr, cvScalar(value1, value2, 0, 0), mask);+}++void wrapSet3(CvArr* arr, double value1, double value2, double value3, CvArr* mask)+{+ cvSet(arr, cvScalar(value1, value2, value3, 0), mask);+}++void wrapSet4(CvArr* arr, double value1, double value2, double value3, double value4, CvArr* mask)+{+ cvSet(arr, cvScalar(value1, value2, value3, value4), mask);+}++void swapQuadrants(CvArr *src)+{+ int cx, cy;+ CvMat *tmp, q0, q1, q2, q3;++ cx = cvGetDimSize(src, 0) / 2;+ cy = cvGetDimSize(src, 1) / 2;++ tmp = cvCreateMat(cx,cy,cvGetElemType(src));++ cvGetSubRect(src, &q0, cvRect(0,0,cx,cy));+ cvGetSubRect(src, &q1, cvRect(cx,0,cx,cy));+ cvGetSubRect(src, &q2, cvRect(0,cy,cx,cy));+ cvGetSubRect(src, &q3, cvRect(cx,cy,cx,cy));++ cvCopy(&q0,tmp, NULL);+ cvCopy(&q3,&q0, NULL);+ cvCopy(tmp,&q3, NULL);++ cvCopy(&q1,tmp, NULL);+ cvCopy(&q2,&q1, NULL);+ cvCopy(tmp,&q2, NULL);++ cvReleaseMat(&tmp);+}
+ cbits/cvWrapCore.h view
@@ -0,0 +1,26 @@+#ifndef __CVWRAPCORE__+#define __CVWRAPCORE__++#include <opencv2/core/core_c.h>++/* add missing flag values */++#define CV_DXT_COMPLEX_OUTPUT 16+#define CV_DXT_REAL_OUTPUT 32+#define CV_DXT_INV_REAL (CV_DXT_INVERSE + CV_DXT_REAL_OUTPUT)++IplImage* wrapCreateImage(int width, int height, int depth, int channels);++/* wrap CvScalar as cvSet parameter */++void wrapSet(CvArr* arr, CvScalar *value, CvArr* mask);+void wrapSetAll(CvArr* arr, double value, CvArr* mask);+void wrapSet1(CvArr* arr, double value, CvArr* mask);+void wrapSet2(CvArr* arr, double value1, double value2, CvArr* mask);+void wrapSet3(CvArr* arr, double value1, double value2, double value3, CvArr* mask);+void wrapSet4(CvArr* arr, double value1, double value2, double value3, double value4, CvArr* mask);++/* swap the quadrants 1-3 and 2-4 in a DFT image */+void swapQuadrants(CvArr *src);++#endif
cbits/cvWrapLEO.c view
@@ -6,6 +6,7 @@ //@+node:aleator.20050908100314.1:Includes #include "cvWrapLEO.h" #include <stdio.h>+#include <opencv2/core/types_c.h> #include <complex.h> #include <stdint.h> @@ -17,6 +18,31 @@ size_t images; +inline double eucNorm(CvPoint2D64f p) {return (p.x*p.x+p.y*p.y);}+inline CvPoint2D64f toNormalizedCoords(CvSize area, CvPoint from)+{+ CvPoint2D64f res;+ res.x = (from.x-area.width/2.0)/area.width;+ res.y = (from.y-area.height/2.0)/area.height;+ return res;+}++inline CvPoint fromNormalizedCoords(CvSize area, CvPoint2D64f from)+{+ CvPoint res;+ res.x = (from.x+0.5)*area.width;+ res.y = (from.y+0.5)*area.height;+ return res;+}++inline CvPoint2D64f fromNormalizedCoords64f(CvSize area, CvPoint2D64f from)+{+ CvPoint2D64f res;+ res.x = (from.x+0.5)*area.width;+ res.y = (from.y+0.5)*area.height;+ return res;+}+ void incrImageC(void) { images++;@@ -105,6 +131,26 @@ return r; } +IplImage *wrapCopyMakeBorder(IplImage* src+ ,const int top+ ,const int bottom+ ,const int left+ ,const int right+ ,const int borderType+ ,const float value)+{+ CvSize s = cvGetSize(src);+ s.width += left + right;+ s.height += top + bottom;+ IplImage *r;+ CvPoint p;+ p.x = left;+ p.y = top;+ r = cvCreateImage(s, src->depth, src->nChannels);+ cvCopyMakeBorder(src,r,p,borderType,cvScalarAll((double)value));+ return r;+}+ IplImage* composeMultiChannel(IplImage* img0 ,IplImage* img1 ,IplImage* img2@@ -139,9 +185,9 @@ cvAbsDiffS(src,dst,cvScalarAll(s)); } -double wrapAvg(const CvArr *src)+double wrapAvg(const CvArr *src, const CvArr *mask) {- CvScalar avg = cvAvg(src,0);+ CvScalar avg = cvAvg(src,mask); return avg.val[0]; } @@ -157,7 +203,7 @@ CvScalar dev; IplImage *mask8 = ensure8U(mask); cvAvgSdv(src,0,&dev,mask8);- cvReleaseImage(&mask8); + cvReleaseImage(&mask8); return dev.val[0]; } double wrapMeanMask(const CvArr *src,const CvArr *mask)@@ -165,7 +211,7 @@ CvScalar mean; IplImage *mask8 = ensure8U(mask); cvAvgSdv(src,&mean,0,mask8);- cvReleaseImage(&mask8); + cvReleaseImage(&mask8); return mean.val[0]; } @@ -192,11 +238,11 @@ { pixel = cvGetReal2D(src,j,i); maskP = mask != 0 ? cvGetReal2D(mask,j,i) : 1;- // TODO: Fix below.. - min = (maskP >0.5 ) && (pixel < min) ? pixel : min; - max = (maskP >0.5 ) && (pixel > max) ? pixel : max; + // TODO: Fix below..+ min = (maskP >0.5 ) && (pixel < min) ? pixel : min;+ max = (maskP >0.5 ) && (pixel > max) ? pixel : max; }- (*minVal) = min; (*maxVal) = max; + (*minVal) = min; (*maxVal) = max; } void wrapSetImageROI(IplImage *i,int x, int y, int w, int h)@@ -206,7 +252,7 @@ } -// Return image that is IPL_DEPTH_8U version of +// Return image that is IPL_DEPTH_8U version of // given src IplImage* ensure8U(const IplImage *src) {@@ -228,11 +274,11 @@ default: printf("Cannot convert to floating image"); abort();- + } } -// Return image that is IPL_DEPTH_32F version of +// Return image that is IPL_DEPTH_32F version of // given src IplImage* ensure32F(const IplImage *src) {@@ -261,32 +307,32 @@ default: printf("Cannot convert to floating image"); abort();- + } } void wrapSet32F2D(CvArr *arr, int x, int y, double value)-{ - cvSet2D(arr,x,y,cvRealScalar(value)); +{+ cvSet2D(arr,x,y,cvRealScalar(value)); } double wrapGet32F2D(CvArr *arr, int x, int y)-{ +{ CvScalar r;- r = cvGet2D(arr,x,y); + r = cvGet2D(arr,x,y); return r.val[0]; } double wrapGet32F2DC(CvArr *arr, int x, int y,int c)-{ +{ CvScalar r;- r = cvGet2D(arr,x,y); + r = cvGet2D(arr,x,y); return r.val[c]; } uint8_t wrapGet8U2DC(IplImage *arr, int x, int y,int c)-{ +{ return UGETC(arr,c,y,x); } @@ -303,7 +349,7 @@ cvPutText(img, text, cvPoint(x,y), &font, CV_RGB(r,g,b)); } -void wrapDrawRectangle(CvArr *img, int x1, int y1, +void wrapDrawRectangle(CvArr *img, int x1, int y1, int x2, int y2, float r, float g, float b, int thickness) {@@ -317,13 +363,13 @@ } void wrapFillPolygon(IplImage *img, int pc, int *xs, int *ys, float r, float g, float b)-{ +{ int i=0; int pSizes[] = {pc}; CvPoint *pts = (CvPoint*)malloc(pc*sizeof(CvPoint)); for (i=0; i<pc; ++i)- {pts[i].x = xs[i]; - pts[i].y = ys[i]; + {pts[i].x = xs[i];+ pts[i].y = ys[i]; } cvFillPoly(img, &pts, pSizes, 1, CV_RGB(r,g,b), 8, 0 ); free(pts);@@ -345,11 +391,11 @@ CvRect r; CvSize s; IplImage *newImage;- + r.x = sx; r.y = sy; r.width = w; r.height = h; s.width = w; s.height = h;- + cvSetImageROI(img,r); newImage = cvCreateImage(s,img->depth,img->nChannels); cvCopy(img, newImage,0);@@ -413,7 +459,7 @@ CvSize size = cvGetSize(src); int w = size.width-(size.width % 2); int h = size.height-(size.height % 2);- IplImage *result = wrapCreateImage32F(w,h,1); + IplImage *result = wrapCreateImage32F(w,h,1); CvRect pos = cvRect(0 ,0 ,size.width@@ -431,7 +477,7 @@ int w = size.width+(size.width % 2); int h = size.height+(size.height % 2); int j;- IplImage *result = wrapCreateImage32F(w,h,1); + IplImage *result = wrapCreateImage32F(w,h,1); CvRect pos = cvRect(0 ,0 ,size.width@@ -455,7 +501,7 @@ int w = size.width + (right ? 1 : 0); int h = size.height+ (bottom ? 1 : 0); int j;- IplImage *result = wrapCreateImage32F(w,h,1); + IplImage *result = wrapCreateImage32F(w,h,1); CvRect pos = cvRect(0 ,0 ,size.width@@ -472,7 +518,7 @@ {for (j=0; j<=size.width; j++) { FGET(result,j,(size.height)) = 2*FGET(result,j,(size.height-1))- -FGET(result,j,(size.height-2)); + -FGET(result,j,(size.height-2)); } } return result; }@@ -483,7 +529,7 @@ CvSize size = cvGetSize(dst); for (i=0; i<size.width; i++) for (j=0; j<size.height; j++) {- FGET(dst,i,j) = FGET(src1,i,j)*FGET(mask,i,j) + FGET(dst,i,j) = FGET(src1,i,j)*FGET(mask,i,j) +FGET(src2,i,j)*(1-FGET(mask,i,j)); } }@@ -505,7 +551,7 @@ IplImage* fadedEdges(int w, int h, int edgeW) { IplImage *result; int i,j;- result = wrapCreateImage32F(w,h,1); + result = wrapCreateImage32F(w,h,1); for (i=0; i<h; i++) for (j=0; j<w; j++) { float dx = i < (h/2.0) ? i : h-i ;@@ -520,7 +566,7 @@ IplImage* rectangularDistance(int w, int h) { IplImage *result; int i,j;- result = wrapCreateImage32F(w,h,1); + result = wrapCreateImage32F(w,h,1); for (i=0; i<h; i++) for (j=0; j<w; j++) { float dx = i < (h/2.0) ? i/(h*1.0) : (h-i)/(h*1.0) ;@@ -536,7 +582,7 @@ double r; const double x0 = w/2.0; const double y0 = h/2.0;- result = wrapCreateImage32F(w,h,1); + result = wrapCreateImage32F(w,h,1); for (i=0; i<h; i++) for (j=0; j<w; j++) { nx = (y0-i)/h;@@ -553,7 +599,7 @@ double r; const double x0 = w/2.0; const double y0 = h/2.0;- result = wrapCreateImage32F(w,h,1); + result = wrapCreateImage32F(w,h,1); for (i=0; i<h; i++) for (j=0; j<w; j++) { r = fabs((i-y0)/y0) ;@@ -566,20 +612,19 @@ IplImage *result; int i,j; double r;- result = wrapCreateImage32F(w,h,1); + result = wrapCreateImage32F(w,h,1); for (i=0; i<h; i++) for (j=0; j<w; j++) { FGET(result,j,i) = -((i-c)*s)*((i-c)*s)-m; } return result; }-inline double eucNorm(CvPoint2D64f p) {return (p.x*p.x+p.y*p.y);} IplImage* vignettingModelB3(int w, int h,double b1, double b2, double b3) { IplImage *result; int i,j; double r;- result = wrapCreateImage32F(w,h,1); + result = wrapCreateImage32F(w,h,1); for (i=0; i<h; i++) for (j=0; j<w; j++) { CvPoint2D64f nor = toNormalizedCoords(cvSize(w,h),cvPoint(j,i));@@ -594,7 +639,7 @@ double r; double mx = w/2.0; double my = w/2.0;- result = wrapCreateImage32F(w,h,1); + result = wrapCreateImage32F(w,h,1); for (i=0; i<h; i++) for (j=0; j<w; j++) { FGET(result,j,i) =-((i-my)*scaley)*((i-my)*scaley)*((j-mx)*scalex)*((j-mx)*scalex)-max ;@@ -606,7 +651,7 @@ IplImage *result; int i,j; double r;- result = cvCloneImage(src); + result = cvCloneImage(src); int h = cvGetSize(src).height; int w = cvGetSize(src).width; CvPoint2D32f srcPts[4] = {{0,0},{w-1,0},{w-1,h-1},{0,h-1}};@@ -644,30 +689,7 @@ cvReleaseMat(&hmg); } -inline CvPoint2D64f toNormalizedCoords(CvSize area, CvPoint from)-{- CvPoint2D64f res;- res.x = (from.x-area.width/2.0)/area.width;- res.y = (from.y-area.height/2.0)/area.height; - return res;-} -inline CvPoint fromNormalizedCoords(CvSize area, CvPoint2D64f from)-{- CvPoint res;- res.x = (from.x+0.5)*area.width;- res.y = (from.y+0.5)*area.height; - return res;-}--inline CvPoint2D64f fromNormalizedCoords64f(CvSize area, CvPoint2D64f from)-{- CvPoint2D64f res;- res.x = (from.x+0.5)*area.width;- res.y = (from.y+0.5)*area.height; - return res;-}- void alphaBlit(IplImage *a, IplImage *aAlpha, IplImage *b, IplImage *bAlpha, int offset_y, int offset_x) { // TODO: Add checks for image type and size@@ -701,9 +723,9 @@ for (i=0; i<bSize.height; i++) { for (j=0; j<bSize.width; j++) { if (j+offset_x<0 || j+offset_x>=aSize.width || i+offset_y<0 || i+offset_y>=aSize.height ) continue;- if (a->nChannels == 1) + if (a->nChannels == 1) {FGET(a,j+offset_x,i+offset_y) =FGET(b,j,i);}- else if (a->nChannels ==3) + else if (a->nChannels ==3) { int dx = j+offset_x; int dy = i+offset_y; ((float *)(a->imageData + dy*a->widthStep))[dx*a->nChannels + 0] =@@ -780,13 +802,13 @@ } // Convolutions-IplImage* wrapFilter2D(IplImage *src, int ax,int ay, +IplImage* wrapFilter2D(IplImage *src, int ax,int ay, int w, int h, double *kernel){ int i,j; IplImage *target = cvCloneImage(src); CvMat *kernelMat = cvCreateMat(w,h,CV_32FC1); for(i=0;i<w*h;i++)- cvSetReal2D(kernelMat,i%w,i/w,kernel[i]); + cvSetReal2D(kernelMat,i%w,i/w,kernel[i]); cvFilter2D(src,target,kernelMat,cvPoint(ay,ax)); cvReleaseMat(&kernelMat); return target;@@ -802,7 +824,7 @@ CvMat *kernelMat = cvCreateMat(size.width,size.height,CV_32FC1); for(i=0;i<size.width;i++) for(j=0;j<size.height;j++)- cvSetReal2D(kernelMat,i,j,cvGetReal2D(mask,j,i)); + cvSetReal2D(kernelMat,i,j,cvGetReal2D(mask,j,i)); cvFilter2D(src,target,kernelMat,cvPoint(ay,ax)); cvReleaseMat(&kernelMat); return target;@@ -817,7 +839,7 @@ cvFloodFill(i,cvPoint(x,y),cvRealScalar(c),cvRealScalar(low) ,cvRealScalar(high),NULL,flag,NULL); }- + // hough-lines void wrapProbHoughLines(IplImage *img, double rho, double theta@@ -830,8 +852,8 @@ IplImage *tmp; CvSeq *lines = 0; int i;- CvMemStorage *storage = cvCreateMemStorage(0); - + CvMemStorage *storage = cvCreateMemStorage(0);+ tmp = ensure8U(img); lines = cvHoughLines2(tmp,storage,CV_HOUGH_PROBABILISTIC@@ -840,17 +862,17 @@ { CvPoint* line = (CvPoint*)cvGetSeqElem(lines,i); xs[i] = line[0].x; xs1[i] = line[1].x;- ys[i] = line[0].y; ys1[i] = line[1].y; + ys[i] = line[0].y; ys1[i] = line[1].y; } *maxLines = MIN(lines->total,*maxLines); cvReleaseImage(&tmp); cvReleaseMemStorage(&storage);- + }- + //@-node:aleator.20050908100314.2:Wrappers //@+node:aleator.20050908100314.3:Utilities /* These are utilities that operate on opencv primitives but@@ -907,7 +929,7 @@ // Simple routines for calculating pixelwise // haar responses -void haarFilter(IplImage *intImg, +void haarFilter(IplImage *intImg, int x1, int y1, int x2, int y2, IplImage *target) {@@ -917,12 +939,12 @@ double desArea = (x2-x1)*(y1-y2); double area = 0; int rx1,rx2,ry1,ry2;- CvSize imageSize = cvGetSize(target); + CvSize imageSize = cvGetSize(target); for(i=0; i<imageSize.width; ++i) for(j=0; j<imageSize.height; ++j) {- rx1 = imax(0,imin(i+x1,imageSize.width-1)); + rx1 = imax(0,imin(i+x1,imageSize.width-1)); ry1 = imax(0,imin(j+y1,imageSize.height-1));- rx2 = imax(0,imin(i+x2,imageSize.width-1)); + rx2 = imax(0,imin(i+x2,imageSize.width-1)); ry2 = imax(0,imin(j+y2,imageSize.height-1)); area = (float)((rx2-rx1)*(ry2-ry1)); // if (area > 0) ratio = fabs(desArea/area);@@ -936,7 +958,7 @@ } } -double haar_at(IplImage *intImg, +double haar_at(IplImage *intImg, int x1, int y1, int w, int h) { int i,j;@@ -947,7 +969,7 @@ +blurGet2D(intImg,x1+w,y1+h); return s; }- + //@nonl //@-node:aleator.20070827150608:Haar Filters //@+node:aleator.20070130144337:Statistics along a line@@ -977,10 +999,10 @@ if (y0 < y1) {ystep = 1;} else {ystep = -1;} for (x=x0; x<x1; ++x) { if (steep) {sum+=blurGet2D(src,y,x);- ++len;} - // _plot(y,x);} + ++len;}+ // _plot(y,x);} else {sum+=blurGet2D(src,x,y);- ++len; } + ++len; } //_plot(x,y);} error = error + deltay; if (2*error >= deltax) {@@ -1036,7 +1058,7 @@ double m1 = calculateMoment(1,arr, l); double result = 0; for(j=0; j<l; j++)- { + { result += pow(((j*1.0)/HISTOGRAMSIZE)-m1,i)*arr[j]; }@@ -1055,7 +1077,7 @@ int y = 0; int i = 0; int j = 0;-double histogram[HISTOGRAMSIZE]; +double histogram[HISTOGRAMSIZE]; for (x=0; x<ih; x++) for (y=0; y<iw; y++) {@@ -1071,7 +1093,7 @@ } -result = calculateCentralMoment(n,histogram,HISTOGRAMSIZE); +result = calculateCentralMoment(n,histogram,HISTOGRAMSIZE); cvSet2D(target,x,y,cvScalarAll(result)); } @@ -1089,7 +1111,7 @@ int y = 0; int i = 0; int j = 0;-double histogram[HISTOGRAMSIZE]; +double histogram[HISTOGRAMSIZE]; for (x=0; x<ih; x++) for (y=0; y<iw; y++) {@@ -1105,7 +1127,7 @@ } -result = calculateAbsCentralMoment(n,histogram,HISTOGRAMSIZE); +result = calculateAbsCentralMoment(n,histogram,HISTOGRAMSIZE); cvSet2D(target,x,y,cvScalarAll(result)); } @@ -1123,7 +1145,7 @@ int y = 0; int i = 0; int j = 0;-double histogram[HISTOGRAMSIZE]; +double histogram[HISTOGRAMSIZE]; for (x=0; x<ih; x++) for (y=0; y<iw; y++) {@@ -1138,7 +1160,7 @@ histogram[slot] += 1.0/(w*h*1.0); } -result = calculateMoment(n,histogram,HISTOGRAMSIZE); +result = calculateMoment(n,histogram,HISTOGRAMSIZE); cvSet2D(target,x,y,cvScalarAll(result)); } @@ -1147,7 +1169,7 @@ //@-node:aleator.20050930104348.1:Central Moments //@+node:aleator.20051103110155:SMAB- + // Perform second moment adaptive binarization for a single pixel `x` // using given histogram. double max(double x,double y) {if (x<y) return y; else return x;}@@ -1212,14 +1234,14 @@ //@-node:aleator.20051108093248:Skewness //@-node:aleator.20050930104348:Histogram Features //@+node:aleator.20050926095227:Susan-/* - Susan (Smallest Univalue Segmenting Nucleus) is +/*+ Susan (Smallest Univalue Segmenting Nucleus) is family of image processing methods, including edge preserving noise reduction. */ //@+node:aleator.20050926095227.1:Susan Smoothing Function -/* +/* Calculate susan smoothing for `src` around `x`,`y` coordinates. `t` determines brightness treshold and sigma controls scale of spatial smoothing. `w` and `h` determine window size.@@ -1239,7 +1261,7 @@ { if (i==w/2 && j==h/2) continue; double r2 = i*i+j*j;- double expFrac = (cvGet2D(src,x+i,y+j).val[0] + double expFrac = (cvGet2D(src,x+i,y+j).val[0] - cvGet2D(src,x,y).val[0]); expFrac *= expFrac; @@ -1277,7 +1299,7 @@ } //@-node:aleator.20050926100856:Susan Smoothing //@+node:aleator.20050927083244:Susan Edge-/* +/* Susan Edge Detector. */ @@ -1329,13 +1351,13 @@ //@-node:aleator.20050927083244:Susan Edge //@-node:aleator.20050926095227:Susan //@+node:aleator.20050908112008:Gabors-/* +/* Gabor functions are modulated gaussians which bear some resemblance to human visual cortex neurons. */ //@+node:aleator.20050908104238:gabor function in C /* This function calculates value of simple gabor function at given x,y coordinates. Parameters for the gabor are:- + stdX - standard deviation in oscillation direction stdY - standard deviation tangential to stdX theta - angle (in radians) of the gabor@@ -1353,7 +1375,7 @@ double oscillationPart = cos(2*M_PI*xth/cycles+phase); double gaussianPart = exp((-0.5*xth*xth)/(stdX*stdX)) *exp((-0.5*yth*yth)/(stdY*stdY));- + return gaussianPart * oscillationPart; } @@ -1365,7 +1387,7 @@ double oscillationPart = cos(2*M_PI*(x-center)/cycles+phase); double gaussianPart = exp((-0.5*(x-center)*(x-center)) /(sigma*sigma));- + return gaussianPart * oscillationPart; } @@ -1437,7 +1459,7 @@ *maxy = maxPoint.y ; *minx = minPoint.x ; *miny = minPoint.y ;-} +} void simpleMatchTemplate(const IplImage* target, const IplImage* template, int* x, int* y, double *val,int type) {@@ -1456,7 +1478,7 @@ *y = maxPoint.y;+rh/2; *val = max; cvReleaseImage(&result);- } + } IplImage* templateImage(const IplImage* target, const IplImage* template) {@@ -1465,7 +1487,7 @@ IplImage* result = wrapCreateImage32F(rw,rh,1); cvMatchTemplate(target,template,result,CV_TM_CCORR); return result;- } + } //@-node:aleator.20050908112116:rendering gabors to arrays@@ -1519,19 +1541,19 @@ int width = size.width; int height = size.height; double result=0;-double tij=0,wij=0,testij=0,rij=0; +double tij=0,wij=0,testij=0,rij=0; for (i=0; i<width; i++) for (j=0; j<height; j++)- { + { tij = cvGetReal2D(target,j,i); wij = cvGetReal2D(weigths,j,i); testij = cvGetReal2D(test,j,i); rij=wij;- if (((tij < 0.2) && (testij < 0.2)) || ((tij > 0.8) && (testij > 0.8))) - {rij=0;} + if (((tij < 0.2) && (testij < 0.2)) || ((tij > 0.8) && (testij > 0.8)))+ {rij=0;} result += rij; }- + return result; } //@-node:aleator.20070511142414.1:Fitness@@ -1549,24 +1571,24 @@ int i,j; int width = size.width; int height = size.height;-double tij=0,wij=0,testij=0,rij=0; +double tij=0,wij=0,testij=0,rij=0; IplImage *result = wrapCreateImage32F(width,height,1); for (i=0; i<width; i++) for (j=0; j<height; j++)- { + { tij = cvGetReal2D(target,j,i); wij = cvGetReal2D(weigths,j,i); testij = cvGetReal2D(test,j,i); if ( (tij>0.2) && (tij<0.8) ) continue;- if (((tij < 0.2) && (testij < 0.2)) - || ((tij > 0.8) && (testij > 0.8))) + if (((tij < 0.2) && (testij < 0.2))+ || ((tij > 0.8) && (testij > 0.8))) {rij = wij*exp(-at); cvSetReal2D(result,j,i,rij); }- else + else {rij = wij*exp(at); cvSetReal2D(result,j,i,rij); } }- + return result; } @@ -1574,13 +1596,13 @@ //@-node:aleator.20070511142414:Adaboost Learning //@+node:aleator.20051207074905:LBP -void get_weighted_histogram(IplImage *src, IplImage *weights, - double start, double end, +void get_weighted_histogram(IplImage *src, IplImage *weights,+ double start, double end, int bins, double *histo) { int i,j,index; double value,weight;- CvSize imageSize = cvGetSize(src); + CvSize imageSize = cvGetSize(src); for(i=0;i<bins;++i) histo[i]=0; for(i=0; i<imageSize.width-1; ++i) for(j=0; j<imageSize.height-1; ++j)@@ -1592,10 +1614,10 @@ if (index<0 || index>=bins) continue; histo[index] += weight; }- + } -// Calculate local binary pattern for image. +// Calculate local binary pattern for image. // LBP is outgoing array // of (preallocated) 256 bytes that are assumed to be 0. void localBinaryPattern(IplImage *src, int *LBP)@@ -1603,7 +1625,7 @@ int i,j; int pattern = 0; double center = 0;- CvSize imageSize = cvGetSize(src); + CvSize imageSize = cvGetSize(src); for(i=1; i<imageSize.width-1; ++i) for(j=1; j<imageSize.height-1; ++j) {@@ -1612,10 +1634,10 @@ pattern += (blurGet2D(src,i-1,j-1) > center) *1; pattern += (blurGet2D(src,i,j-1) > center) *2; pattern += (blurGet2D(src,i+1,j-1) > center) *4;- + pattern += (blurGet2D(src,i-1,j) > center) *8; pattern += (blurGet2D(src,i+1,j) > center) *16;- + pattern += (blurGet2D(src,i-1,j+1) > center) *32; pattern += (blurGet2D(src,i,j+1) > center) *64; pattern += (blurGet2D(src,i+1,j+1) > center) *128;@@ -1630,7 +1652,7 @@ int i,j; int pattern = 0; double center = 0;- CvSize imageSize = cvGetSize(src); + CvSize imageSize = cvGetSize(src); for(i=1; i<imageSize.width-1; ++i) for(j=1; j<imageSize.height-1; ++j) {@@ -1639,10 +1661,10 @@ pattern += (blurGet2D(src,i-2,j-2) > center) *1; pattern += (blurGet2D(src,i,j-3) > center) *2; pattern += (blurGet2D(src,i+2,j-2) > center) *4;- + pattern += (blurGet2D(src,i-3,j) > center) *8; pattern += (blurGet2D(src,i+3,j) > center) *16;- + pattern += (blurGet2D(src,i-2,j+2) > center) *32; pattern += (blurGet2D(src,i,j+3) > center) *64; pattern += (blurGet2D(src,i+2,j+2) > center) *128;@@ -1655,7 +1677,7 @@ int i,j; int pattern = 0; double center = 0;- CvSize imageSize = cvGetSize(src); + CvSize imageSize = cvGetSize(src); for(i=1; i<imageSize.width-1; ++i) for(j=1; j<imageSize.height-1; ++j) {@@ -1664,10 +1686,10 @@ pattern += (blurGet2D(src,i-4,j-4) > center) *1; pattern += (blurGet2D(src,i,j-5) > center) *2; pattern += (blurGet2D(src,i+4,j-4) > center) *4;- + pattern += (blurGet2D(src,i-5,j) > center) *8; pattern += (blurGet2D(src,i+5,j) > center) *16;- + pattern += (blurGet2D(src,i-4,j+4) > center) *32; pattern += (blurGet2D(src,i,j+5) > center) *64; pattern += (blurGet2D(src,i+4,j+4) > center) *128;@@ -1683,7 +1705,7 @@ int pattern = 0; double center = 0; double weight = 0;- CvSize imageSize = cvGetSize(src); + CvSize imageSize = cvGetSize(src); for(i=1; i<imageSize.width-1; ++i) for(j=1; j<imageSize.height-1; ++j) {@@ -1693,10 +1715,10 @@ pattern += (blurGet2D(src,i-offsetXY,j-offsetXY) > center) *1; pattern += (blurGet2D(src,i,j-offsetX) > center) *2; pattern += (blurGet2D(src,i+offsetXY,j-offsetXY) > center) *4;- + pattern += (blurGet2D(src,i-offsetX,j) > center) *8; pattern += (blurGet2D(src,i+offsetX,j) > center) *16;- + pattern += (blurGet2D(src,i-offsetXY,j+offsetXY) > center) *32; pattern += (blurGet2D(src,i,j+offsetX) > center) *64; pattern += (blurGet2D(src,i+offsetXY,j+offsetXY) > center) *128;@@ -1711,7 +1733,7 @@ int i,j; int pattern = 0; double center = 0;- CvSize imageSize = cvGetSize(src); + CvSize imageSize = cvGetSize(src); for(i=0; i<imageSize.width-1; ++i) for(j=0; j<imageSize.height-1; ++j) {@@ -1735,7 +1757,7 @@ int i,j; int pattern = 0; double center = 0;- CvSize imageSize = cvGetSize(src); + CvSize imageSize = cvGetSize(src); for(i=0; i<imageSize.width-1; ++i) for(j=0; j<imageSize.height-1; ++j) {@@ -1757,13 +1779,13 @@ //@-node:aleator.20051207074905:LBP //@+node:aleator.20051109102750:Selective Average-// Assuming grayscale image calculate local selective average of point x y +// Assuming grayscale image calculate local selective average of point x y inline double calcSelectiveAvg(IplImage *img,double t ,int x, int y ,int wwidth, int wheight) { int i,j;-double accum=0; +double accum=0; double count=0; double centerValue; double processed=0; CvSize size = cvGetSize(img);@@ -1771,11 +1793,11 @@ for (i=-wwidth; i<wwidth;++i) for (j=-wheight; j<wheight;++j)- { + { if ( x+i<0 || x+i>=size.width || y+j<0 || y+j>=size.height) continue;- + processed = blurGet2D(img,x+i,y+j); if (fabs(processed-centerValue)<t) {accum+=processed;++count;}@@ -1800,7 +1822,7 @@ result = calcSelectiveAvg(src,t,i,j,wwidth,wheight); cvSetReal2D(target,j,i,result); }- + return target; } @@ -1814,9 +1836,9 @@ int i,j; img = cvCreateImage(cvSize(w,h), IPL_DEPTH_32F,1); for (i=0; i<h; i++) {- for (j=0; j<w; j++) { + 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]; + FGET(img,j,i) = d[j*h+i]; } } return img;@@ -1828,9 +1850,9 @@ int i,j; img = cvCreateImage(cvSize(w,h), IPL_DEPTH_32F,1); for (i=0; i<h; i++) {- for (j=0; j<w; j++) { + 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]; + FGET(img,j,i) = d[j*h+i]; } } return img;@@ -1847,8 +1869,8 @@ int i,j; img = cvCreateImage(cvSize(w,h), IPL_DEPTH_8U,1); for (i=0; i<h; i++) {- for (j=0; j<w; j++) { - UGETC(img,0,j,i) = *d; d++; + for (j=0; j<w; j++) {+ UGETC(img,0,j,i) = *d; d++; } } return img;@@ -1860,10 +1882,10 @@ 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++; + 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;@@ -1875,10 +1897,10 @@ 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,2,j,i) = *d; d++; - UGETC(img,1,j,i) = *d; d++; - UGETC(img,0,j,i) = *d; d++; + for (j=0; j<w; j++) {+ UGETC(img,2,j,i) = *d; d++;+ UGETC(img,1,j,i) = *d; d++;+ UGETC(img,0,j,i) = *d; d++; } } return img;@@ -1890,8 +1912,8 @@ int i,j; img = cvCreateImage(cvSize(w,h), IPL_DEPTH_32F,1); for (i=0; i<h; i++) {- for (j=0; j<w; j++) { - FGET(img,j,i) = (float)(creal(d[j*h+i])); + for (j=0; j<w; j++) {+ FGET(img,j,i) = (float)(creal(d[j*h+i])); } } return img;@@ -1902,8 +1924,8 @@ int i,j; CvSize s= cvGetSize(img); for (i=0; i<s.height; i++) {- for (j=0; j<s.width; j++) { - d[j*s.height+i] = (complex float)(FGET(img,j,i) + 0*I); + for (j=0; j<s.width; j++) {+ d[j*s.height+i] = (complex float)(FGET(img,j,i) + 0*I); } } }@@ -1913,8 +1935,8 @@ int i,j; CvSize s= cvGetSize(img); for (i=0; i<s.height; i++) {- for (j=0; j<s.width; j++) { - d[j*s.height+i] = FGET(img,j,i); + for (j=0; j<s.width; j++) {+ d[j*s.height+i] = FGET(img,j,i); } } }@@ -1923,8 +1945,8 @@ int i,j; CvSize s= cvGetSize(img); for (i=0; i<s.height; i++) {- for (j=0; j<s.width; j++) { - d[j*s.height+i] = FGET(img,j,i); + for (j=0; j<s.width; j++) {+ d[j*s.height+i] = FGET(img,j,i); } } }@@ -1938,45 +1960,45 @@ { cvReleaseMemStorage(&(f->storage)); free(f);- + } int reset_contour(FoundContours *f)-{ +{ f->contour = f->start; } int cur_contour_size(FoundContours *f)-{ +{ return f->contour->total; } double contour_area(FoundContours *f)-{ +{ return cvContourArea(f->contour,CV_WHOLE_SEQ,0); } CvMoments* contour_moments(FoundContours *f)-{ +{ CvMoments* moments = (CvMoments*) malloc(sizeof(CvMoments)); cvMoments(f->contour,moments,0); return moments; } double contour_perimeter(FoundContours *f)-{ +{ return cvContourPerimeter(f->contour); } int more_contours(FoundContours *f)-{ +{ if (f->contour != 0) {return 1;} {return 0;} // no more contours } int next_contour(FoundContours *f)-{ +{ if (f->contour != 0) {f->contour = f->contour->h_next; return 1;} {return 0;} // no more contours@@ -1985,25 +2007,25 @@ void contour_points(FoundContours *f, int *xs, int *ys) { if (f->contour==0) {printf("unavailable contour\n"); exit(1);}- + CvPoint *pt=0; int total,i=0; total = f->contour->total;- for (i=0; i<total;i++) + for (i=0; i<total;i++) { pt = (CvPoint*)cvGetSeqElem(f->contour,i); if (pt==0) {printf("point out of contour\n"); exit(1);} xs[i] = pt->x; ys[i] = pt->y;- } - + }+ } void print_contour(FoundContours *fc) { int i=0; CvPoint *pt=0;- for (i=0; i<fc->contour->total;++i) + for (i=0; i<fc->contour->total;++i) { pt = (CvPoint*)cvGetSeqElem(fc->contour,i); printf("PT=%d,%d\n",pt->x,pt->y);@@ -2026,21 +2048,21 @@ //size = cvGetSize(src1); //src = cvCreateImage(size,dstDepth,1); //cvCopy(src1,src,NULL);- - ++ CvPoint* pt=0; int i=0;- + CvMemStorage *storage=0; CvSeq *contour=0; FoundContours* result = (FoundContours*)malloc(sizeof(FoundContours)); storage = cvCreateMemStorage(0);- + cvFindContours( src,storage , &contour- , sizeof(CvContour) - ,CV_RETR_EXTERNAL - //,CV_RETR_CCOMP + , sizeof(CvContour)+ ,CV_RETR_EXTERNAL+ //,CV_RETR_CCOMP ,CV_CHAIN_APPROX_NONE ,cvPoint(0,0) ); @@ -2053,7 +2075,7 @@ cvReleaseImage(&src); return result;- + } //@-node:aleator.20071016114634:Contours //@+node:aleator.20070814123008:moments@@ -2080,7 +2102,7 @@ *hu = hu_moments->hu4; ++hu; *hu = hu_moments->hu5; ++hu; *hu = hu_moments->hu6; ++hu;- *hu = hu_moments->hu7; + *hu = hu_moments->hu7; return; } @@ -2139,7 +2161,7 @@ CvPoint2D32f center = cvPoint2D32f(w/2.0,h/2.0); CvMat *N = cv2DRotationMatrix(center,angle,scale,M); cvWarpAffine( src, dst, N, CV_INTER_LINEAR+CV_WARP_FILL_OUTLIERS- , cvScalarAll(0)); + , cvScalarAll(0)); return dst; cvReleaseMat(&M); }@@ -2169,7 +2191,7 @@ double u_opposite = 1 - u_ratio; double v_opposite = 1 - v_ratio; double result = ((x+1 >= s.width) || (y+1 >= s.height)) ? FGET(tex,x,y) :- (FGET(tex,x,y) * u_opposite + FGET(tex,x+1,y) * u_ratio) * v_opposite + + (FGET(tex,x,y) * u_opposite + FGET(tex,x+1,y) * u_ratio) * v_opposite + (FGET(tex,x,y+1) * u_opposite + FGET(tex,x+1,y+1) * u_ratio) * v_ratio; return result; }@@ -2192,25 +2214,25 @@ double a03 = -p[1][0] + p[1][1] - p[1][2] + p[1][3]; double a10 = -p[0][1] + p[2][1]; double a11 = p[0][0] - p[0][2] - p[2][0] + p[2][2];- double a12 = -2*p[0][0] + 2*p[0][1] - p[0][2] + p[0][3] + 2*p[2][0] - 2*p[2][1] + double a12 = -2*p[0][0] + 2*p[0][1] - p[0][2] + p[0][3] + 2*p[2][0] - 2*p[2][1] + p[2][2] - p[2][3]; double a13 = p[0][0] - p[0][1] + p[0][2] - p[0][3] - p[2][0] + p[2][1] - p[2][2] + p[2][3]; double a20 = 2*p[0][1] - 2*p[1][1] + p[2][1] - p[3][1];- double a21 = -2*p[0][0] + 2*p[0][2] + 2*p[1][0] - 2*p[1][2] - p[2][0] + p[2][2] + double a21 = -2*p[0][0] + 2*p[0][2] + 2*p[1][0] - 2*p[1][2] - p[2][0] + p[2][2] + p[3][0] - p[3][2];- double a22 = 4*p[0][0] - 4*p[0][1] + 2*p[0][2] - 2*p[0][3] - 4*p[1][0] + 4*p[1][1] - - 2*p[1][2] + 2*p[1][3] + 2*p[2][0] - 2*p[2][1] + p[2][2] - p[2][3] + double a22 = 4*p[0][0] - 4*p[0][1] + 2*p[0][2] - 2*p[0][3] - 4*p[1][0] + 4*p[1][1]+ - 2*p[1][2] + 2*p[1][3] + 2*p[2][0] - 2*p[2][1] + p[2][2] - p[2][3] - 2*p[3][0] + 2*p[3][1] - p[3][2] + p[3][3];- double a23 = -2*p[0][0] + 2*p[0][1] - 2*p[0][2] + 2*p[0][3] + 2*p[1][0] - 2*p[1][1] - + 2*p[1][2] - 2*p[1][3] - p[2][0] + p[2][1] - p[2][2] + p[2][3] + p[3][0] + double a23 = -2*p[0][0] + 2*p[0][1] - 2*p[0][2] + 2*p[0][3] + 2*p[1][0] - 2*p[1][1]+ + 2*p[1][2] - 2*p[1][3] - p[2][0] + p[2][1] - p[2][2] + p[2][3] + p[3][0] - p[3][1] + p[3][2] - p[3][3]; double a30 = -p[0][1] + p[1][1] - p[2][1] + p[3][1]; double a31 = p[0][0] - p[0][2] - p[1][0] + p[1][2] + p[2][0] - p[2][2] - p[3][0] + p[3][2];- double a32 = -2*p[0][0] + 2*p[0][1] - p[0][2] + p[0][3] + 2*p[1][0] - 2*p[1][1] - + p[1][2] - p[1][3] - 2*p[2][0] + 2*p[2][1] - p[2][2] + p[2][3] + 2*p[3][0] + double a32 = -2*p[0][0] + 2*p[0][1] - p[0][2] + p[0][3] + 2*p[1][0] - 2*p[1][1]+ + p[1][2] - p[1][3] - 2*p[2][0] + 2*p[2][1] - p[2][2] + p[2][3] + 2*p[3][0] - 2*p[3][1] + p[3][2] - p[3][3];- double a33 = p[0][0] - p[0][1] + p[0][2] - p[0][3] - p[1][0] + p[1][1] - p[1][2] - + p[1][3] + p[2][0] - p[2][1] + p[2][2] - p[2][3] - p[3][0] + p[3][1] + double a33 = p[0][0] - p[0][1] + p[0][2] - p[0][3] - p[1][0] + p[1][1] - p[1][2]+ + p[1][3] + p[2][0] - p[2][1] + p[2][2] - p[2][3] - p[3][0] + p[3][1] - p[3][2] + p[3][3]; double x2 = u_ratio * u_ratio;@@ -2240,8 +2262,8 @@ ny = ny*(1+k*r2); x = (nx+0.5)*s.width; y = (ny+0.5)*s.height;- if (x<0 || x>=s.width || y<0 || y>=s.height) - { FGET(dest,j,i) = 0; + if (x<0 || x>=s.width || y<0 || y>=s.height)+ { FGET(dest,j,i) = 0; continue;} FGET(dest,j,i) = bilinearInterp(source,x,y); }@@ -2305,7 +2327,7 @@ CvVideoWriter* wrapCreateVideoWriter(char *fn, int fourcc, double fps,int w, int h,- int color) + int color) { CvVideoWriter *res = cvCreateVideoWriter(fn,CV_FOURCC('M','P','G','4'),fps,cvSize(w,h), color); return res;@@ -2335,6 +2357,29 @@ CvSize zero = {winW,winH}; cvFindCornerSubPix(image, corners, count, searchWindow, zero, t); };++void wrapFitEllipse(CvArr* pts, CvBox2D *out) {+CvBox2D box = cvFitEllipse2(pts);+out->center = box.center;+out->size = box.size;+out->angle = box.angle;+}++int wrapCamShift(const CvArr* prob_image, CvRect *window, CvTermCriteria *criteria, CvConnectedComp* comp, CvBox2D* box)+{ return cvCamShift(prob_image, *window, *criteria, comp, box); }++++void extractCVSeq(const CvSeq* seq,void *dest){+CvSeqReader reader;+cvStartReadSeq( seq, &reader, 0 );+void *index=dest;+for( int i = 0; i < seq->total; i++ )+{+ memcpy(index,(void*)reader.ptr,seq->elem_size);+ index += seq->elem_size;+ CV_NEXT_SEQ_ELEM( seq->elem_size, reader );+}} //
cbits/cvWrapLEO.h view
@@ -8,6 +8,7 @@ #define M_PI 3.14159265358979323846 #endif +#include <stdio.h> #include <opencv/cv.h> #include <opencv/cxcore.h> #include <opencv/highgui.h>@@ -18,11 +19,13 @@ IplImage* wrapCreateImage8U(const int width, const int height, const int channels); +IplImage *wrapCopyMakeBorder(IplImage* src, const int top, const int bottom, const int left, const int right, const int borderType, const float value);+ void wrapSubRS(const CvArr *src, double s,CvArr *dst); void wrapSubS(const CvArr *src, double s,CvArr *dst); void wrapAddS(const CvArr *src, double s, CvArr *dst); -double wrapAvg(const CvArr *src);+double wrapAvg(const CvArr *src, const CvArr *mask); double wrapStdDev(const CvArr *src); double wrapStdDevMask(const CvArr *src,const CvArr *mask); double wrapSum(const CvArr *src);@@ -118,7 +121,7 @@ IplImage* selectiveAvgFilter(IplImage *src,double t ,int wwidth, int wheight); -IplImage* wrapFilter2D(IplImage *src, int ax,int ay, +IplImage* wrapFilter2D(IplImage *src, int ax,int ay, int w, int h, double *kernel); IplImage* wrapFilter2DImg(IplImage *src ,IplImage *mask@@ -138,8 +141,8 @@ void localHorizontalBinaryPattern(IplImage *src, int *LBP); void localVerticalBinaryPattern(IplImage *src, int *LBP); -void get_weighted_histogram(IplImage *src, IplImage *weights, - double start, double end, +void get_weighted_histogram(IplImage *src, IplImage *weights,+ double start, double end, int bins, double *histo); @@ -163,7 +166,7 @@ double average_of_line(int x0, int y0 ,int x1, int y1 ,IplImage *src);- + IplImage* adaUpdateDistrImage(IplImage *target ,IplImage *weigths ,IplImage *test@@ -172,7 +175,7 @@ double adaFitness1(IplImage *target ,IplImage *weigths ,IplImage *test);- + CvMoments* getMoments(IplImage *src, int isBinary); void freeCvMoments(CvMoments *x);@@ -181,14 +184,14 @@ void freeCvHuMoments(CvHuMoments *x); -void haarFilter(IplImage *intImg, +void haarFilter(IplImage *intImg, int a, int b, int c, int d, IplImage *target); -double haar_at(IplImage *intImg, +double haar_at(IplImage *intImg, int x1, int y1, int w, int h); -void wrapDrawRectangle(CvArr *img, int x1, int y1, +void wrapDrawRectangle(CvArr *img, int x1, int y1, int x2, int y2, float r, float g, float b, int thickness); @@ -201,7 +204,7 @@ CvMemStorage *storage; CvSeq *contour; CvSeq *start;- + } FoundContours; CvMoments* contour_moments(FoundContours *f);@@ -237,16 +240,12 @@ void wrapDrawText(CvArr *img, char *text, float s, int x, int y,float r,float g,float b); IplImage* vignettingModelB3(int w, int h,double b1, double b2, double b3);-inline CvPoint2D64f toNormalizedCoords(CvSize area, CvPoint from);-inline CvPoint fromNormalizedCoords(CvSize area, CvPoint2D64f from);-inline double eucNorm(CvPoint2D64f p); IplImage* vignettingModelP(int w, int h,double scalex, double scaley, double max); IplImage* wrapPerspective(IplImage* src, double a1, double a2, double a3 , double a4, double a5, double a6 , double a7, double a8, double a9); IplImage* simplePerspective(double k,IplImage *src); double bilinearInterp(IplImage *tex, double u, double v);-inline CvPoint2D64f fromNormalizedCoords64f(CvSize area, CvPoint2D64f from); void findHomography(double* srcPts, double *dstPts, int noPts, double *homography); void masked_merge(IplImage *src1, IplImage *mask, IplImage *src2, IplImage *dst); IplImage* makeEvenUp(IplImage *src);@@ -270,7 +269,7 @@ void subpixel_blit(IplImage *a, IplImage *b, double offset_y, double offset_x); double bicubicInterp(IplImage *tex, double u, double v); -CvVideoWriter* wrapCreateVideoWriter(char *fn, int fourcc, double fps,int w, int h, int color); +CvVideoWriter* wrapCreateVideoWriter(char *fn, int fourcc, double fps,int w, int h, int color); double wrapGet32F2DC(CvArr *arr, int x, int y,int c); void maximal_covering_circle(int ox,int oy, double or, IplImage *distmap@@ -281,6 +280,42 @@ int wrapDrawChessBoardCorners(void* image, int pw, int ph, CvPoint2D32f* corners, int cornerCount, int wasFound); double wrapCalibrateCamera2(const CvMat* objectPoints, const CvMat* imagePoints, const CvMat* pointCounts, CvSize *imageSize, CvMat* cameraMatrix, CvMat* distCoeffs, CvMat* rvecs, CvMat* tvecs, int flags);++void wrapFitEllipse(CvArr* pts, CvBox2D *out);+int wrapCamShift(const CvArr* prob_image, CvRect *window, CvTermCriteria *criteria, CvConnectedComp* comp, CvBox2D* box);++void wrapExtractSURF(const CvArr* image, const CvArr* mask, CvSeq** keypoints, CvSeq** descriptors, CvMemStorage* storage, CvSURFParams *param, int useProvidedKeyPts){+return cvExtractSURF(image, mask, keypoints, descriptors, storage, *param, useProvidedKeyPts);+};++void wrapExtractMSER( CvArr* _img, CvArr* _mask, CvSeq** contours, CvMemStorage* storage, CvMSERParams *params ){+cvExtractMSER( _img, _mask, contours, storage, *params );+};++void wrapEllipseBox(CvArr* img, CvBox2D *box, CvScalar *color+ ,int thickness, int lineType, int shift)+{+cvEllipseBox(img, *box, *color, thickness, lineType, shift);+};+++void extractCVSeq(const CvSeq* seq,void *dest);++void printSeq(const CvSeq *seq) {+printf("Seq:\n flags %d\nheader_size %d\n total %d\n ptr %p",+ seq->flags, seq->header_size, seq->total, (void*)seq->ptr);+}++int wrapMeanShift(const CvArr* prob_image, CvRect *window, CvTermCriteria *criteria, CvConnectedComp* comp)+{+return cvMeanShift(prob_image, *window, *criteria, comp);+};++void wrapMinAreaRect2(const CvArr* points, CvMemStorage* storage, CvBox2D *r)+{ *r = cvMinAreaRect2(points, storage); }++void wrapBoundingRect(CvArr* points, int update, CvRect *r)+{ *r = cvBoundingRect(points, update); } #endif //@-node:aleator.20050908101148.2:@thin cvWrapLEO.h
+ cbits/wrapImgProc.c view
@@ -0,0 +1,6 @@+#include "wrapImgProc.h"+#include <opencv2/imgproc/imgproc_c.h>++void wrapFilter2(const CvArr* src, CvArr* dst, const CvMat* kernel, CvPoint *anchor)+{cvFilter2D(src, dst, kernel, *anchor);};+
+ cbits/wrapImgProc.h view
@@ -0,0 +1,8 @@+#ifndef __CVWRAPIMGPROC__+#define __CVWRAPIMGPROC__++#include <opencv2/imgproc/imgproc_c.h>++void wrapFilter2(const CvArr* src, CvArr* dst, const CvMat* kernel, CvPoint *anchor);++#endif
+ examples/ConnectedComponents.hs view
@@ -0,0 +1,21 @@+module Main where+import CV.Fitting+import CV.Image+import CV.Drawing+import CV.Matrix+import CV.ImageOp++main = do+ let res :: Image GrayScale D32+ res = empty (400,400)+ testPts = [(200+100*sin x-80*cos x,200+60*cos x) | x <- [0,0.1..pi]]+ mat = fromList (1,length testPts) testPts+ ell = fitEllipse mat+ bb = minAreaRect mat+ br = boundingRect mat+ pts = res <## [circleOp 1 (round x, round y) 3 Filled | (x,y) <- testPts]+ <# drawBox2Dop 1 bb+ saveImage "bb_result.png" pts+ print ell+ print bb+ print br
+ examples/Fitting.hs view
@@ -0,0 +1,54 @@+module Main where+import CV.Fitting+import CV.Image+import CV.ConnectedComponents+import CV.Drawing+import CV.Matrix+import CV.ImageOp+import CV.Bindings.Types+import System.Environment++main' = do+ let res :: Image RGB D32+ res = empty (400,400)+ testPts = [(200+100*sin x-80*cos x,200+60*cos x) | x <- [0,0.1..pi]] +++ [(150+100*sin (-x)+20*cos x,100+60*cos (-x)) | x <- [0,0.1..2*pi]]+ mat = fromList (1,length testPts) testPts+ ell = fitEllipse mat+ bb = minAreaRect mat+ br = boundingRect mat+ ch = map (both round) . toList $ convexHull mat + segments = zip (ch) (tail . cycle $ ch)+ pts = res <## [circleOp (0.5,0.5,0.5) (round x, round y) 3 Filled | (x,y) <- testPts]+ <# drawLinesOp (1,0,0) 1 segments+ <# drawBox2Dop (0,1,0) bb+ saveImage "bb_result.png" pts+ print ell+ print bb+ print br++main = do+ Just x <- getArgs >>= loadImage . head+ let + cs = head . mapContours contourPoints . getContours . unsafeImageTo8Bit $ x + mat :: Matrix (Float,Float)+ mat = fromList (1,length cs) (map (both realToFrac) cs)+ matI :: Matrix (Int,Int)+ matI = fromList (1,length cs) (map (both round) cs)+ ell = fitEllipse mat+ bb = minAreaRect mat+ br = boundingRect mat+ ch = map (both round) . toList $ convexHull mat + cdefs = convexityDefects matI+ segments = zip (ch) (tail . cycle $ ch)+ pts = grayToRGB x + <## [circleOp (0.5,0.5,0.5) (round x, round y) 3 Filled | (x,y) <- toList mat]+ <## [circleOp (1,0,0.8) (fromIntegral x, fromIntegral y) 13 Filled + | (_,_,C'CvPoint x y,_) <- cdefs]+ <# drawLinesOp (1,0,0) 3 segments+ <# drawBox2Dop (0,1,0) bb+ mapM_ print cdefs+ saveImage "bb_result.png" pts+++both f (a,b) = (f a, f b)
examples/Fuse.hs view
@@ -1,8 +1,9 @@-{-#LANGUAGE ScopedTypeVariables #-}+{-#LANGUAGE ScopedTypeVariables, ParallelListComp #-} module Main where import CV.Drawing import CV.Filters+import CV.Edges import CV.Image import CV.ColourUtils import CV.ImageMathOp@@ -15,25 +16,44 @@ 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)+merge a b = (IM.invert mask #* b) #+ (mask #* a) where- mask = unsafeImageTo32F $ (IM.abs a::Image GrayScale D32) #> (IM.abs b::Image GrayScale D32)+ 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) +veskuFusion a b = (IM.invert mask #* b) #+ (mask #* a)+ where+ mask = unsafeImageTo32F $ (IM.abs (sobel (1,1) s5 a::Image GrayScale D32)) #> (IM.abs (sobel (1,1) s5 b::Image GrayScale D32))+ sFuser i1 fn = do Just i2 <- loadImage fn >>= return . fmap (T.enlarge 5)- let r = laplacianFusion i1 i2+ let r = veskuFusion i1 i2 r `seq` return r +laplacianImages img = [x T.pyrUp i $ l | l <- reverse (T.laplacianPyramid 5 img) | i <- [0..] ]+x a b = foldr (.) id (replicate b a) +demonstrate imgs = let+ gs = [(no,oct,r) | (i,no) <- zip imgs [1..]+ , (r,oct) <- zip (laplacianImages i) [1..] + ]+ sums = [(oct, IM.averageImages [r | (_,n,r) <- gs , n==oct ]) | oct <- [1..5]]+ in (gs,sums)+ main = do (fn1:fns) <- getArgs Just i1 <- loadImage fn1 >>= return . fmap (T.enlarge 5)+ is <- catMaybes <$> mapM (loadImage >=> return . fmap (T.enlarge 5)) (fn1:fns) r <- foldM sFuser i1 fns saveImage "fusing_result.png" $ stretchHistogram r+ let (ls,ss) = (demonstrate is)+ sequence [saveImage ("avg"++show oct++".png") $ balance (0.3, 0.3) r+ | ((oct,r)) <- ss | i <- [1..]]+ sequence [saveImage ("laplacian"++show no++"_"++show oct++".png") $ balance (0.3, 0.3) r+ | ((no,oct,r)) <- ls | i <- [1..]]
+ examples/Histograms.hs view
@@ -0,0 +1,15 @@+module Main where+import CV.Image+import CV.Histogram as H+import CV.ColourUtils++main = do+ Just full <- loadColorImage "building.jpg"+ Just sample <- loadColorImage "building_sample2.jpg"+ let hist = H.Histogram [(unsafeImageTo8Bit $ getChannel Red sample,64)+ ,(unsafeImageTo8Bit $ getChannel Green sample,64)+ ,(unsafeImageTo8Bit $ getChannel Blue sample,64)] False Nothing + res = backProjectHistogram [unsafeImageTo8Bit $ getChannel Red full+ ,unsafeImageTo8Bit $ getChannel Green full+ ,unsafeImageTo8Bit $ getChannel Blue full] hist + saveImage "backproject_result.png" $ stretchHistogram $ unsafeImageTo32F res
+ examples/Hough.hs view
@@ -0,0 +1,26 @@+{-#LANGUAGE ParallelListComp,ScopedTypeVariables#-}+module Main where+import CV.Image+import CV.ImageOp+import CV.Drawing+import CV.ColourUtils+import CV.HoughTransform+import CV.Matrix++main = do+ Just x <- loadImage "houghtest2.png"+ let hough = houghLinesStandard (unsafeImageTo8Bit x) 100 1 (pi/180) 100+ hough2 = houghLinesProbabilistic (unsafeImageTo8Bit x) 100 1 (pi/180) 100 10 40+ hough3 = houghLinesMultiscale (unsafeImageTo8Bit x) 100 5 (pi/90) 100 4 4++ (w,h) = getSize x+ test = x <## [lineOp 1 2 (0,round y) (w,round $ y + (fromIntegral w)*negate (tan (pi/2-k))) | (y,k) <- toList hough]+ test2 = x <## [lineOp 1 2 ( x, y) ( u, v) | (x,y,u,v) <- toList hough2]+ test3 = x <## [lineOp 1 2 (0,round y) (w,round $ y + (fromIntegral w)*negate (tan (pi/2-k))) | (y,k) <- toList hough3]+ print hough+ print hough2+ print hough3+ saveImage "Hough_result.png" test+ saveImage "Hough_result2.png" test+ saveImage "Hough_result3.png" test3+
− examples/MR-Edge.hs
@@ -1,31 +0,0 @@-{-#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/MeanShift.hs view
@@ -0,0 +1,31 @@+{-#LANGUAGE ParallelListComp#-}+module Main where++import CV.Image+import CV.Tracking+import CV.Bindings.Types+import CV.Drawing+import CV.ImageOp+import CV.Transforms+import Utils.Rectangle+import Text.Printf++main' = do+ Just x <- loadImage "meanshiftsample.png"+ let start x = Rectangle x 200 60 60+ let res = x <## [rectOp 1 1 y | p <- [0,30..640]+ , let (val,y) = meanShift x (start p) (EPS 1) ]+ saveImage "meanshift_result.png" res++mstrack ip (imgs) = foldl (\(bb:bbs) i -> snd (meanShift i bb (EPS 1)):bb:bbs) ([ip]) imgs++main = do+ Just x <- loadImage "meanshiftsample2.png"+ let start = Rectangle 30 30 50 50+ rotations x= [rotate p x | p <- [0,0.1..2*pi-0.1]]+ res = [img <## [rectOp 1 1 box1, rectOp 0.5 2 box2]+ | box1 <- reverse (mstrack (Rectangle 30 30 50 50) (rotations x))+ | box2 <- reverse (mstrack (Rectangle 230 120 50 50) (rotations x))+ | img <- rotations x]+ sequence_ [saveImage (printf "meanshift_result_%.2d_.png" i) r+ | (r,i) <- zip res [1::Int ..]]
examples/Monster.hs view
@@ -1,4 +1,4 @@-{-#LANGUAGE ViewPatterns#-}+{-#LANGUAGE ViewPatterns, ParallelListComp#-} module Main where import CV.Image@@ -13,6 +13,8 @@ import CV.FunnyStatistics import CV.ConnectedComponents import CV.Transforms+import CV.Matrix+import CV.Fitting import System.Environment import CV.Pixelwise import Graphics.Gnuplot.Simple@@ -23,11 +25,19 @@ hdef d _ = d horMax :: Image GrayScale D32 -> [Double]-horMax (fromImage -> pixels) = [fromIntegral $ snd $ maximumBy (comparing value) [(i,j) | j<-[0..height-1]] | i <- [0..width-1] ]+horMax (pixels) = [fromIntegral $ snd $ maximumBy (comparing value) [(i,j) | j<-[0..height-1]] | i <- [0..width-1] ] where- value (x,y) = getPixel (x,y) pixels + value (x,y) = getPixel (x,y) pixels (width,height) = getSize pixels +getMarks :: Image GrayScale D32 -> [(Float,Float)]+getMarks pixels = [(realToFrac i,realToFrac j) | j <- [0..height-1]+ , i <- [0..width-1]+ , value (i,j) > 0.5]+ where+ value (x,y) = getPixel (x,y) pixels+ value (x,y) = getPixel (x,y) pixels+ ntimes n op = (!! n) . iterate op smooth [x] = [x]@@ -35,39 +45,41 @@ smooth (x:y:xs) = (x+y) / 2:smooth (y:xs) conv mask = map (prod mask) . tails- where + where prod xs ys = sum (zipWith (*) xs ys) --- TODO: Something is not type safe in this chain:+to32F = unsafeImageTo32F+ main = do Just x <- getArgs >>= loadImage . hdef (error "No file given!") >>= return . fmap (enlarge n )- let - operR = unsafeImageTo32F . nibbly 1 0.01 . IM.abs . sobel (1,0) s3 -- nibbly 0.3 0.01- operL = unsafeImageTo32F . nibbly 1 0.01 . IM.abs . sobel (0,1) s3 -- nibbly 0.3 0.01- down oper = take n $ map oper $ iterate pyrDown x- up oper = foldl1 (\a b -> (pyrUp a) `IM.min` b) $ reverse (down oper)+ let+ oper msk = to32F . nibbly 1 0.01 . IM.abs . sobel msk s3+ up op = foldl1 (\a b -> (pyrUp a) `IM.min` b)+ . reverse+ . take n+ . map op+ . iterate pyrDown+ se = structuringElement (9,9) (4,4) EllipseShape- thd = dilate se 2 . unsafeImageTo32F . nibbly 0.9 0.001 $ IM.invert x - pyrd = stretchHistogram $ (up operL) #+ (up operR)-- $ sobel (1,0) s3 x -- $ (up operR)- clean :: Image GrayScale D8- clean = selectSizedComponents (10000) (10000000) $ IM.moreThan 0.2 $ thd #* (close se pyrd)- final = unsafeImageTo32F clean -- #* (IM.abs (sobel (1,0) s1 x) #+ IM.abs (sobel (0,1) s1 x))- rotated :: Image GrayScale D8- rotated = rotate (pi/4.5) final--- hm = (horMax rotated)--- shm = ntimes 100 smooth hm+ pyrd x = (up (oper (1,0)) x) #+ (up (oper (0,1)) x)++ thd = dilate se 2 . unsafeImageTo32F . nibbly 0.9 0.001 . IM.invert + clean = selectSizedComponents (1e4) (1e10) . IM.moreThan 0.2 $ thd x #* (close se (pyrd x))++ final = to32F clean #* (IM.abs (sobel (1,0) s1 x) #+ IM.abs (sobel (0,1) s1 x))+ hm = getMarks $ to32F clean+ ell = fitEllipse $ fromList (1,length hm) $ hm+ rotated = rotate (realToFrac $ pi/2+2*pi*(angle ell/360)) final saveImage "Combine.png" rotated--- print (length hm,getSize rotated, getSize (fromImage rotated)) --- plotLists [YRange (-15,15)] [map (*100) $ nonMaxSupress 30 $ conv [-1,2,-1] $ shm, map (\x -> (x-400)/20) shm] where n = 5 nonMaxSupress w = reverse . nonMaxSupress' w . reverse . nonMaxSupress' w-nonMaxSupress' w = map supress . map (take w) . tails - where - supress [] = 0 +nonMaxSupress' w = map supress . map (take w) . tails+ where+ supress [] = 0 supress [x] = x supress (x:xs) | all (<x) xs = x- | otherwise = 0 + | otherwise = 0 threshold t x | x <t = 0 | otherwise = 10
− examples/StupidConv.hs
@@ -1,35 +0,0 @@-{-#LANGUAGE BangPatterns#-}-import CV.Image-import CV.ColourUtils-import Control.Monad-import qualified CV.ImageMath as IM--{-#INLINE (×)#-}-a × b = [(a',b') | a' <- a , b' <- b]--stupidConv im m = do- res <- create (w-mw,h-mh)- forM_ ([0..w-1-mw] × [0..h-1-mh]) $ \(x,y) -> - setPixel (x,y) (sum [getPixel (x+i,y+j) im * getPixel (i,j) m - | (i,j) <- [0..mw-1] × [0..mh-1]]) res- return res- where - maskSize = IM.sum m- (!mw,!mh) = getSize m- (!w,!h) = getSize im--main = do- Just x <- loadImage "smallLena.jpg"- m <- fromList (3,3) [-1,0,1- ,-1,0,1- ,-1,0,1] - print (IM.sum x)- r <- stupidConv x m- print (IM.sum r)- saveImage "stupid.png" $ stretchHistogram r---fromList (w,h) xs = do- i <- create (w,h)- forM_ (zip ([0..w-1] × [0..h-1]) xs) $ \(p,v) -> setPixel p v i - return i
− examples/montageDebug.hs
@@ -1,16 +0,0 @@-module Main where-import CV.Image-import CV.Sampling---- | Output:--- splitLena.jpg - Lena image split to tiles with few pixels of black between tiles--- splitLena2.jpg - Lena image split to tiles and joined safely back to original-main = do- Just x <- loadImage "smallLena.jpg"- let pieces = getTiles (60,30) x- piecesWithCoordinates = getTilesC (30,60) x- joined = montage (6,3) 5 pieces- blitted = blitM (205,205) piecesWithCoordinates- saveImage "splitLena.jpg" joined - saveImage "splitLena2.jpg" blitted-
+ examples/mser.hs view
@@ -0,0 +1,23 @@+module Main where+import CV.Image+import CV.Features+import CV.Drawing+import CV.ImageOp+import CV.Bindings.Types+import CV.Transforms+import Utils.GeometryClass+import Utils.Point+import System.Environment ++main = do+ Just x <- getArgs >>= loadImage . head + let y = rotate (pi/4) x+ lst = getMSER (unsafeImageTo8Bit x) Nothing defaultMSERParams+ lsty = getMSER (unsafeImageTo8Bit y) Nothing defaultMSERParams+ result lst x = x <## [drawLinesOp 1 1 $ polyline ctr+ | ctr <- lst]+ print lst+ saveImage "mser.png" $ montage (2,1) 2 [result (take 100 lst) x ,result (take 100 lsty) y]++polyline pts = pts `zip` tail pts+
examples/pixelwise.hs view
@@ -10,24 +10,19 @@ main = do Just x <- loadImage "smallLena.jpg"- let y = T.flip T.Horizontal x- u = T.flip T.Vertical y- z = T.flip T.Vertical x+ let y = fromImage $ T.flip T.Horizontal x+ u = fromImage $ T.flip T.Vertical y+ z = fromImage $ T.flip T.Vertical x saveImage "PixelWise.png" $ montage (3,3) 5 - [x- ,y- ,{-#SCC "+" #-} stretchHistogram . toImage $ ((+) <$$> x <+> y)- - ,{-#SCC "++++" #-} stretchHistogram . toImage $ ((\a b c d -> a+b+c+d) <$$> x - <+> y- <+> u- <+> z)- ,{-#SCC "sin" #-}stretchHistogram . toImage $ fmap (sin . (*9)) . fromImage $ x - ,stretchHistogram . toImage $ fmap log . fromImage $ x + [x,y+ ,stretchHistogram . toImage $ (z + y)+ ,stretchHistogram . toImage $ y + u + z+ ,stretchHistogram . toImage $ fmap (sin . (*9)) $ y + ,stretchHistogram . toImage $ fmap log $ x ,stretchHistogram . gaussian (3,3) . toImage $ atan2 <$$> (sobel (1,0) s5 x) <+> (sobel (0,1) s5 x) - ,toImage $ fmap (\x -> if x > 0.5 then 0 else 1) . fromImage $ x- ,toImage $ fmap (\x -> if x > 0.5 && x < 0.6 then 0 else 1) . fromImage $ x+ ,toImage $ fmap (\x -> if x > 0.5 then 0 else 1) $ x+ ,toImage $ fmap (\x -> if x > 0.5 && x < 0.6 then 0 else 1) $ x ]
+ examples/surf.hs view
@@ -0,0 +1,46 @@+{-#LANGUAGE FlexibleContexts#-}+module Main where+import CV.Image+import CV.Features+import CV.Drawing+import Utils.DrawingClass+import CV.DrawableInstances+import CV.ImageOp+import CV.Bindings.Types+import CV.Transforms+import Utils.GeometryClass+import System.Environment+import System.IO.Unsafe++main = do+ Just x <- getArgs >>= loadImage . head+ let y = scale Area (2.2,2) . rotate (pi/2) $ x+ lst = getSURF defaultSURFParams (unsafeImageTo8Bit x) Nothing+ lsty = getSURF defaultSURFParams (unsafeImageTo8Bit y) Nothing+ let result lst x = (x <## map (draw.fst) lst) :: Image GrayScale D32+ -- [ellipseBoxOp 1 (C'CvBox2D c size d) 1 0+ -- | (C'CvSURFPoint c l s d h,_) <- lst+ -- , let size = C'CvSize2D32f (fromIntegral s) (fromIntegral $ s`div`2)+ -- ]+ saveImage "surf_result.png" $ montage (2,1) 2 [padToSize (getSize y) (result lst x) ,result lsty y]+ mapM_ print (take 5 lst)++padToSize :: (CreateImage (Image c d)) => (Int,Int) -> Image c d -> Image c d+padToSize size img = unsafePerformIO $ do+ let r = empty size+ blit r img (0,0)+ return r++-- main = do+-- let seq = C'CvSeq 1 10+-- nullPtr nullPtr nullPtr nullPtr+-- 111+-- 12+-- nullPtr+-- nullPtr+-- 222+-- nullPtr+-- nullPtr+--+-- with seq c'printSeq+-- with seq $ \sp -> peek sp >>= print