diff --git a/C2HS.hs b/C2HS.hs
deleted file mode 100644
--- a/C2HS.hs
+++ /dev/null
@@ -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
diff --git a/C2HSTools.hs b/C2HSTools.hs
deleted file mode 100644
--- a/C2HSTools.hs
+++ /dev/null
@@ -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
diff --git a/CV.cabal b/CV.cabal
--- a/CV.cabal
+++ b/CV.cabal
@@ -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
-
+ (The scarce) Documentation is available at
+
.
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
-
+
diff --git a/CV/Bindings/Calibrate.hsc b/CV/Bindings/Calibrate.hsc
--- a/CV/Bindings/Calibrate.hsc
+++ b/CV/Bindings/Calibrate.hsc
@@ -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 -> Ptr -> Ptr -> Ptr -> Ptr -> Ptr -> Ptr -> Ptr -> CInt -> IO Double
#ccall wrapFindCornerSubPix , Ptr BareImage -> Ptr -> 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
diff --git a/CV/Bindings/Core.hsc b/CV/Bindings/Core.hsc
new file mode 100644
--- /dev/null
+++ b/CV/Bindings/Core.hsc
@@ -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
+#include "cvWrapCore.h"
+#include
+
+-- 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 -> Ptr -> Ptr -> IO ()
+#ccall wrapSetAll , Ptr -> CDouble -> Ptr -> IO ()
+#ccall wrapSet1 , Ptr -> CDouble -> Ptr -> IO ()
+#ccall wrapSet2 , Ptr -> CDouble -> CDouble -> Ptr -> IO ()
+#ccall wrapSet3 , Ptr -> CDouble -> CDouble -> CDouble -> Ptr -> IO ()
+#ccall wrapSet4 , Ptr -> CDouble -> CDouble -> CDouble -> CDouble -> Ptr -> IO ()
+
+-- CVAPI(void) cvSetZero(
+-- CvArr* arr
+-- );
+
+-- Clears all the array elements (sets them to 0)
+
+#ccall cvSetZero , Ptr -> 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 -> Ptr -> Ptr -> Ptr -> Ptr -> 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 -> Ptr -> Ptr -> Ptr -> Ptr -> 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 -> Ptr -> Ptr -> Ptr -> 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 -> Ptr -> Ptr -> Ptr -> 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 -> Ptr CDouble -> Ptr CDouble -> Ptr -> Ptr -> Ptr -> 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 -> Ptr -> Ptr -> 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 -> Ptr -> CDouble -> CDouble -> CInt -> Ptr -> 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 -> Ptr -> CInt -> CInt -> IO ()
+
+-- #ccall cvWrapDFT , Ptr -> Ptr -> IO ()
+
+-- #ccall cvWrapIDFT , Ptr -> Ptr -> IO ()
+
+-- CVAPI(void) cvMulSpectrums(
+-- const CvArr* src1,
+-- const CvArr* src2,
+-- CvArr* dst,
+-- int flags
+-- );
+
+#ccall swapQuadrants, Ptr -> IO ()
+
+-- Multiply results of DFTs: DFT(X)*DFT(Y) or DFT(X)*conj(DFT(Y))
+
+#ccall cvMulSpectrums , Ptr -> Ptr -> Ptr -> 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 -> Ptr -> CInt -> IO ()
diff --git a/CV/Bindings/Drawing.hsc b/CV/Bindings/Drawing.hsc
new file mode 100644
--- /dev/null
+++ b/CV/Bindings/Drawing.hsc
@@ -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
+#include "cvWrapLEO.h"
+
+#ccall wrapEllipseBox, Ptr -> Ptr -> Ptr -> CInt -> CInt -> CInt -> IO ()
diff --git a/CV/Bindings/Features.hsc b/CV/Bindings/Features.hsc
new file mode 100644
--- /dev/null
+++ b/CV/Bindings/Features.hsc
@@ -0,0 +1,38 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+module CV.Bindings.Features where
+
+import Foreign.C.Types
+import CV.Bindings.Types
+
+#strict_import
+
+#include
+#include
+
+#starttype CvSURFParams
+#field extended, CInt
+#field hessianThreshold, CDouble
+#field nOctaves, CInt
+#field nOctaveLayers, CInt
+#stoptype
+
+#ccall wrapExtractSURF, Ptr -> Ptr -> Ptr (Ptr ) -> Ptr (Ptr ) -> Ptr -> Ptr -> 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 -> Ptr -> Ptr (Ptr ) -> Ptr -> Ptr -> IO ()
+
+#ccall cvMoments , Ptr -> Ptr -> Int -> IO ()
+#ccall cvGetSpatialMoment, Ptr -> CInt -> CInt -> IO CDouble
+#ccall cvGetNormalizedCentralMoment, Ptr -> CInt -> CInt -> IO CDouble
+#ccall cvGetCentralMoment, Ptr -> CInt -> CInt -> IO CDouble
diff --git a/CV/Bindings/Fittings.hsc b/CV/Bindings/Fittings.hsc
new file mode 100644
--- /dev/null
+++ b/CV/Bindings/Fittings.hsc
@@ -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
+#include "cvWrapLEO.h"
+
+#ccall wrapFitEllipse , Ptr -> Ptr -> IO ()
+#ccall cvFitLine , Ptr -> CInt -> Double -> Double -> Double-> Ptr Float -> IO ()
+#ccall cvConvexHull2 , Ptr -> Ptr () -> CInt -> CInt -> IO (Ptr )
+#ccall cvConvexityDefects, Ptr -> Ptr -> Ptr ->IO (Ptr )
+#ccall wrapMinAreaRect2 , Ptr -> Ptr -> Ptr -> IO ()
+#ccall wrapBoundingRect , Ptr -> CInt -> Ptr -> IO ()
+#ccall cvMinEnclosingCircle, Ptr -> Ptr -> 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
+
diff --git a/CV/Bindings/ImgProc.hsc b/CV/Bindings/ImgProc.hsc
new file mode 100644
--- /dev/null
+++ b/CV/Bindings/ImgProc.hsc
@@ -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
+#include
+#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 -> 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 -> Ptr -> 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 -> Ptr () -> Int -> Double -> Double -> Int -> Double -> Double -> IO ()
+
+#ccall wrapFilter2, Ptr -> Ptr -> Ptr -> Ptr -> IO ()
+
+#ccall cvCalcArrBackProject, Ptr (Ptr ) -> Ptr -> Ptr -> IO ()
+
+#num CV_HIST_ARRAY
+
+#ccall cvCreateHist, Int -> Ptr Int -> Int -> Ptr (Ptr Float) -> Int -> IO (Ptr )
+#ccall cvReleaseHist, Ptr (Ptr ) -> IO ()
+#ccall cvCalcArrHist, Ptr (Ptr ) -> Ptr -> Int -> Ptr -> 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
diff --git a/CV/Bindings/Iterators.hsc b/CV/Bindings/Iterators.hsc
new file mode 100644
--- /dev/null
+++ b/CV/Bindings/Iterators.hsc
@@ -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
+#include "cvIterators.h"
+
+#starttype F32_image_iterator
+#field image_data , Ptr Float
+#stoptype
+
+#ccall alloc_F32_image_iterator , IO (Ptr )
+#ccall free_F32_image_iterator , Ptr -> IO ()
+#ccall F32_create_rowwise_iterator , Ptr -> Ptr BareImage -> IO ()
+#ccall F32_next , Ptr -> IO (Ptr )
+#ccall F32_val , Ptr -> Ptr CFloat
+#ccall F32_rowwise_pos , Ptr -> Ptr
diff --git a/CV/Bindings/Matrix.hsc b/CV/Bindings/Matrix.hsc
--- a/CV/Bindings/Matrix.hsc
+++ b/CV/Bindings/Matrix.hsc
@@ -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
diff --git a/CV/Bindings/Tracking.hsc b/CV/Bindings/Tracking.hsc
new file mode 100644
--- /dev/null
+++ b/CV/Bindings/Tracking.hsc
@@ -0,0 +1,26 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+#include
+#include "cvWrapLEO.h"
+#include
+
+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 -> Ptr -> Ptr -> Ptr -> Ptr -> IO ()
+
+#ccall wrapMeanShift, Ptr -> Ptr -> Ptr -> Ptr -> 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 -> Ptr -> Int -> Ptr Float -> Ptr Float -> Ptr Float -> Int -> Ptr -> Ptr -> Int -> IO ()
+
+#num CV_VALUE
+#num CV_ARRAY
+
diff --git a/CV/Bindings/Types.hsc b/CV/Bindings/Types.hsc
new file mode 100644
--- /dev/null
+++ b/CV/Bindings/Types.hsc
@@ -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
+#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
+#field h_next, Ptr
+#field v_prev, Ptr
+#field v_next, Ptr
+#field total, CInt
+#field elem_size, CInt
+#field block_max, Ptr Char
+#field ptr, Ptr Char
+#field delta_elems, CInt
+#field free_blocks, Ptr
+#field first, Ptr
+#stoptype
+
+#ccall extractCVSeq, Ptr -> Ptr () -> IO ()
+#ccall cvGetSeqElem, Ptr -> CInt -> IO (Ptr CChar)
+#ccall printSeq, Ptr -> 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()
+
+-- CV_INLINE CvScalar cvRealScalar(
+-- double val0
+-- )
+
+-- #cinline cvRealScalar , CDouble -> IO()
+
+-- CV_INLINE CvScalar cvScalarAll(
+-- double val0123
+-- )
+
+-- #cinline cvScalarAll , CDouble -> IO()
+
+-- 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,
+#field rect,
+#field contour, Ptr
+#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 ,
+#field size ,
+#field angle ,CFloat
+#stoptype
+
+-- #startype CvHistogram
+-- #field type, Int
+-- #field bins, Ptr
+-- #array_field thresh, Ptr (Ptr Float)
+-- #field thresh2, Ptr (Ptr Float)
+-- #array_field mat,
+-- #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 )
+#ccall cvReleaseMemStorage, Ptr (Ptr ) -> 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
+#field depth_point, Ptr
+#field depth , CFloat
+#stoptype
+
+#starttype CvSURFPoint
+#field pt,
+#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
+
diff --git a/CV/Calibration.chs b/CV/Calibration.chs
--- a/CV/Calibration.chs
+++ b/CV/Calibration.chs
@@ -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
diff --git a/CV/ColourUtils.chs b/CV/ColourUtils.chs
--- a/CV/ColourUtils.chs
+++ b/CV/ColourUtils.chs
@@ -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 :/
diff --git a/CV/ConnectedComponents.chs b/CV/ConnectedComponents.chs
--- a/CV/ConnectedComponents.chs
+++ b/CV/ConnectedComponents.chs
@@ -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#}
diff --git a/CV/Conversions.hs b/CV/Conversions.hs
--- a/CV/Conversions.hs
+++ b/CV/Conversions.hs
@@ -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
diff --git a/CV/Corners.hs b/CV/Corners.hs
new file mode 100644
--- /dev/null
+++ b/CV/Corners.hs
@@ -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
diff --git a/CV/DFT.hs b/CV/DFT.hs
new file mode 100644
--- /dev/null
+++ b/CV/DFT.hs
@@ -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
diff --git a/CV/DrawableInstances.hs b/CV/DrawableInstances.hs
new file mode 100644
--- /dev/null
+++ b/CV/DrawableInstances.hs
@@ -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
+
+
diff --git a/CV/Drawing.chs b/CV/Drawing.chs
--- a/CV/Drawing.chs
+++ b/CV/Drawing.chs
@@ -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
diff --git a/CV/Edges.chs b/CV/Edges.chs
--- a/CV/Edges.chs
+++ b/CV/Edges.chs
@@ -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)
diff --git a/CV/Features.hs b/CV/Features.hs
new file mode 100644
--- /dev/null
+++ b/CV/Features.hs
@@ -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
+--
+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)
diff --git a/CV/Filters.chs b/CV/Filters.chs
--- a/CV/Filters.chs
+++ b/CV/Filters.chs
@@ -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 ->
diff --git a/CV/Fitting.hs b/CV/Fitting.hs
new file mode 100644
--- /dev/null
+++ b/CV/Fitting.hs
@@ -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 ]
+
diff --git a/CV/HighGUI.chs b/CV/HighGUI.chs
--- a/CV/HighGUI.chs
+++ b/CV/HighGUI.chs
@@ -6,8 +6,6 @@
import Foreign.ForeignPtr
import Foreign.Ptr
-import C2HSTools
-
import CV.Image
{#import CV.Image#}
import CV.ImageOp
diff --git a/CV/Histogram.chs b/CV/Histogram.chs
--- a/CV/Histogram.chs
+++ b/CV/Histogram.chs
@@ -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
diff --git a/CV/HoughTransform.hs b/CV/HoughTransform.hs
new file mode 100644
--- /dev/null
+++ b/CV/HoughTransform.hs
@@ -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
diff --git a/CV/Image.chs b/CV/Image.chs
--- a/CV/Image.chs
+++ b/CV/Image.chs
@@ -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
diff --git a/CV/ImageMath.chs b/CV/ImageMath.chs
--- a/CV/ImageMath.chs
+++ b/CV/ImageMath.chs
@@ -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)
-
-
+
+
diff --git a/CV/ImageOp.hs b/CV/ImageOp.hs
--- a/CV/ImageOp.hs
+++ b/CV/ImageOp.hs
@@ -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
diff --git a/CV/Iterators.hs b/CV/Iterators.hs
new file mode 100644
--- /dev/null
+++ b/CV/Iterators.hs
@@ -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
diff --git a/CV/LightBalance.chs b/CV/LightBalance.chs
--- a/CV/LightBalance.chs
+++ b/CV/LightBalance.chs
@@ -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
diff --git a/CV/Marking.hs b/CV/Marking.hs
--- a/CV/Marking.hs
+++ b/CV/Marking.hs
@@ -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
+
+
diff --git a/CV/Matrix.hs b/CV/Matrix.hs
--- a/CV/Matrix.hs
+++ b/CV/Matrix.hs
@@ -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
diff --git a/CV/Morphology.chs b/CV/Morphology.chs
--- a/CV/Morphology.chs
+++ b/CV/Morphology.chs
@@ -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
diff --git a/CV/Operations.hs b/CV/Operations.hs
new file mode 100644
--- /dev/null
+++ b/CV/Operations.hs
@@ -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 |+)
diff --git a/CV/Pixelwise.hs b/CV/Pixelwise.hs
--- a/CV/Pixelwise.hs
+++ b/CV/Pixelwise.hs
@@ -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)++" "
+
+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)
diff --git a/CV/TemplateMatching.chs b/CV/TemplateMatching.chs
--- a/CV/TemplateMatching.chs
+++ b/CV/TemplateMatching.chs
@@ -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 ->
diff --git a/CV/Textures.chs b/CV/Textures.chs
--- a/CV/Textures.chs
+++ b/CV/Textures.chs
@@ -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
diff --git a/CV/Thresholding.hs b/CV/Thresholding.hs
--- a/CV/Thresholding.hs
+++ b/CV/Thresholding.hs
@@ -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
diff --git a/CV/Tracking.hs b/CV/Tracking.hs
new file mode 100644
--- /dev/null
+++ b/CV/Tracking.hs
@@ -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
+
diff --git a/CV/Transforms.chs b/CV/Transforms.chs
--- a/CV/Transforms.chs
+++ b/CV/Transforms.chs
@@ -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)
diff --git a/Utils/DrawingClass.hs b/Utils/DrawingClass.hs
new file mode 100644
--- /dev/null
+++ b/Utils/DrawingClass.hs
@@ -0,0 +1,5 @@
+{-#LANGUAGE TypeFamilies, MultiParamTypeClasses#-}
+module Utils.DrawingClass where
+
+class Draws a b where
+ draw :: a -> b
diff --git a/Utils/GeometryClass.hs b/Utils/GeometryClass.hs
new file mode 100644
--- /dev/null
+++ b/Utils/GeometryClass.hs
@@ -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))
+
diff --git a/Utils/Point.hs b/Utils/Point.hs
--- a/Utils/Point.hs
+++ b/Utils/Point.hs
@@ -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
diff --git a/Utils/Pointer.hs b/Utils/Pointer.hs
new file mode 100644
--- /dev/null
+++ b/Utils/Pointer.hs
@@ -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
+
diff --git a/Utils/Rectangle.hs b/Utils/Rectangle.hs
--- a/Utils/Rectangle.hs
+++ b/Utils/Rectangle.hs
@@ -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
diff --git a/Utils/Stream.hs b/Utils/Stream.hs
--- a/Utils/Stream.hs
+++ b/Utils/Stream.hs
@@ -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
-
+
diff --git a/cbits/cvIterators.c b/cbits/cvIterators.c
new file mode 100644
--- /dev/null
+++ b/cbits/cvIterators.c
@@ -0,0 +1,63 @@
+#include "cvIterators.h"
+#include
+
+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;
+}
diff --git a/cbits/cvIterators.h b/cbits/cvIterators.h
new file mode 100644
--- /dev/null
+++ b/cbits/cvIterators.h
@@ -0,0 +1,56 @@
+#ifndef __CVITERATORS__
+#define __CVITERATORS__
+
+#include
+
+/*
+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
diff --git a/cbits/cvWrapCore.c b/cbits/cvWrapCore.c
new file mode 100644
--- /dev/null
+++ b/cbits/cvWrapCore.c
@@ -0,0 +1,69 @@
+#include "cvWrapCore.h"
+#include
+
+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);
+}
diff --git a/cbits/cvWrapCore.h b/cbits/cvWrapCore.h
new file mode 100644
--- /dev/null
+++ b/cbits/cvWrapCore.h
@@ -0,0 +1,26 @@
+#ifndef __CVWRAPCORE__
+#define __CVWRAPCORE__
+
+#include
+
+/* 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
diff --git a/cbits/cvWrapLEO.c b/cbits/cvWrapLEO.c
--- a/cbits/cvWrapLEO.c
+++ b/cbits/cvWrapLEO.c
@@ -6,6 +6,7 @@
//@+node:aleator.20050908100314.1:Includes
#include "cvWrapLEO.h"
#include
+#include
#include
#include
@@ -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; idepth,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=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;itotal,*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 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= deltax) {
@@ -1036,7 +1058,7 @@
double m1 = calculateMoment(1,arr, l);
double result = 0;
for(j=0; j 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; i0.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) 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 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 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 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 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=size.width
|| y+j<0 || y+j>=size.height)
continue;
-
+
processed = blurGet2D(img,x+i,y+j);
if (fabs(processed-centerValue) %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 %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; istorage));
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; icontour,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; icontour->total;++i)
+ for (i=0; icontour->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 );
+}}
//
diff --git a/cbits/cvWrapLEO.h b/cbits/cvWrapLEO.h
--- a/cbits/cvWrapLEO.h
+++ b/cbits/cvWrapLEO.h
@@ -8,6 +8,7 @@
#define M_PI 3.14159265358979323846
#endif
+#include
#include
#include
#include
@@ -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
diff --git a/cbits/wrapImgProc.c b/cbits/wrapImgProc.c
new file mode 100644
--- /dev/null
+++ b/cbits/wrapImgProc.c
@@ -0,0 +1,6 @@
+#include "wrapImgProc.h"
+#include
+
+void wrapFilter2(const CvArr* src, CvArr* dst, const CvMat* kernel, CvPoint *anchor)
+{cvFilter2D(src, dst, kernel, *anchor);};
+
diff --git a/cbits/wrapImgProc.h b/cbits/wrapImgProc.h
new file mode 100644
--- /dev/null
+++ b/cbits/wrapImgProc.h
@@ -0,0 +1,8 @@
+#ifndef __CVWRAPIMGPROC__
+#define __CVWRAPIMGPROC__
+
+#include
+
+void wrapFilter2(const CvArr* src, CvArr* dst, const CvMat* kernel, CvPoint *anchor);
+
+#endif
diff --git a/examples/ConnectedComponents.hs b/examples/ConnectedComponents.hs
new file mode 100644
--- /dev/null
+++ b/examples/ConnectedComponents.hs
@@ -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
diff --git a/examples/Fitting.hs b/examples/Fitting.hs
new file mode 100644
--- /dev/null
+++ b/examples/Fitting.hs
@@ -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)
diff --git a/examples/Fuse.hs b/examples/Fuse.hs
--- a/examples/Fuse.hs
+++ b/examples/Fuse.hs
@@ -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..]]
diff --git a/examples/Histograms.hs b/examples/Histograms.hs
new file mode 100644
--- /dev/null
+++ b/examples/Histograms.hs
@@ -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
diff --git a/examples/Hough.hs b/examples/Hough.hs
new file mode 100644
--- /dev/null
+++ b/examples/Hough.hs
@@ -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
+
diff --git a/examples/MR-Edge.hs b/examples/MR-Edge.hs
deleted file mode 100644
--- a/examples/MR-Edge.hs
+++ /dev/null
@@ -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
-
diff --git a/examples/MeanShift.hs b/examples/MeanShift.hs
new file mode 100644
--- /dev/null
+++ b/examples/MeanShift.hs
@@ -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 ..]]
diff --git a/examples/Monster.hs b/examples/Monster.hs
--- a/examples/Monster.hs
+++ b/examples/Monster.hs
@@ -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 (
- 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
diff --git a/examples/montageDebug.hs b/examples/montageDebug.hs
deleted file mode 100644
--- a/examples/montageDebug.hs
+++ /dev/null
@@ -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
-
diff --git a/examples/mser.hs b/examples/mser.hs
new file mode 100644
--- /dev/null
+++ b/examples/mser.hs
@@ -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
+
diff --git a/examples/pixelwise.hs b/examples/pixelwise.hs
--- a/examples/pixelwise.hs
+++ b/examples/pixelwise.hs
@@ -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
]
diff --git a/examples/surf.hs b/examples/surf.hs
new file mode 100644
--- /dev/null
+++ b/examples/surf.hs
@@ -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