From 7dea75d8f91bd2de1644d24e16393c0e72c15de7 Mon Sep 17 00:00:00 2001 From: Ville Tirronen Date: Mon, 19 Apr 2010 15:18:54 +0300 Subject: [PATCH] Initial import This contains only the CV module. For version history of this module and it's siblings, contact ville.e.t.tirronen@jyu.fi. --- C2HS.hs | 220 ++++ C2HSTools.hs | 220 ++++ CV.cabal | 29 + CV/Binary.hs | 22 + CV/ColourUtils.chs | 49 + CV/ConnectedComponents.chs | 125 ++ CV/Conversions.hs | 58 + CV/Drawing.chs | 92 ++ CV/Edges.chs | 51 + CV/Filters.chs | 223 ++++ CV/FunnyStatistics.hs | 31 + CV/Gabor.chs | 57 + CV/HighGUI.chs | 39 + CV/Histogram.chs | 170 +++ CV/Image.chs | 232 ++++ CV/ImageMath.chs | 263 +++++ CV/ImageMathOp.hs | 17 + CV/ImageOp.hs | 30 + CV/LightBalance.chs | 17 + CV/Marking.hs | 62 + CV/Morphology.chs | 131 +++ CV/MultiresolutionSpline.hs | 44 + CV/PatternRemover.hs | 34 + CV/Sampling.hs | 116 ++ CV/TemplateMatching.chs | 76 ++ CV/Textures.chs | 43 + CV/Thresholding.hs | 75 ++ CV/Transforms.chs | 207 ++++ CV/cvWrapLEO.c | 2162 +++++++++++++++++++++++++++++++++++ CV/cvWrapLEO.h | 261 +++++ LICENSE | 0 31 files changed, 5156 insertions(+) create mode 100644 C2HS.hs create mode 100644 C2HSTools.hs create mode 100644 CV.cabal create mode 100644 CV/Binary.hs create mode 100644 CV/ColourUtils.chs create mode 100644 CV/ConnectedComponents.chs create mode 100644 CV/Conversions.hs create mode 100644 CV/Drawing.chs create mode 100644 CV/Edges.chs create mode 100644 CV/Filters.chs create mode 100644 CV/FunnyStatistics.hs create mode 100644 CV/Gabor.chs create mode 100644 CV/HighGUI.chs create mode 100644 CV/Histogram.chs create mode 100644 CV/Image.chs create mode 100644 CV/ImageMath.chs create mode 100644 CV/ImageMathOp.hs create mode 100644 CV/ImageOp.hs create mode 100644 CV/LightBalance.chs create mode 100644 CV/Marking.hs create mode 100644 CV/Morphology.chs create mode 100644 CV/MultiresolutionSpline.hs create mode 100644 CV/PatternRemover.hs create mode 100644 CV/Sampling.hs create mode 100644 CV/TemplateMatching.chs create mode 100644 CV/Textures.chs create mode 100644 CV/Thresholding.hs create mode 100644 CV/Transforms.chs create mode 100644 CV/cvWrapLEO.c create mode 100644 CV/cvWrapLEO.h create mode 100644 LICENSE diff --git a/C2HS.hs b/C2HS.hs new file mode 100644 index 0000000..f0c6e75 --- /dev/null +++ b/C2HS.hs @@ -0,0 +1,220 @@ +-- 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 new file mode 100644 index 0000000..699fc72 --- /dev/null +++ b/C2HSTools.hs @@ -0,0 +1,220 @@ +-- 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 new file mode 100644 index 0000000..d7a6031 --- /dev/null +++ b/CV.cabal @@ -0,0 +1,29 @@ +Name: CV +Version: 0.1 +Description: OpenCV Bindings +License: GPL +License-file: LICENSE +Author: Ville Tirronen +Maintainer: ville.tirronen@jyu.fi +Build-Type: Simple +Cabal-Version: >=1.2 + +Library + Build-Tools: c2hs >= 0.16.0 + Include-dirs: /opt/local/include/opencv, CV/ + Includes: cv.h, cxtypes.h, highgui.h, CV/cvWrapLEO.h + c-sources: CV/cvWrapLEO.c + cc-options: --std=c99 + extra-libraries: cv, cxcore, highgui + Build-Depends: haskell98, base >= 3 && < 5, parallel > 1.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, JYU-Utils, storable-complex, binary >= 0.5 + Exposed-modules: CV.Image, CV.ColourUtils, CV.ImageMath, CV.ImageMathOp, CV.ImageOp, + CV.Drawing, CV.Edges, CV.Filters, CV.Histogram, CV.LightBalance, CV.Morphology, + CV.TemplateMatching, CV.Transforms, CV.FunnyStatistics, CV.MultiresolutionSpline, CV.HighGUI, + CV.Sampling, CV.Marking, CV.Textures, CV.Gabor, CV.ConnectedComponents, CV.Conversions, + CV.Thresholding, CV.Binary + Other-modules: C2HSTools, C2HS + + ghc-options: -O2 -fglasgow-exts + diff --git a/CV/Binary.hs b/CV/Binary.hs new file mode 100644 index 0000000..349e6e6 --- /dev/null +++ b/CV/Binary.hs @@ -0,0 +1,22 @@ +{-#LANGUAGE ScopedTypeVariables#-} +module CV.Binary where +import CV.Image (Image) +import CV.Conversions + +import Data.Maybe (fromJust) +import Data.Binary +import Data.Array.CArray +import Data.Array.IArray + + +-- NOTE: This binary instance is NOT PORTABLE.   + +instance Binary Image where + put img = do + let arr :: CArray (Int,Int) Double = copyImageToCArray img + put (bounds arr) + put . unsafeCArrayToByteString $ arr + get = do + bds <- get + get >>= return . copyCArrayToImage . fromJust . unsafeByteStringToCArray bds + diff --git a/CV/ColourUtils.chs b/CV/ColourUtils.chs new file mode 100644 index 0000000..3ea71a5 --- /dev/null +++ b/CV/ColourUtils.chs @@ -0,0 +1,49 @@ +{-#LANGUAGE ForeignFunctionInterface#-} +#include "cvWrapLEO.h" +module CV.ColourUtils where +import Foreign.C.Types +import Foreign.C.String +import Foreign.ForeignPtr +import Foreign.Ptr + +import CV.Image +{#import CV.Image#} +import CV.ImageOp +import qualified CV.ImageMath as IM +import CV.ImageMathOp + +import C2HS + +-- Balance image grayscales so that it has m mean and md standard deviation +balance (m,md) i = m |+ (scale |* (i |- im) ) + where + imd = realToFrac $ IM.stdDeviation i + im = IM.average i + scale = realToFrac $ md/imd + + +logarithmicCompression image = stretchHistogram $ + IM.log $ 1 `IM.addS` image + + +getStretchScaling reference image = stretched + where + stretched = (1/realToFrac length) `IM.mulS` normed + normed = image `IM.subS` (realToFrac min) + length = max-min + (min,max) = IM.findMinMax reference + + +stretchHistogram image = stretched + where + stretched = (1/realToFrac length) `IM.mulS` normed + normed = image `IM.subS` (realToFrac min) + length = max-min + (min,max) = IM.findMinMax image + +equalizeHistogram image = unsafePerformIO $ do + x <- imageTo8Bit image + withGenImage x $ \i -> + {#call cvEqualizeHist#} i i + imageTo32F x + diff --git a/CV/ConnectedComponents.chs b/CV/ConnectedComponents.chs new file mode 100644 index 0000000..dcadef4 --- /dev/null +++ b/CV/ConnectedComponents.chs @@ -0,0 +1,125 @@ +{-#LANGUAGE ForeignFunctionInterface#-} +#include "cvWrapLEO.h" +module CV.ConnectedComponents +-- (selectSizedComponents,countBlobs,centralMoments +-- ,huMoments,Contours,getContours) +where + +import Foreign.Ptr +import Foreign.C.Types +import System.IO.Unsafe +import Foreign.ForeignPtr + +import C2HSTools + +{#import CV.Image#} + +import CV.ImageOp + +countBlobs image = unsafePerformIO $ do + eightBit <- imageTo8Bit image + withGenImage eightBit $ \i -> + {#call blobCount#} i + +selectSizedComponents minSize maxSize image = unsafePerformIO $ do + eightBit <- imageTo8Bit image + withGenImage eightBit $ \i -> + creatingImage ({#call sizeFilter#} i minSize maxSize) + + +{#pointer *CvMoments as Moments foreign newtype#} + +-- foreign import ccall "& freeCvMoments" releaseMoments :: FinalizerPtr Moments + +centralMoments image binary = unsafePerformIO $ do + moments <- withImage image $ \i -> {#call getMoments#} i (if binary then 1 else 0) + ms <- sequence [{#call cvGetCentralMoment#} moments i j + | i <- [0..3], j<-[0..3], i+j <= 3] + {#call freeCvMoments#} moments + return ms + +huMoments image binary = unsafePerformIO $ do + moments <- withImage image $ \i -> {#call getMoments#} i (if binary then 1 else 0) + hu <- readHu moments + {#call freeCvMoments#} moments + return hu + +readHu m = do + hu <- mallocArray 7 + {#call getHuMoments#} m hu + hu' <- peekArray 7 hu + free hu + return hu' + +-- Contours +{#pointer *FoundContours as Contours foreign newtype#} +foreign import ccall "& free_found_contours" releaseContours + :: FinalizerPtr Contours + +getContours img = unsafePerformIO $ do + withImage img $ \i -> do + ptr <- {#call get_contours#} i + fptr <- newForeignPtr releaseContours ptr + return $ Contours fptr + + +newtype ContourFunctionUS a = CFUS (Contours -> IO a) +newtype ContourFunctionIO a = CFIO (Contours -> IO a) + +rawContourOpUS op = CFUS $ \c -> withContours c op +rawContourOp op = CFIO $ \c -> withContours c op + +printContour = rawContourOp {#call print_contour#} +contourArea = rawContourOpUS ({#call contour_area#}) +contourPerimeter = rawContourOpUS {#call contour_perimeter#} + +getContourPoints = rawContourOpUS getContourPoints' +getContourPoints' f = do + count <- {#call cur_contour_size#} f + let count' = fromIntegral count + ----print count + xs <- mallocArray count' + ys <- mallocArray count' + {#call contour_points#} f xs ys + xs' <- peekArray count' xs + ys' <- peekArray count' ys + free xs + free ys + return $ zip (map fromIntegral xs') (map fromIntegral ys') + +getContourHuMoments = rawContourOpUS getContourHuMoments' +getContourHuMoments' f = do + m <- {#call contour_moments#} f + hu <- readHu m + {#call freeCvMoments#} m + return hu + +mapContours :: ContourFunctionUS a -> Contours -> [a] +mapContours (CFUS op) contours = unsafePerformIO $ do + let loop acc cp = do + more <- withContours cp {#call more_contours#} + if more < 1 + then return acc + else do + x <- op cp + (i::CInt) <- withContours cp {#call next_contour#} + loop (x:acc) cp + + acc <- loop [] contours + withContours contours ({#call reset_contour#}) + return acc + +mapContoursIO :: ContourFunctionIO a -> Contours -> IO [a] +mapContoursIO (CFIO op) contours = do + let loop acc cp = do + more <- withContours cp {#call more_contours#} + if more < 1 + then return acc + else do + x <- op cp + (i::CInt) <- withContours cp {#call next_contour#} + loop (x:acc) cp + + acc <- loop [] contours + withContours contours ({#call reset_contour#}) + return acc diff --git a/CV/Conversions.hs b/CV/Conversions.hs new file mode 100644 index 0000000..bc8ec91 --- /dev/null +++ b/CV/Conversions.hs @@ -0,0 +1,58 @@ +{-#LANGUAGE ForeignFunctionInterface#-} + +module CV.Conversions where + +import Complex + +import CV.Image + +import Data.Array.CArray +import Data.Array.IArray + +import Foreign.C.Types +import Foreign.Ptr +import Foreign.Storable.Complex +import System.IO.Unsafe + +-- | Copy the contents of a CArray into CV.Image type. +copyCArrayToImage :: CArray (Int,Int) Double -> Image +copyCArrayToImage carr = unsafePerformIO $ + creatingImage (withCArray carr (acquireImageSlow' w h)) + where + ((sx,sy),(ex,ey)) = bounds carr + (w,h) = (fromIntegral $ ex-sx+1, fromIntegral $ ey-sy+1) + +copyComplexCArrayToImage :: CArray (Int,Int) (Complex Double) -> Image +copyComplexCArrayToImage carr = unsafePerformIO $ + creatingImage (withCArray carr (acquireImageSlowComplex' w h)) + where + ((sx,sy),(ex,ey)) = bounds carr + (w,h) = (fromIntegral $ ex-sx+1, fromIntegral $ ey-sy+1) + +-- | Copy the contents of a CV.Image into a CArray. +copyImageToCArray :: Image -> CArray (Int,Int) Double +copyImageToCArray img = unsafePerformIO $ + withImage img $ \cimg -> + createCArray ((0,0),(w-1,h-1)) (exportImageSlow' cimg) --({#call exportImageSlow#} cimg) + where + (w,h) = getSize img + +copyImageToComplexCArray :: Image -> CArray (Int,Int) (Complex Double) +copyImageToComplexCArray img = unsafePerformIO $ + withImage img $ \cimg -> + createCArray ((0,0),(w-1,h-1)) (exportImageSlowComplex' cimg) --({#call exportImageSlow#} cimg) + where + (w,h) = getSize img + +foreign import ccall safe "CV/cvWrapLeo.h exportImageSlow" + exportImageSlow' :: ((Ptr (Image)) -> ((Ptr Double) -> (IO ()))) + +foreign import ccall safe "CV/cvWrapLeo.h exportImageSlowComplex" + exportImageSlowComplex' :: ((Ptr (Image)) -> ((Ptr (Complex Double)) -> (IO ()))) + +foreign import ccall safe "CV/cvWrapLeo.h acquireImageSlow" + acquireImageSlow' :: (Int -> (Int -> ((Ptr Double) -> (IO (Ptr (Image)))))) + +foreign import ccall safe "CV/cvWrapLeo.h acquireImageSlowComplex" + acquireImageSlowComplex' :: (Int -> (Int -> ((Ptr (Complex Double)) -> (IO (Ptr (Image)))))) + diff --git a/CV/Drawing.chs b/CV/Drawing.chs new file mode 100644 index 0000000..aceb0c5 --- /dev/null +++ b/CV/Drawing.chs @@ -0,0 +1,92 @@ +{-#LANGUAGE ForeignFunctionInterface#-} +#include "cvWrapLEO.h" + +module CV.Drawing(ShapeStyle(Filled,Stroked),circle,putTextOp,circleOp,fillOp + ,floodfill,drawLinesOp,lineOp,line,drawLines,rectangle + ,rectOp,rectOpS,fillPolyOp,fillPoly) where + +import Foreign.Ptr +import Foreign.C.Types +import Foreign.C.String +import Foreign.ForeignPtr +import Foreign.Marshal.Array +import Foreign.Marshal.Alloc +import System.IO.Unsafe + +{#import CV.Image#} + +import CV.ImageOp + +data ShapeStyle = Filled | Stroked Int + deriving(Eq,Show) + +styleToCV Filled = -1 +styleToCV (Stroked w) = fromIntegral w + +putTextOp size text (x,y) = ImgOp $ \img -> do + withGenImage img $ \cimg -> + withCString text $ \(ctext) -> + {#call wrapDrawText#} cimg ctext size x y + +circleOp (x,y) r c s = ImgOp $ \i -> do + let (w,h) = getSize i + let tr = r + abs (styleToCV s) + if r <1 + then return () + else withGenImage i $ \img -> + ({#call wrapDrawCircle#} img x y r c + $ styleToCV s) + +lineOp c t (x,y) (x1,y1) = ImgOp $ \i -> do + withGenImage i $ \img -> + {#call wrapDrawLine#} img x y x1 y1 c t + +fillPolyOp c pts = ImgOp $ \i -> do + withImage i $ \img -> do + let (xs,ys) = unzip pts + xs' <- newArray $ map fromIntegral xs + ys' <- newArray $ map fromIntegral ys + {#call wrapFillPolygon#} img + (fromIntegral $ length xs) xs' ys' + (realToFrac c) + free xs' + free ys' + +rectOp c t (x,y) (x1,y1) = ImgOp $ \i -> do + withGenImage i $ \img -> + {#call wrapDrawRectangle#} img x y x1 y1 c t + +rectOpS c t (x,y) (w,h) = ImgOp $ \i -> do + withGenImage i $ \img -> + {#call wrapDrawRectangle#} img x y (x+w) (y+h) c t + +line color thickness start end i = + operate (lineOp color thickness start end ) i + +rectangle color thickness a b i = + operate (rectOp color thickness a b ) i + +fillPoly c pts i = operate (fillPolyOp c pts) i + +drawLinesOp color thickness segments = + foldl (#>) nonOp + $ map (\(a,b) -> lineOp color thickness a b) segments + +drawLines img color thickness segments = operateOn img + (drawLinesOp color thickness segments) + +circle center r color s i = unsafeOperate (circleOp center r color s) i + +floodfill (x,y) color low high floats = + unsafeOperate (fillOp (x,y) color low high floats) + +fillOp (x,y) color low high floats = + ImgOp $ \i -> do + withImage i $ \img -> + ({#call wrapFloodFill#} img x y color low high + (toCINT $ floats)) + where + toCINT False = 0 + toCINT True = 1 + + diff --git a/CV/Edges.chs b/CV/Edges.chs new file mode 100644 index 0000000..2e9b2a2 --- /dev/null +++ b/CV/Edges.chs @@ -0,0 +1,51 @@ +{-#LANGUAGE ForeignFunctionInterface#-} +#include "cvWrapLEO.h" +module CV.Edges where +import Foreign.C.Types +import Foreign.C.String +import Foreign.ForeignPtr +import Foreign.Ptr + +import CV.ImageOp + +import CV.Image +{#import CV.Image#} + +import C2HSTools + +sobelOp :: (Int,Int) -> Int -> ImageOperation +sobelOp (dx,dy) aperture + | dx >=0 && dx <3 + && aperture `elem` [-1,1,3,5,7] + && not ((aperture == -1) && (dx>1 || dy>1)) + && dy >=0 && dy<3 = ImgOp $ \i -> withGenImage i $ \image -> + ({#call cvSobel#} image image cdx cdy cap) + + | otherwise = error "Invalid aperture" + where [cdx,cdy,cap] = map fromIntegral [dx,dy,aperture] + +sobel dd ap im = unsafeOperate (sobelOp dd ap) im + + +laplaceOp s = ImgOp $ \img -> withGenImage img $ \image -> + if s `elem` [1,3,5,7] + then ({#call cvLaplace #} image image s) + else error "Laplace aperture must be 1, 3, 5 or 7" +laplace s i = unsafeOperate (laplaceOp s) i + +-- TODO: Add tests below! +canny t1 t2 aperture src' = unsafePerformIO $ do + src <- imageTo8Bit src' + withClone src $ \clone -> + withGenImage src $ \si -> + withGenImage clone $ \ci -> do + {#call cvCanny#} si ci t1 t2 aperture + imageTo32F clone + + + + +susan (w,h) t image = unsafePerformIO $ do + withGenImage image $ \img -> + creatingImage + ({#call susanEdge#} img w h t) diff --git a/CV/Filters.chs b/CV/Filters.chs new file mode 100644 index 0000000..0c61cd8 --- /dev/null +++ b/CV/Filters.chs @@ -0,0 +1,223 @@ +{-#LANGUAGE ForeignFunctionInterface#-} +#include "cvWrapLEO.h" +module CV.Filters(gaussian,gaussianOp,bilateral + ,blurOp,blur,blurNS + ,median,mkFilter,forWindows,center + ,susan,getCentralMoment,getAbsCentralMoment + ,getMoment,secondMomentBinarize,secondMomentBinarizeOp + ,secondMomentAdaptiveBinarize,secondMomentAdaptiveBinarizeOp + ,selectiveAvg,convolve2D,convolve2DI,haar,haarAt + ,IntegralImage,getIISize,integralImage,verticalAverage) where +import Foreign.C.Types +import Foreign.C.String +import Foreign.ForeignPtr +import Foreign.Ptr + +import CV.Image +import CV.ImageOp +import Debug.Trace + +import C2HSTools +{#import CV.Image#} + +-- higher level api for creating non-convolutional filters + +-- Type for handling regions of image. Read this as "a function that +-- takes an image with ROI set, and returns a new value for the center pixel +type RegionOp = Image -> IO CDouble +-- Filter image using RegionOp. RegionOp is applied to +-- given size window, and its results are stored into a new +-- image. Window is specified using ROI +mkFilter :: (CInt,CInt) -> RegionOp -> ImageOperation +mkFilter (w,h) rOp + | odd w && odd h = ImgOp $ \image -> do + clone <- cloneImage image + --result <- createImage resultSize imageDepth32F 1 + let (imageW,imageH) = getSize image + let wpad = w `div` 2 + let hpad = h `div` 2 + let resultSize = (imageW - (2*wpad),imageH - (2*hpad)) + let windows = [(i,j) | i<-[0..fst resultSize-1] + , j<-[0..snd resultSize-1]] + sequence_ [applyOp pos (wpad,hpad) clone image | pos <- windows] + resetROI clone + return () + + | otherwise = error "Must have odd size window" -- have only odd size windows + + where + (cw,ch) = (fromIntegral w,fromIntegral h) + applyOp pos shift src dst = setROI pos (cw,ch) src + >> (createPixel pos shift src dst) + + createPixel :: (CInt,CInt) -> (CInt,CInt) -> Image -> Image -> IO () + createPixel (x,y) (dx,dy) src dst = do + val <- rOp src + setPixel (x+dx,y+dy) val dst + +forWindows (w,h) (imageW,imageH) op dst + | odd w && odd h = do + let wpad = w `div` 2 + let hpad = h `div` 2 + let resultSize = (imageW - (2*wpad),imageH - (2*hpad)) + let positions = [((i,j)) | i<-[0..fst resultSize-1] + , j<-[0..snd resultSize-1]] + sequence_ [createPixel pos (wpad,hpad) dst | pos <- positions] + return dst + + | otherwise = error "Must have odd size window" -- have only odd size windows + + where + (cw,ch) = (fromIntegral w,fromIntegral h) + createPixel (x,y) (dx,dy) dst = do + val <- op ((x,y),(cw,ch)) + setPixel (x+dx,y+dy) val dst + +center ((x,y),(w,h)) = (x+(w `div` 2), y+(h `div` 2)) +-- Low level wrapper for Susan filtering: +-- IplImage* susanSmooth(IplImage *src, int w, int h +-- ,double t, double sigma); + +susan (w,h) t sigma image = unsafePerformIO $ do + withGenImage image $ \img -> + creatingImage + ({#call susanSmooth#} img w h t sigma) +-- TODO: ADD checks above! +selectiveAvg (w,h) t image = unsafePerformIO $ do + withGenImage image $ \img -> + creatingImage + ({#call selectiveAvgFilter#} + img t w h) +-- TODO: ADD checks above! + +getCentralMoment n (w,h) image = unsafePerformIO $ do + withGenImage image $ \img -> + creatingImage + ({#call getNthCentralMoment#} img n w h) + +getAbsCentralMoment n (w,h) image = unsafePerformIO $ do + withGenImage image $ \img -> + creatingImage + ({#call getNthAbsCentralMoment#} img n w h) + +getMoment n (w,h) image = unsafePerformIO $ do + withGenImage image $ \img -> + creatingImage + ({#call getNthMoment#} img n w h) +-- TODO: ADD checks above! + +secondMomentBinarizeOp t = ImgOp $ \image -> + withGenImage image (flip {#call smb#} $ t) +secondMomentBinarize t i = unsafeOperate (secondMomentBinarizeOp t) i + +secondMomentAdaptiveBinarizeOp w h t = ImgOp $ \image -> + withGenImage image + (\i-> {#call smab#} i w h t) +secondMomentAdaptiveBinarize w h t i = unsafeOperate (secondMomentAdaptiveBinarizeOp w h t) i + +-- Low level wrapper for opencv +data SmoothType = BlurNoScale | Blur + | Gaussian | Median + | Bilateral + deriving(Enum) + +{#fun cvSmooth as smooth' + {withGenImage* `Image' + ,withGenImage* `Image' + ,`Int',`Int',`Int',`Double',`Double'} + -> `()'#} + +gaussianOp (w,h) + | maskIsOk (w,h) = ImgOp $ \img -> + smooth' img img (fromEnum Gaussian) w h 0 0 + | otherwise = error "One of aperture dimensions is incorrect (should be >=1 and odd))" + +gaussian = unsafeOperate.gaussianOp + +blurOp (w,h) + | maskIsOk (w,h) = ImgOp $ \img -> + smooth' img img (fromEnum Blur) w h 0 0 + | otherwise = error "One of aperture dimensions is incorrect (should be >=1 and odd))" + +blurNSOp (w,h) + | maskIsOk (w,h) = ImgOp $ \img -> + smooth' img img (fromEnum BlurNoScale) w h 0 0 + | otherwise = error "One of aperture dimensions is incorrect (should be >=1 and odd))" + +blur size image = let r = unsafeOperate (blurOp size) image + in r +blurNS size image = let r = unsafeOperate (blurNSOp size) image + in r + +-- These work on 8 bit images only! Need a fix. TODO TODO! +bilateral colorS spaceS img = withClone img $ \clone -> + smooth' img clone (fromEnum Bilateral) + colorS spaceS 0 0 + + +median (w,h) img + | maskIsOk (w,h) = unsafePerformIO $ do + clone1 <- imageTo8Bit img + clone2 <- imageTo8Bit img + smooth' clone1 clone2 (fromEnum Median) w h 0 0 + imageTo32F clone2 + | otherwise = error "One of aperture dimensions is incorrect (should be >=1 and odd))" + +maskIsOk (w,h) = odd w && odd h && w >0 && h>0 + + +-- General 2D comvolutions +-- 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 + +convolve2DI (x,y) kernel image = unsafePerformIO $ + withImage image $ \img-> + withImage kernel $ \k -> + creatingImage $ + {#call wrapFilter2DImg#} + img k x y + +verticalAverage image = unsafePerformIO $ do + let (w,h) = getSize image + s <- createImage32F (w,h) 1 + withGenImage image $ \i -> do + withGenImage s $ \sum -> do + {#call vertical_average#} i sum + return s + +newtype IntegralImage = IntegralImage Image + +getIISize (IntegralImage i) = getSize i + +integralImage image = unsafePerformIO $ do + let (w,h) = getSize image + s <- createImage64F (w+1,h+1) 1 + withGenImage image $ \i -> do + withGenImage s $ \sum -> do + {#call cvIntegral#} i sum nullPtr nullPtr + return $ IntegralImage s + + +haar (IntegralImage image) (a',b',c',d') = unsafePerformIO $ do + let (w,h) = getSize image + let [a,b,c,d] = map fromIntegral [a',b',c',d'] + r <- createImage32F (w,h) 1 + withImage image $ \sum -> + withImage r $ \res -> do + {#call haarFilter#} sum + (min a c) + (max b d) + (max a c) + (min b d) + res + return r + +haarAt (IntegralImage ii) (a,b,w,h) = unsafePerformIO $ withImage ii $ \i -> + {#call haar_at#} i a b w h diff --git a/CV/FunnyStatistics.hs b/CV/FunnyStatistics.hs new file mode 100644 index 0000000..39da131 --- /dev/null +++ b/CV/FunnyStatistics.hs @@ -0,0 +1,31 @@ +module CV.FunnyStatistics where + +import CV.Image +import CV.Filters +import qualified CV.ImageMath as IM +import CV.ImageMathOp + +nthCM s n i = blur s $ (i #- blur s i) |^ n + +r_variance s i = msq #- (m #* m) + where + msq = gaussian s (i #* i) + m = gaussian s i + +variance s i = msq #- (m #* m) + where + msq = blur s (i #* i) + m = blur s i + +stdDev s i = IM.sqrt $ variance s i +r_stdDev s i = IM.sqrt $ r_variance s i + +{- +skewness s i = IM.div (nthCM s 3 i) (stdDev s i |^3) + +kurtosis s i = IM.div (nthCM s 4 i) (stdDev s i |^4) +xx s i = IM.div (nthCM s 6 i) (stdDev s i |^6) + -} + +pearsonSkewness1 s image = IM.div (blur s image #- median s image) + (stdDev s image) diff --git a/CV/Gabor.chs b/CV/Gabor.chs new file mode 100644 index 0000000..88828e1 --- /dev/null +++ b/CV/Gabor.chs @@ -0,0 +1,57 @@ +{-#LANGUAGE ForeignFunctionInterface#-} +#include "cvWrapLEO.h" +module CV.Gabor where + +{#import CV.Image #} +{#import CV.Filters #} +import CV.Image +import CV.Filters +import System.IO.Unsafe +import Foreign.C.Types +import Foreign.Ptr +import CV.Transforms + +newtype GaborMask = GaborMask (CInt,CInt,CDouble,CDouble,CDouble,CDouble,CDouble) + +-- gaborFilterS +-- (GaborMask (width,height,stdX,stdY,theta,phase,cycles)) image +-- = convolve2DI (width `div` 2,height `div` 2) kernel image +-- where +-- kernel = scale Cubic 0.5 +-- $ gaborImage 0 0 (GaborMask (2*width,2*height,stdX,stdY,theta,phase,cycles)) +-- + +gaborImage (width,height,dx,dy,stdX,stdY,theta,phase,cycles) = + unsafePerformIO $ do + img <- createImage32F (width,height) 1 + withGenImage img $ \i -> + {#call renderGabor#} i width height dx dy stdX stdY theta phase cycles + return img + +gaborFiltering (GaborMask (width,height,stdX,stdY,theta,phase,cycles)) image = + unsafePerformIO $ + withClone image $ \img -> + withGenImage img $ \clone -> + withGenImage image $ \original -> + {#call gaborFilter#} original clone width height + stdX stdY theta phase cycles + +radialGaborFiltering (width,height,sigma,phase + ,center,cycles) image = + unsafePerformIO $ + withClone image $ \img -> + withGenImage img $ \clone -> + withGenImage image $ \original -> + {#call radialGaborFilter#} original clone + width height + sigma phase center cycles + +radialGaborImage (width,height,sigma,phase + ,center,cycles) = + unsafePerformIO $ do + img <- createImage32F (width,height) 1 + withGenImage img $ \i -> + {#call renderRadialGabor#} i width height sigma + phase center cycles + return img + diff --git a/CV/HighGUI.chs b/CV/HighGUI.chs new file mode 100644 index 0000000..5cf7dbe --- /dev/null +++ b/CV/HighGUI.chs @@ -0,0 +1,39 @@ +{-#LANGUAGE ForeignFunctionInterface#-} +#include "cvWrapLEO.h" +module CV.HighGUI where +import Foreign.C.Types +import Foreign.C.String +import Foreign.ForeignPtr +import Foreign.Ptr + +import C2HSTools + +import CV.Image +{#import CV.Image#} +import CV.ImageOp +import Control.Concurrent + +-- Functions for easy operation + +-- TODO: "__TMP__" should be a gensym +display image = do + makeWindow "__TMP__" + showImage "__TMP__" image + --threadDelay 2000000 + waitKey 0 + destroyWindow "__TMP__" + +--- Lower level interface +{#fun cvNamedWindow as mkWin {withCString* `String', `Int' } -> `()' #} + +makeWindow name = mkWin name 1 + +destroyWindow n = withCString n $ \name -> do + {#call cvDestroyWindow#} name + + +{#fun cvShowImage as showImage + {`String',withGenImage* `Image' } -> `()' #} + +waitKey delay = {#call cvWaitKey#} delay + diff --git a/CV/Histogram.chs b/CV/Histogram.chs new file mode 100644 index 0000000..b4e0aa3 --- /dev/null +++ b/CV/Histogram.chs @@ -0,0 +1,170 @@ +{-#LANGUAGE ForeignFunctionInterface#-} +#include "cvWrapLEO.h" +module CV.Histogram where + +import CV.Image +{#import CV.Image#} + +import Data.List +import Data.Array +import Data.Array.ST +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Ptr +import C2HSTools + +import System.IO.Unsafe + +-- 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) + +values (HGD a) = snd.unzip $ a + +-- This does not make any sense! +cmpUnion a b = sum $ zipWith (max) a b + +cmpIntersect a b = sum $ zipWith min a b + +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) +chiSqr a b = sum $ zipWith (calc) a b + where + calc a b = (a-b)*(a-b) `divide` (a+b) + divide a b | abs(b) > 0.000001 = a/b + | otherwise = 0 + +liftBins op (HGD a) = zip (op bins) values + where (bins,values) = unzip a + +liftValues op (HGD a) = zip bins (op values) + where (bins,values) = unzip a + +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 :: [CDouble] + values :: [CDouble] + (bins,values) = unzip lst + +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) + (fromIntegral binCount) bins + r <- peekArray binCount bins >>= return.map realToFrac + free bins + return r + +simpleGetHistogram img mask start end binCount cumulative = unsafePerformIO $ + withImage img $ \i -> do + bins <- mallocArray binCount + let isCum | cumulative == True = 1 + | cumulative == False = 0 + + case mask of + (Just msk) -> do + mask8 <- (imageTo8Bit msk) + withImage mask8 $ \m -> do + {#call get_histogram#} i m (realToFrac start) (realToFrac end) + isCum (fromIntegral binCount) bins + 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 + + + + +getNormalHistogram bins image = HGD new + where + (HGD lst) = getHistogram bins image + + value :: [CDouble] + bin :: [CDouble] + (bin,value) = unzip lst + new = zip bin $ map (/size) value + size = fromIntegral $ uncurry (*) $ getSize image + +getHistogram :: Int -> Image -> HistogramData CDouble +getHistogram bins image = unsafePerformIO $ do + h <- buildHistogram cbins image + values <- mapM (getBin h) + [0..fromIntegral bins-1] + return.HGD $ + zip [-1,-1+2/(fromIntegral bins)..1] values + where + cbins = fromIntegral bins + + +getHistgramHS bins image = calcHistogram bins $ getAllPixels image + +-- Calculate image histogram from _Floating Point_ Image +calcHistogram :: Int -> [CDouble] -> HistogramData Double +calcHistogram bins pixels = HGD $ map (\(a,b) -> (realToFrac a, b/l)) $ assocs $ accumArray (+) 0 (0,bins) binned + where + l = fromIntegral $ length pixels + bin :: CDouble -> (Int,Double) + bin d = (floor $ (fromIntegral bins) * d,1.0) + binned = map bin pixels + +-- Low level interaface: + +{#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 CDouble +getBin hist bin = withHistogram hist $ \h -> + ({#call getHistValue#} h bin) diff --git a/CV/Image.chs b/CV/Image.chs new file mode 100644 index 0000000..597d489 --- /dev/null +++ b/CV/Image.chs @@ -0,0 +1,232 @@ +{-#LANGUAGE ForeignFunctionInterface, ViewPatterns#-} +#include "cvWrapLeo.h" +module CV.Image where + +import System.Posix.Files +import System.Mem + +import Foreign.C.Types +import Foreign.C.String +import Foreign.ForeignPtr +import Foreign.Ptr +import Control.Parallel.Strategies + +-- import C2HSTools + +import Data.Maybe(catMaybes) +import Data.List(genericLength) +import Foreign.Marshal.Array +import System.IO.Unsafe + + +{#pointer *IplImage as Image foreign newtype#} + +foreign import ccall "& wrapReleaseImage" releaseImage :: FinalizerPtr Image + +instance NFData Image where + rnf a@(Image fptr) = (unsafeForeignPtrToPtr) fptr `seq` a `seq` ()-- This might also need peek? + + +creatingImage fun = do + iptr <- fun +-- {#call incrImageC#} -- Uncomment this line to get statistics of number of images allocated by ghc + fptr <- newForeignPtr releaseImage iptr + return.Image $ fptr + +unImage (Image fptr) = fptr +composeMultichannelImage :: Maybe Image -> Maybe Image -> Maybe Image -> Maybe Image -> Image +composeMultichannelImage c1 c2 c3 c4 = unsafePerformIO $ do + res <- createImage32F (size) 4 -- TODO: Check channel count + withMaybe c1 $ \cc1 -> + withMaybe c2 $ \cc2 -> + withMaybe c3 $ \cc3 -> + withMaybe c4 $ \cc4 -> + withGenImage res $ \cres -> {#call cvMerge#} cc1 cc2 cc3 cc4 cres + return res + where + withMaybe (Just i) op = withGenImage i op + 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 + +createImage32F (w,h) nChannels = do + creatingImage $ {#call wrapCreateImage32F#} w h nChannels + +createImage64F (w,h) nChannels = do + creatingImage $ {#call wrapCreateImage64F#} w h nChannels + +createImage8U (w,h) nChannels = do + creatingImage $ {#call wrapCreateImage8U#} w h nChannels + +image32F size channels = unsafePerformIO $ createImage32F size channels +image8U size channels = unsafePerformIO $ createImage8U size channels + +emptyCopy img = image32F (getSize img) 1 + +saveImage filename image = do + fpi <- imageTo8Bit image + withCString filename $ \name -> + withGenImage fpi $ \cvArr -> + ({#call cvSaveImage #} name cvArr >> return ()) + +getSize image = unsafePerformIO $ withImage image $ \i -> do + w <- {#call getImageWidth#} i + h <- {#call getImageHeight#} i + return (fromIntegral w,fromIntegral h) + +getArea = uncurry (*).getSize + +getRegion :: (Integral a) => (a, a) -> (a,a) -> Image -> Image +getRegion (fromIntegral -> x,fromIntegral -> y) (fromIntegral -> w,fromIntegral -> h) image + | x+w <= width && y+h <= height = getRegion' (x,y) (w,h) image + | otherwise = error $ "Region outside image:" + ++ show (getSize image) ++ + "/"++show (x+w,y+h) + where + (width,height) = getSize image + +getRegion' (x,y) (w,h) image = unsafePerformIO $ + withImage image $ \i -> + creatingImage ({#call getSubImage#} + i x y w h) + + +-- | Tile images by overlapping them on a black canvas. +tileImages image1 image2 (x,y) = unsafePerformIO $ + withImage image1 $ \i1 -> + withImage image2 $ \i2 -> + creatingImage ({#call simpleMergeImages#} + i1 i2 x y) +-- | Blit image2 onto image1. +--blit image1 image2 (x,y) = +-- withImage image1 $ \i1 -> +-- withImage image2 $ \i2 -> +-- ({#call plainBlit#} i1 i2 x y) +-- TODO: Remove the above +blitFix = blit +blit image1 image2 (x,y) + | badSizes = error $ "Bad blit sizes: " ++ show [(w1,h1),(w2,h2)]++"<-"++show (x,y) + | otherwise = withImage image1 $ \i1 -> + withImage image2 $ \i2 -> + ({#call plainBlit#} i1 i2 y x) + where + ((w1,h1),(w2,h2)) = (getSize image1,getSize image2) + badSizes = x+w2>w1 || y+h2>h1 || x<0 || y<0 +subPixelBlit + :: Image -> Image -> (CDouble, CDouble) -> IO () + +subPixelBlit image1 image2 (x,y) + | badSizes = error $ "Bad blit sizes: " ++ show [(w1,h1),(w2,h2)]++"<-"++show (x,y) + | otherwise = withImage image1 $ \i1 -> + withImage image2 $ \i2 -> + ({#call subpixel_blit#} i1 i2 y x) + where + ((w1,h1),(w2,h2)) = (getSize image1,getSize image2) + badSizes = ceiling x+w2>w1 || ceiling y+h2>h1 || x<0 || y<0 + +safeBlit i1 i2 (x,y) = unsafePerformIO $ do + res <- cloneImage i1-- createImage32F (getSize i1) 1 + blit res i2 (x,y) + return res + +-- | Blit image2 onto image1. +-- This uses an alpha channel bitmap for determining the regions where the image should be "blended" with +-- the base image. +blendBlit image1 image1Alpha image2 image2Alpha (x,y) = + withImage image1 $ \i1 -> + withImage image1Alpha $ \i1a -> + withImage image2Alpha $ \i2a -> + withImage image2 $ \i2 -> + ({#call alphaBlit#} i1 i1a i2 i2a x y) + + +cloneImage img = withGenImage img $ \image -> + creatingImage ({#call cvCloneImage #} image) + +withClone img fun = do + result <- cloneImage img + fun result + return result + +imageTo32F img = withGenImage img $ \image -> + creatingImage + ({#call ensure32F #} image) +imageTo8Bit img = withGenImage img $ \image -> + creatingImage + ({#call ensure8U #} image) +-- Ok. this is just the example why I need image types +withUniPtr with x fun = with x $ \y -> + fun (castPtr y) + +withGenImage = withUniPtr withImage + +-- Manipulating regions of interest: +setROI (x,y) (w,h) image = withImage image $ \i -> + {#call wrapSetImageROI#} i x y w h +resetROI image = withImage image $ \i -> + {#call cvResetImageROI#} i + +setCOI chnl image = withImage image $ \i -> + {#call cvSetImageCOI#} i (fromIntegral chnl) +resetCOI image = withImage image $ \i -> + {#call cvSetImageCOI#} i 0 + +withIOROI pos size image op = do + setROI pos size image + x <- op + resetROI image + return x + +withROI pos size image op = unsafePerformIO $ do + setROI pos size image + let x = op image + resetROI image + return x + +-- Manipulating image pixels +setPixel :: (CInt,CInt) -> CDouble -> Image -> IO () +setPixel (x,y) v image = withGenImage image $ \img -> + {#call wrapSet32F2D#} img y x v + +getPixel :: (CInt,CInt) -> Image -> CDouble +getPixel (x,y) image = unsafePerformIO $ withGenImage image $ \img -> + {#call wrapGet32F2D#} img y x + +getAllPixels image = [getPixel (i,j) image + | i <- [0..width-1 ] + , j <- [0..height-1]] + where + (width,height) = getSize image + +getAllPixelsRowMajor image = [getPixel (i,j) image + | j <- [0..height-1] + , i <- [0..width-1] + ] + where + (width,height) = getSize image + +-- |Create a montage form given images (u,v) determines the layout and space the spacing +-- between images. Images are assumed to be the same size (determined by the first image) +montage :: (Int,Int) -> Int -> [Image] -> Image +montage (u',v') space' imgs = resultPic + where + space = fromIntegral space' + (u,v) = (fromIntegral u', fromIntegral v') + (rw,rh) = (u*xstep,v*ystep) + (w,h) = getSize (head imgs) + (xstep,ystep) = (fromIntegral space + w,fromIntegral space + h) + edge = space`div`2 + resultPic = unsafePerformIO $ do + r <- createImage32F (rw,rh) 1 + sequence_ [blit r i (edge + x*xstep, edge + y*ystep) | y <- [0..v-1] , x <- [0..u-1] | i <- imgs ] + return r + diff --git a/CV/ImageMath.chs b/CV/ImageMath.chs new file mode 100644 index 0000000..ae57a8c --- /dev/null +++ b/CV/ImageMath.chs @@ -0,0 +1,263 @@ +{-#LANGUAGE ForeignFunctionInterface, ScopedTypeVariables#-} +#include "cvWrapLEO.h" +module CV.ImageMath where +import Foreign.C.Types +import Foreign.C.String +import Foreign.ForeignPtr +import Foreign.Ptr + +import CV.Image +import CV.ImageOp + +-- import C2HSTools +{#import CV.Image#} +import Foreign.Marshal +import Foreign.Ptr +import System.IO.Unsafe + +import C2HS + +mkBinaryImageOpIO f = \a -> \b -> + withGenImage a $ \ia -> + withGenImage b $ \ib -> + withClone a $ \clone -> + withGenImage clone $ \cl -> do + f ia ib cl + return clone + +mkBinaryImageOp f = \a -> \b -> unsafePerformIO $ + withGenImage a $ \ia -> + withGenImage b $ \ib -> + withClone a $ \clone -> + withGenImage clone $ \cl -> do + f ia ib cl + return clone + + +-- I just can't think of a proper name for this + -- Friday Evening +abcNullPtr f = \a b c -> f a b c nullPtr + +add = mkBinaryImageOp $ abcNullPtr {#call cvAdd#} +sub = mkBinaryImageOp $ abcNullPtr {#call cvSub#} +subFrom what = ImgOp $ \from -> + withGenImage from $ \ifrom -> + withGenImage what $ \iwhat -> + {#call cvSub#} ifrom iwhat ifrom nullPtr + +logOp = ImgOp $ \i -> withGenImage i (\img -> {#call cvLog#} img img) +log = unsafeOperate logOp + +sqrtOp = ImgOp $ \i -> withGenImage i (\img -> {#call sqrtImage#} img img) +sqrt = unsafeOperate sqrtOp + +limitToOp what = ImgOp $ \from -> + withGenImage from $ \ifrom -> + withGenImage what $ \iwhat -> + {#call cvMin#} ifrom iwhat ifrom + +limitTo x y = unsafeOperate (limitToOp x) y + +mul = mkBinaryImageOp + (\a b c -> {#call cvMul#} a b c 1) + +div = mkBinaryImageOp + (\a b c -> {#call cvDiv#} a b c 1) + +min = mkBinaryImageOp {#call cvMin#} + +max = mkBinaryImageOp {#call cvMax#} + +absDiff = mkBinaryImageOp {#call cvAbsDiff#} + +atan i = unsafePerformIO $ do + let (w,h) = getSize i + res <- createImage32F (w,h) 1 + withImage i $ \s -> + withImage res $ \r -> do + {#call calculateAtan#} s r + return res + + +-- Operation that subtracts image mean from image +subtractMeanAbsOp = ImgOp $ \image -> do + av <- average' image + withGenImage image $ \i -> + {#call wrapAbsDiffS#} i av i + +-- 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 -> + {#call wrapAbsDiffS#} i 0 i + +abs = unsafeOperate absOp + +subtractMeanOp = ImgOp $ \image -> do + let s = CV.ImageMath.sum image + let mean = s / (fromIntegral $ uncurry (*) $ getSize image ) + let (ImgOp subop) = subRSOp mean + subop image + +subRSOp scalar = ImgOp $ \a -> + withGenImage a $ \ia -> do + {#call wrapSubRS#} ia scalar ia +subRS s a= unsafeOperate (subRSOp s) a + +subSOp scalar = ImgOp $ \a -> + withGenImage a $ \ia -> do + {#call wrapSubS#} ia scalar ia + +subS a s = unsafeOperate (subSOp s) a + +-- Multiply the image with scalar +mulSOp :: Double -> ImageOperation +mulSOp scalar = ImgOp $ \a -> + withGenImage a $ \ia -> do + {#call cvConvertScale#} ia ia s 0 + return () + where s = realToFrac scalar + -- I've heard this will lose information +mulS s = unsafeOperate $ mulSOp s + +mkImgScalarOp op scalar = ImgOp $ \a -> + withGenImage a $ \ia -> do + op ia scalar ia + return () + -- where s = realToFrac scalar + -- I've heard this will lose information + +addSOp = mkImgScalarOp $ {#call wrapAddS#} +addS s = unsafeOperate $ addSOp s + +minSOp = mkImgScalarOp $ {#call cvMinS#} +minS s = unsafeOperate $ minSOp s + +maxSOp = mkImgScalarOp $ {#call cvMaxS#} +maxS s = unsafeOperate $ maxSOp s + + +-- Comparison operators +cmpEQ = 0 +cmpGT = 1 +cmpGE = 2 +cmpLT = 3 +cmpLE = 4 +cmpNE = 5 + +mkCmpOp cmp = \scalar a -> unsafePerformIO $ do + withGenImage a $ \ia -> do + new <- createImage8U (getSize a) 1 + withGenImage new $ \cl -> do + {#call cvCmpS#} ia scalar cl cmp + imageTo32F new + +mkCmp2Op cmp = \imgA imgB -> unsafePerformIO $ do + withGenImage imgA $ \ia -> do + withGenImage imgB $ \ib -> do + new <- createImage8U (getSize imgA) 1 + withGenImage new $ \cl -> do + {#call cvCmp#} ia ib cl cmp + imageTo32F new + +-- Is image less than a scalar at all points? +lessThan = mkCmpOp cmpLT +moreThan = mkCmpOp cmpGT + +-- Is image less than another image +less2Than = mkCmp2Op cmpLT +lessEq2Than = mkCmp2Op cmpLE +more2Than = mkCmp2Op cmpGT + +-- Statistics +average' :: Image -> IO CDouble +average' img = withGenImage img $ \image -> + {#call wrapAvg#} image +average = unsafePerformIO.average' + +sum img = unsafePerformIO $ withGenImage img $ \image -> + {#call wrapSum#} image + +averageImages is = ( (1/(fromIntegral $ length is)) `mulS`) (foldl1 add is) + +-- sum img = unsafePerformIO $ withGenImage img $ \image -> +-- {#call wrapSum#} image + +stdDeviation' img = withGenImage img {#call wrapStdDev#} +stdDeviation img = unsafePerformIO $ stdDeviation' img + +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' + { withGenImage* `Image' + , withGenImage* `Image' + , alloca- `Double' peekFloatConv* + , alloca- `Double' peekFloatConv*} + -> `()'#} + +findMinMaxLoc img = unsafePerformIO $ + alloca $ \(ptrintmaxx :: Ptr CInt)-> + alloca $ \(ptrintmaxy :: Ptr CInt)-> + alloca $ \(ptrintminx :: Ptr CInt)-> + alloca $ \(ptrintminy :: Ptr CInt)-> + alloca $ \(ptrintmin :: Ptr CDouble)-> + alloca $ \(ptrintmax :: Ptr CDouble)-> + withImage img $ \cimg -> do { + {#call wrapMinMaxLoc#} cimg ptrintminx ptrintminy ptrintmaxx ptrintmaxy ptrintmin ptrintmax; + minx <- peek ptrintminx; + miny <- peek ptrintminy; + maxx <- peek ptrintmaxx; + maxy <- peek ptrintmaxy; + maxval <- peek ptrintmax; + minval <- peek ptrintmin; + return (((minx,miny),minval),((maxx,maxy),maxval));} + +-- I've got no clue what is supposed to happen below, but I hope it doesn't work.. +-- |DEPRECATED +findMinMax i = unsafePerformIO $ do + nullp <- newForeignPtr_ nullPtr + (findMinMax' i (Image nullp)) + +-- |Find minimum and maximum value of image i in area specified by the mask. +findMinMaxMask i mask = unsafePerformIO (findMinMax' i mask) +-- let a = getAllPixels i in (minimum a,maximum a) + +maxValue = snd.findMinMax +minValue = fst.findMinMax + +-- | Render image of 2D gaussian curve with standard deviation of (stdX,stdY) to image size (w,h) +-- The origin/center of curve is in center of the image +gaussianImage (w,h) (stdX,stdY) = unsafePerformIO $ + let dst = image32F (w,h) 1 + in withImage dst $ \d-> do + {#call render_gaussian#} d (realToFrac stdX) (realToFrac stdY) + return dst + +-- | Produce white image with 'edgeW' amount of edges fading to black +fadedEdgeImage (w,h) edgeW = unsafePerformIO $ creatingImage ({#call fadedEdges#} w h edgeW) + +-- | Produce image where pixel is coloured according to distance from the edge +fadeToCenter (w,h) = unsafePerformIO $ creatingImage ({#call rectangularDistance#} w h ) + +-- | Merge two images according to a mask. Result R is R = A*m+B*(m-1) . +maskedMerge mask img img2 = unsafePerformIO $ do + let res = image32F (getSize img) 1 + withImage img $ \cimg -> + withImage img2 $ \cimg2 -> + withImage res $ \cres -> + withImage mask $ \cmask -> + {#call masked_merge#} cimg cmask cimg2 cres + return res + + + diff --git a/CV/ImageMathOp.hs b/CV/ImageMathOp.hs new file mode 100644 index 0000000..7d347ca --- /dev/null +++ b/CV/ImageMathOp.hs @@ -0,0 +1,17 @@ +module CV.ImageMathOp where +import CV.Image +import CV.ImageMath as IM +import Data.List(iterate) + +(#+) = IM.add +(#-) = IM.sub +(#*) = IM.mul +(|*) = IM.mulS +(|+) = IM.addS +(|-) = IM.subS +(-|) = IM.subRS +(#<) = IM.less2Than +(#>) = IM.more2Than +(|>) = IM.moreThan +(|<) = IM.lessThan +(|^) i n = (iterate (#* i) i) !! (n-1) diff --git a/CV/ImageOp.hs b/CV/ImageOp.hs new file mode 100644 index 0000000..fb4f42f --- /dev/null +++ b/CV/ImageOp.hs @@ -0,0 +1,30 @@ +module CV.ImageOp where + +import Foreign +import CV.Image + +-- Testing how to handle operation sequences without +-- copying image for each operation. +newtype ImageOperation = ImgOp (Image -> IO ()) +(#>) :: ImageOperation -> ImageOperation -> ImageOperation +(#>) (ImgOp a) (ImgOp b) = ImgOp (\img -> (a img >> b img)) +nonOp = ImgOp (\i -> return ()) + +img <# op = unsafeOperate op img +img <## op = unsafeOperate (foldl1 (#>) op) img + +times n op = foldl (#>) nonOp (replicate n op) + +-- This could, if I take enough care, be pure. +runImageOperation :: Image -> ImageOperation -> IO Image +runImageOperation img (ImgOp op) = withClone img $ \clone -> + op clone >> return clone + +directOp i (ImgOp op) = op i +operate op img = runImageOperation img op +operateOn = runImageOperation +unsafeOperate op img = unsafePerformIO $ operate op img +unsafeOperateOn img op = unsafePerformIO $ operate op img + +operateWithROI pos size (ImgOp op) img = withClone img $ \clone -> + withIOROI pos size clone (op clone) diff --git a/CV/LightBalance.chs b/CV/LightBalance.chs new file mode 100644 index 0000000..5a36bba --- /dev/null +++ b/CV/LightBalance.chs @@ -0,0 +1,17 @@ +{-#LANGUAGE ForeignFunctionInterface#-} +#include "cvWrapLEO.h" +module CV.LightBalance where + +import Foreign.C.Types +import Foreign.Ptr + +import C2HSTools +{#import CV.Image#} + +x2cylinder (w,h) m s c = unsafePerformIO $ creatingImage ({#call vignettingModelX2Cyl#} w h + (realToFrac m) (realToFrac s) (realToFrac c)) +cos4cylinder (w,h) = unsafePerformIO $ creatingImage ({#call vignettingModelCos4XCyl#} w h) +cos4vignetting (w,h) = unsafePerformIO $ creatingImage ({#call vignettingModelCos4#} w h) +threeB (w,h) b1 b2 b3 = unsafePerformIO $ creatingImage ({#call vignettingModelB3#} w h b1 b2 b3) +twoPar (w,h) sx sy m = unsafePerformIO $ creatingImage ({#call vignettingModelP#} w h sx sy m) + diff --git a/CV/Marking.hs b/CV/Marking.hs new file mode 100644 index 0000000..208bbc1 --- /dev/null +++ b/CV/Marking.hs @@ -0,0 +1,62 @@ +module CV.Marking where + +import CV.Image as Image +import CV.Morphology +import CV.Edges as Edges +import CV.ImageOp as ImageOp +import CV.Sampling +import qualified CV.ImageMath as IM +import CV.Drawing +import CV.ColourUtils +import Foreign.C.Types +import CV.ImageMathOp + + + +-- For easy marking of detected flaws +boxFlaws i = Edges.laplace 1 $ dilate basicSE 5 (i) +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 1 + + +type Marker = (CInt,CInt) -> CDouble -> (CInt,CInt) + -> ImageOperation + +condMarker condition m size t place = if condition t + then m size t place + else nonOp + +getCoordsForMarkedTiles tileSize overlap marks image = + map fst $ filter (snd) $ zip coords marks + where + coords = getOverlappedTileCoords tileSize overlap image + +cuteDot (x,y) = + circleOp + (x,y) (w*2) 0.1 (Stroked 1) ImageOp.#> circleOp (x,y) (w*2-1) 0.9 (Stroked 1) + where w = 2 + +cuteCircle1 (x,y) = + circleOp + (x+w,y+w) (w*2) 0.1 (Stroked 1) ImageOp.#> circleOp (x+w,y+w) (w*2-1) 0.9 (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) + +cuteCircle :: Marker +cuteCircle (tw,th) t (x,y) = + (circleOp + (x+tw`div`2,y+tw`div`2) (w) 0.1 (Stroked 1) ) ImageOp.#> circleOp (x+tw`div`2,y+tw`div`2) (w-1) 0.9 (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 + + diff --git a/CV/Morphology.chs b/CV/Morphology.chs new file mode 100644 index 0000000..824a8f3 --- /dev/null +++ b/CV/Morphology.chs @@ -0,0 +1,131 @@ +{-#LANGUAGE ForeignFunctionInterface, ScopedTypeVariables#-} +#include "cvWrapLEO.h" +module CV.Morphology (StructuringElement + ,structuringElement + ,customSE + ,basicSE,bigSE + ,geodesic + ,openOp,closeOp + ,open,close + ,erode,dilate + ,blackTopHat,whiteTopHat + ,dilateOp,erodeOp,ellipseShape + ,crossShape,rectShape) +where + +import Foreign.C.Types +import Foreign.C.String +import Foreign.ForeignPtr +import Foreign.Ptr +import Foreign.Marshal.Array + +import CV.Image + +import CV.ImageOp +import qualified CV.ImageMath as IM + +import C2HSTools + +-- Morphological opening +openOp :: StructuringElement -> ImageOperation +openOp se = erodeOp se 1 #> dilateOp se 1 +open se = unsafeOperate (openOp se) +-- Morphological closing +closeOp :: StructuringElement -> ImageOperation +closeOp se = dilateOp se 1 #> erodeOp se 1 +close se = unsafeOperate (closeOp se) + +geodesic :: Image -> ImageOperation -> ImageOperation +geodesic mask op = op #> IM.limitToOp mask + +blackTopHat size i = unsafePerformIO $ do + let se = structuringElement + (size,size) (size `div` 2, size `div` 2) rectShape + x <- runImageOperation i (closeOp se) + return $ x `IM.sub` i + +whiteTopHat size i = unsafePerformIO $ do + let se = structuringElement + (size,size) (size `div` 2, size `div` 2) rectShape + x <- runImageOperation i (openOp se) + return $ i `IM.sub` x + +basicSE = structuringElement (3,3) (1,1) rectShape +bigSE = structuringElement (9,9) (4,4) rectShape + +---------- Low level wrapper +rectShape = 0 +crossShape = 1 +ellipseShape = 2 +customShape = 100 + +{#pointer *IplConvKernel as ConvKernel foreign newtype#} + +type StructuringElement = ConvKernel + +foreign import ccall "& wrapReleaseStructuringElement" + releaseSE :: FinalizerPtr ConvKernel + + +-- Check morphology element +isGoodSE s@(w,h) d@(x,y) | x>=0 && y>=0 + && w>=0 && h>=0 + && x + {#call cvCreateStructuringElementEx#} + w h x y (fromIntegral customShape) arr + fptr <- newForeignPtr releaseSE iptr + return (ConvKernel fptr) + +{#fun cvErode as erosion + {withGenImage* `Image' + ,withGenImage* `Image' + ,withConvKernel* `ConvKernel' + ,`Int'} -> `()' #} +{#fun cvDilate as dilation + {withGenImage* `Image' + ,withGenImage* `Image' + ,withConvKernel* `ConvKernel' + ,`Int'} -> `()' #} + + + +erodeOp se count = ImgOp $ \img -> erosion img img se count +dilateOp se count = ImgOp $ \img -> dilation img img se count + +erode se count i = unsafeOperate (erodeOp se count) i +dilate se count i = unsafeOperate (dilateOp se count) i + + +erode' se count img = withImage img $ \image -> + withConvKernel se $ \ck -> + {#call cvErode#} (castPtr image) + (castPtr image) + ck count + +dilate' se count img = withImage img $ \image -> + withConvKernel se $ \ck -> + {#call cvDilate#} (castPtr image) + (castPtr image) + ck count diff --git a/CV/MultiresolutionSpline.hs b/CV/MultiresolutionSpline.hs new file mode 100644 index 0000000..578140e --- /dev/null +++ b/CV/MultiresolutionSpline.hs @@ -0,0 +1,44 @@ +module CV.MultiresolutionSpline where + +import CV.Image +import qualified CV.ImageMath as IM +import CV.Transforms +import CV.ImageMathOp +import CV.Filters + + +-- stitchHalfAndHalf i1 i2 = montage (2,1) 0 [getRegion (0,0) (hw,dh) i1,getRegion (hw,0) (hw,dh) i2] +-- where +-- dh = h +-- (w,h) = getSize i1 +-- (hw,hh) = (w`div`2,h`div`2) + +-- | Do a burt-adelson multiresolution splining for two images. +-- Areas marked as 1 in mask are +burtAdelsonMerge levels mask img1 img2 + | badSize = error $ "BAMerge: Images have a bad size. Not divisible by "++show divisor ++" "++show sizes + | otherwise = reconstructFromLaplacian pyrMerge + where + divisor = 2^levels + notDivisible x = x`mod`(divisor) /= 0 + sizes = map getSize [mask,img1,img2] + badSize = any (\(x,y) -> notDivisible x || notDivisible y) sizes + maskPyr = reverse $ take levels $ iterate pyrDown $ blur (3,3) mask + pyr = laplacianPyramid levels img1 + pyr2 = laplacianPyramid levels img2 + pyrMerge = zipWith3 IM.maskedMerge maskPyr pyr2 pyr + +-- | Another Burt-Adelson spline. Since OpenCV:s pyramids are inflexible, this one does without +-- Naturally, this is much more inefficient and must be seen as stop-gap solution for splining +-- arbitrary size images. Does not work, btw. + +burtAdelsonMerge2 levels mask img1 img2 = foldl1 (#+) pyrMerge + where + g = gaussian (25,25) + fakeLaplacian gpyr = zipWith (#-) gpyr (tail gpyr) ++ last [gpyr] + maskPyr = take levels $ iterate g mask + gpyr1 = take levels . iterate g $ img1 + gpyr2 = take levels . iterate g $ img2 + pyrMerge = zipWith3 IM.maskedMerge maskPyr (fakeLaplacian gpyr2) (fakeLaplacian gpyr1) + + diff --git a/CV/PatternRemover.hs b/CV/PatternRemover.hs new file mode 100644 index 0000000..b532cda --- /dev/null +++ b/CV/PatternRemover.hs @@ -0,0 +1,34 @@ +module CV.PatternRemover where +import CV.Image +import CV.Transforms +import CV.ColourUtils +import qualified CV.ImageMath as IM +import CV.ImageMathOp + +import CV.Filters +import CV.Thresholding +import CV.Drawing +import CV.Morphology + +-- Remove pattern creates a filter that will remove regular patterns +-- from images. The assumption is that the image is, for practical +-- purposes, homogenous and contains slight texture which is undesired. +-- For sellu series: removePattern 7 13 50 0.6 $ getRegion (0,0) (304,304) x +-- Parameters: +-- Smoothing size, spike size, minimum filtered frequency, amount of +-- removal, image +designFilter s2 min w img = filter + where + ci = dct img + filter = circle (0,0) min 0 Filled filter' + filter' = dilate basicSE 2 $ nibbly w 0.00001 $ + gaussian (s2,s2) $ IM.log ci -- #- ci + + +removePattern s1 s2 min w img = idct (ci #* IM.invert filter) + where + ci = dct img + filter = circle (0,0) min 0 Filled filter' + filter' = gaussian (s1,s1) $ dilate basicSE 2 $ nibbly w 0.00001 + ci #- gaussian (s2,s2) ci + diff --git a/CV/Sampling.hs b/CV/Sampling.hs new file mode 100644 index 0000000..c4a53b2 --- /dev/null +++ b/CV/Sampling.hs @@ -0,0 +1,116 @@ +module CV.Sampling where + +import CV.Image +import System.Random +import Control.Monad + +import Foreign.C.Types +import qualified CV.ImageMath as IM +import Data.List(partition) +import Utils.MonadRandom + +-- Get a patch around every pixel of given size for which it is +-- attainable (Enough far from edge) +allPatches size image = [getRegion (x,y) size image + | x <- [0..w-1], y <- [0..h-1]] + where + (wi,hi) = getSize image + (wp,hp) = size + (w,h) = (wi-wp,hi-hp) + +allButLast = reverse.tail.reverse +-- Get all non-overlapping patches of image +getTiles size image = getOverlappedTiles size (0,0) image + +-- Get Coordinates for overlapping tiles +getOverlappedTileCoords size (xover,yover) image + = [(x,y) + | x <- [0,wstep..wi-w-1] + , y <- [0,hstep..hi-h-1]] + where + (w,h) = size + (wi,hi) = getSize image + (wstep,hstep) = (floor $ fromIntegral w*(1-xover) + ,floor $ fromIntegral h*(1-yover)) + +-- Get overlapping tiles +getOverlappedTiles :: (CInt,CInt) -> (CDouble,CDouble) -> Image -> [Image] +getOverlappedTiles size overlap image + = map (\c -> getRegion c size image) + $ getOverlappedTileCoords size + overlap image + +getMarkedAndUnmarkedTiles size overlap image marks = + (map fst markedTiles,map fst nonMarked) + where + samples = getOverlappedTiles size overlap image + marked = getOverlappedTiles size overlap marks + ismarked (_,m) = IM.maxValue m > 0.9 + (markedTiles,nonMarked) = partition ismarked + $ zip samples marked + + +-- get patches of image at `coords` +getPatches size coords image = map (\c -> getRegion c size image) coords + +getCenteredPatches size coords image = map (\c -> getRegion (adjust c) + size image) + coords + where + (w,h) = size + adjust (x,y) = (x-w`div`2 + ,y-h`div`2) + +-- Make a random selections in IO monad +randomSelect lst = randomRIO (0,length lst -1) >>= \x -> + return (lst !! x) + +select k lst = sequence $ replicate k (randomSelect lst) + +-- Discard coords around image borders. Useful for safely picking patches +discardAroundEdges (iw,ih) (vb,hb) coords = filter inRange coords + where + inRange (x,y) = vb0.9, arbitarily) of +-- image `marks` +getCoordsFromMarks marks = [(x,y) | x <- [0..w-1] + , y <- [0..h-1] + , getPixel (x,y) marks >0.9] + where (w,h) = getSize marks + +getMarkedPatches size source marks + | getSize source == getSize marks = getPatches size coords source + | otherwise = error "Image sizes mismatch" + where coords = getCoordsFromMarks marks + + +-- Get some random image patches +randomPatches size count image = do + coords <- replicateM count $ randomCoord (w,h) + return $ getPatches size coords image + where + (pwidth,pheight) = size + (iwidth,iheight) = getSize image + (w,h) = (iwidth - pwidth , iheight-pheight) + +-- Get some random pixels from image +randomPixels count image = do + coords <- replicateM count $ randomCoord size + return $ map (flip getPixel $ image) $ coords + where + size = getSize image + +-- Get some random coords from image +randomCoords :: MonadRandom m => Int -> (CInt,CInt) -> m [(CInt,CInt)] +randomCoords count area = replicateM count $ randomCoord area + +randomCoord :: MonadRandom m => (CInt,CInt) -> m (CInt,CInt) +randomCoord (w,h) = do + x <- (getRandomR (0::Int,fromIntegral $ w-1)) + >>= return.fromIntegral + y <- (getRandomR (0::Int,fromIntegral $ h-1)) + >>= return.fromIntegral + return (x,y) diff --git a/CV/TemplateMatching.chs b/CV/TemplateMatching.chs new file mode 100644 index 0000000..33a3263 --- /dev/null +++ b/CV/TemplateMatching.chs @@ -0,0 +1,76 @@ +{-#LANGUAGE ForeignFunctionInterface, ScopedTypeVariables#-} +#include "cvWrapLEO.h" +module CV.TemplateMatching where + +import Foreign.C.Types +import Foreign.Ptr + +import CV.Image +import CV.Transforms + +import Utils.Function +import Utils.Point +import Utils.Rectangle + +{#import CV.Image#} +import C2HSTools + +getTemplateMap image template = unsafePerformIO $ + withImage image $ \cvimg -> + withImage template $ \cvtemp -> + creatingImage $ {#call templateImage#} cvimg cvtemp + + +-- TODO: Make this somehow smarter #PotentialDanger +data MatchType = CV_TM_SQDIFF | CV_TM_SQDIFF_NORMED | CV_TM_CCORR + | CV_TM_CCORR_NORMED | CV_TM_CCOEFF | CV_TM_CCOEFF_NORMED + deriving (Eq,Show,Enum) + + +simpleTemplateMatch :: MatchType -> Image -> Image -> ((CInt,CInt),Double) +simpleTemplateMatch mt image template + = unsafePerformIO $ do + withImage image $ \cvimg -> + withImage template $ \cvtemp -> + alloca $ \(ptrintx :: Ptr CInt) -> + alloca $ \(ptrinty :: Ptr CInt)-> + alloca $ \(ptrdblval :: Ptr CDouble) -> do { + {#call simpleMatchTemplate#} cvimg cvtemp ptrintx ptrinty ptrdblval (fromIntegral $ fromEnum mt); + x <- peek ptrintx; + y <- peek ptrinty; + v <- peek ptrdblval; + return ((x,y),realToFrac v); } + +matchTemplate :: MatchType-> Image -> Image -> Image +matchTemplate mt image template = unsafePerformIO $ do + let isize = getSize image + tsize = getSize template + size = isize - tsize + (1,1) + res <- createImage32F size 1 + withGenImage image $ \cimg -> + withGenImage template $ \ctempl -> + withGenImage res $ \cresult -> + {#call cvMatchTemplate#} cimg ctempl cresult (fromIntegral . fromEnum $ mt) + return res + + +-- | Perform subpixel template matching using intensity interpolation +-- TODO: CDouble to Double #CleanUp +subPixelTemplateMatch :: MatchType -> Image -> Image -> CDouble -> (CDouble,CDouble) +subPixelTemplateMatch mt image template n -- TODO: Make iterative #SpeedUp + = (fromIntegral (tx)+fromIntegral sbx/n + ,fromIntegral (ty)+fromIntegral sby/n) + where + (otw,oth) = getSize template + ((orX,orY),_) = simpleTemplateMatch CV_TM_CCORR_NORMED image template + (tx,ty) = (orX-otw`div`2, orY-oth`div`2) + + bigTempl = scale Linear n template + (tw,th) = getSize bigTempl + region = scale Linear n . getRegion (tx,ty) (otw*2,oth*2) $ image + ((sbx,sby),_) = simpleTemplateMatch CV_TM_CCORR_NORMED region bigTempl + +regionToInt rec = mkRectangle (floor x,floor y) (ceiling w,ceiling h) + where + (x,y) = topLeft rec + (w,h) = rSize rec diff --git a/CV/Textures.chs b/CV/Textures.chs new file mode 100644 index 0000000..31b6e08 --- /dev/null +++ b/CV/Textures.chs @@ -0,0 +1,43 @@ +{-#LANGUAGE ForeignFunctionInterface#-} +#include "cvWrapLEO.h" +module CV.Textures where + +import Foreign.C.Types +import Foreign.C.String +import Foreign.ForeignPtr +import Foreign.Ptr +import Foreign.Marshal.Array + +import CV.Image +import CV.ImageOp + +import C2HSTools +{#import CV.Image#} + +emptyPattern :: [CInt] +emptyPattern = replicate 256 0 +broilerPlate op image = unsafePerformIO $ do + withGenImage image $ \img -> + withArray emptyPattern $ \ptrn -> do + (op img ptrn ) + p <- peekArray 256 ptrn + let !maximum = fromIntegral $ sum p + return $ map (\x -> fromIntegral x / maximum) p + +lbp = broilerPlate ({#call localBinaryPattern#}) + +lbp3 = broilerPlate ({#call localBinaryPattern3#}) +lbp5 = broilerPlate ({#call localBinaryPattern5#}) +lbpHorizontal = broilerPlate + ({#call localHorizontalBinaryPattern#}) +lbpVertical = broilerPlate + ({#call localVerticalBinaryPattern#}) + +-- LBP with weights and adjustable sampling points +weightedLBP offsetX offsetXY weights image = unsafePerformIO $ do + withGenImage image $ \img -> + withGenImage weights $ \ws -> + withArray (replicate 256 0) $ \ptrn -> do + {#call weighted_localBinaryPattern#} img (fromIntegral offsetX) (fromIntegral offsetXY) ws ptrn + p <- peekArray 256 ptrn + return p diff --git a/CV/Thresholding.hs b/CV/Thresholding.hs new file mode 100644 index 0000000..3843bda --- /dev/null +++ b/CV/Thresholding.hs @@ -0,0 +1,75 @@ +module CV.Thresholding +where +import CV.Image +import CV.Filters +import qualified CV.ImageMath as IM +import CV.ImageMathOp +import CV.Morphology +import System.IO.Unsafe +import CV.Sampling +import Utils.List +import Data.List +import CV.Histogram + + +bernsen (w,h) c i = goodContrast #* (i #< surface) + where + low = erode se 1 i + high = dilate se 1 i + goodContrast = IM.moreThan c (high #- low) + surface = 0.5 |* (high #+ low) + se = structuringElement (w,h) (w`div`2,h`div`2) ellipseShape + +-- Very slow implementation of niblack thresholding +--niblack (w,h) k i = IM.more2Than trunc (unsafePerformIO $ surface) +-- where +-- trunc = getRegion (w`div`2,h`div`2) (wi-w,hi-h) i +-- (wi,hi) = getSize i +-- surface = renderFlatList (wi-w,hi-h) (map th patches) +-- th ptch = IM.average ptch + k * IM.stdDeviation ptch +-- patches = allPatches (w,h) i + +nibbly k c i = let dev = IM.stdDeviation i + mean = IM.average i + in IM.moreThan (mean+k*dev+c) i + +nibblyr (w,h) k i = IM.lessThan t flat + where + t = IM.average flat + k * IM.stdDeviation flat + flat = i #- gaussian (w,h) i + + +otsu bs image = IM.moreThan 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 +kittler precision image = IM.moreThan t image + where t = maximumBy (comparing (kittlerMeasure image)) + [0,0+precision..1] + +kittlerMeasure image t = unNaN $ + p_t*log fgDev + + (1-p_t)*log bgDev + - p_t*log p_t + - (1-p_t)*log(1-p_t) + where + unNaN x | isNaN x = -10000000 + | otherwise = x + thresholded = (IM.lessThan t image) + p_t = IM.sum thresholded / fromIntegral (getArea image) + bgDev = IM.stdDeviationMask image thresholded + fgDev = 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) + +betweenClassVariance as bs = sum as * sum bs + * (average bs - average as)^2 + diff --git a/CV/Transforms.chs b/CV/Transforms.chs new file mode 100644 index 0000000..c3d11a0 --- /dev/null +++ b/CV/Transforms.chs @@ -0,0 +1,207 @@ +{-#LANGUAGE ForeignFunctionInterface, ViewPatterns, ScopedTypeVariables#-} +#include "cvWrapLEO.h" +module CV.Transforms where + +import CV.Image +import Foreign.Ptr +import Foreign.C.Types +import Foreign.Marshal.Array +import System.IO.Unsafe +{#import CV.Image#} +import CV.ImageMathOp + +-- Since DCT is valid only for even sized images, we provide a +-- function to crop images to even sizes. +takeEvenSized img = getRegion (0,0) (w-wadjust,h-hadjust) img + where + (w,h) = getSize img + hadjust | odd h = 1 + | otherwise = 2 + wadjust | odd w = 1 + | otherwise = 2 + +-- Perform Discrete Cosine Transform +dct img | (x,y) <- getSize img, even x && even y + = unsafePerformIO $ + withGenImage img $ \i -> + withClone img $ \c' -> + withGenImage c' $ \c -> + ({#call cvDCT#} i c 0) + | otherwise = error "DCT needs even sized image" + +idct img | (x,y) <- getSize img, even x && even y + = unsafePerformIO $ + withGenImage img $ \i -> + withClone img $ \c' -> + withGenImage c' $ \c -> + ({#call cvDCT#} i c 1) + | otherwise = error "IDCT needs even sized image" + +data MirrorAxis = Vertical | Horizontal deriving (Show,Eq) + +flip axis img = unsafePerformIO $ do + let cl = emptyCopy img + withGenImage img $ \cimg -> + withGenImage cl $ \ccl -> do + {#call cvFlip#} cimg ccl (if axis == Vertical then 0 else 1) + return cl + +-- Rotate `img` `angle` radians. +rotate angle img = unsafePerformIO $ + withImage img $ \i -> + creatingImage + ({#call rotateImage#} i 1 angle) + +data Interpolation = NearestNeighbour | Linear + | Area | Cubic + deriving (Eq,Ord,Enum,Show) + +radialDistort img k = unsafePerformIO $ do + target <- createImage32F (getSize img) 1 + withImage img $ \cimg -> + withImage target $ \ctarget -> + {#call radialRemap#} cimg ctarget k + return target + +scale :: (RealFloat a) => Interpolation -> a -> Image -> Image +scale tpe size img = unsafePerformIO $ do + target <- createImage32F (w',h') 1 + withGenImage img $ \i -> + withGenImage target $ \t -> + {#call cvResize#} i t + (fromIntegral.fromEnum $ tpe) + return target + where + (w,h) = getSize img + (w',h') = (round $ fromIntegral w*size + ,round $ fromIntegral h*size) + +scaleToSize :: Interpolation -> Bool -> (CInt,CInt) -> Image -> Image +scaleToSize tpe retainRatio (w,h) img = unsafePerformIO $ do + target <- createImage32F (w',h') 1 + withGenImage img $ \i -> + withGenImage target $ \t -> + {#call cvResize#} i t + (fromIntegral.fromEnum $ tpe) + return target + where + (ow,oh) = getSize img + (w',h') = if retainRatio + then (floor $ fromIntegral ow*ratio,floor $ fromIntegral oh*ratio) + else (w,h) + ratio = max (fromIntegral w/fromIntegral ow) + (fromIntegral h/fromIntegral oh) + +oneParamPerspective img k + = unsafePerformIO $ + withImage img $ \cimg -> creatingImage $ {#call simplePerspective#} k cimg + +perspectiveTransform img (map realToFrac -> [a1,a2,a3,a4,a5,a6,a7,a8,a9]) + = unsafePerformIO $ + withImage img $ \cimg -> creatingImage $ {#call wrapPerspective#} cimg a1 a2 a3 a4 a5 a6 a7 a8 a9 + + +getHomography srcPts dstPts = + unsafePerformIO $ withArray src $ \c_src -> + withArray dst $ \c_dst -> + allocaArray (3*3) $ \c_hmg -> do + {#call findHomography#} c_src c_dst (fromIntegral $ length srcPts) c_hmg + peekArray (3*3) c_hmg + where + flatten = concatMap (\(a,b) -> [a,b]) + src = flatten srcPts + dst = flatten dstPts + + +--- Pyramid transforms +evenize img = if (odd w || odd h) + then + unsafePerformIO $ + creatingImage $ + withGenImage img $ \cImg -> {#call makeEvenUp#} cImg + else img + where + (w,h) = getSize img + +oddize img = if (even w || even h) + then + unsafePerformIO $ + creatingImage $ + withGenImage img $ \cImg -> {#call padUp#} cImg (toI $ even w) (toI $ even h) + else img + where + toI True = 1 + toI False = 0 + (w,h) = getSize img + +sameSizePad img img2 = if (size1 /= size2) + then unsafePerformIO $ do + r <- creatingImage $ + withGenImage img2 $ \cImg -> {#call padUp#} cImg (toI $ w2 Image +pyrDown image = unsafePerformIO $ do + let res = image32F size 1 + withGenImage image $ \cImg -> + withGenImage res $ \cResImg -> + {#call cvPyrDown#} cImg cResImg cv_Gaussian + return res + where + size = (x`div`2,y`div`2) + (x,y) = getSize image + +pyrUp :: Image -> Image +pyrUp image = unsafePerformIO $ do + let res = image32F size 1 + withGenImage image $ \cImg -> + withGenImage res $ \cResImg -> + {#call cvPyrUp#} cImg cResImg cv_Gaussian + return res + where + size = (x*2,y*2) + (x,y) = getSize image + + +-- TODO: For additional efficiency, make this so that pyrDown result is directly put into +-- proper size image which is then padded +safePyrDown img = evenize result + where + result = pyrDown img + (w,h) = getSize result + +laplacianPyramid :: Int -> Image -> [Image] +laplacianPyramid depth image = reverse laplacian + where + downs :: [Image] = take depth $ iterate pyrDown (image) + upsampled :: [Image] = map pyrUp (tail downs) + laplacian = zipWith (#-) downs upsampled ++ [last downs] + +-- | Reconstruct an image from a laplacian pyramid +reconstructFromLaplacian pyramid = foldl1 (\a b -> (pyrUp a) #+ b) (pyramid) + -- where + -- safeAdd x y = sameSizePad y x #+ y + +-- | Enlarge image so, that it's size is divisible by 2^n +enlarge n img = unsafePerformIO $ do + i <- (createImage32F (w2,h2) 1) + blit i img (0,0) + return i + where + (w,h) = getSize img + (w2,h2) = (pad w, pad h) + pad x = x + (np - x `mod` np) + np = 2^n + + diff --git a/CV/cvWrapLEO.c b/CV/cvWrapLEO.c new file mode 100644 index 0000000..1145e60 --- /dev/null +++ b/CV/cvWrapLEO.c @@ -0,0 +1,2162 @@ +//@+leo-ver=4-thin +//@+node:aleator.20050908100314:@thin cvWrapLEO.c +//@@language c + +//@+all +//@+node:aleator.20050908100314.1:Includes +#include "cvWrapLEO.h" +#include +#include + +//@-node:aleator.20050908100314.1:Includes +//@+node:aleator.20050908100314.2:Wrappers + +size_t images; + +void incrImageC(void) +{ + images++; +} + +void wrapReleaseImage(IplImage *t) +{ + // printf("%d ",images); + cvReleaseImage(&t); + images--; +} + +void wrapReleaseStructuringElement(IplConvKernel *t) +{ + cvReleaseStructuringElement(&t); +} + +IplImage* wrapLaplace(IplImage *src,int size) +{ +IplImage *res; +IplImage *tmp; +tmp = cvCreateImage(cvGetSize(src),IPL_DEPTH_16S,1); +res = cvCreateImage(cvGetSize(src),IPL_DEPTH_8U,1); +cvLaplace(src,tmp,size); +cvConvertScale(tmp,res,1,0); +return res; +} + +IplImage* wrapSobel(IplImage *src,int dx + ,int dy,int size) +{ +IplImage *res; +IplImage *tmp; +tmp = cvCreateImage(cvGetSize(src),IPL_DEPTH_16S,1); +res = cvCreateImage(cvGetSize(src),IPL_DEPTH_8U,1); +cvSobel(src,tmp,dx,dy,size); +cvConvertScale(tmp,res,1,0); +cvReleaseImage(&tmp); +return res; +} + +IplImage* wrapCreateImage32F(const int width + ,const int height + ,const int channels) +{ + CvSize s; + IplImage *r; + s.width = width; s.height = height; + r = cvCreateImage(s,IPL_DEPTH_32F,channels); + cvSetZero(r); + return r; +} + +IplImage* wrapCreateImage64F(const int width + ,const int height + ,const int channels) +{ + CvSize s; + IplImage *r; + s.width = width; s.height = height; + r = cvCreateImage(s,IPL_DEPTH_64F,channels); + cvSetZero(r); + return r; +} + + +IplImage* wrapCreateImage8U(const int width + ,const int height + ,const int channels) +{ + CvSize s; + IplImage *r; + s.width = width; s.height = height; + r = cvCreateImage(s,IPL_DEPTH_8U,channels); + cvSetZero(r); + return r; +} + +IplImage* composeMultiChannel(IplImage* img0 + ,IplImage* img1 + ,IplImage* img2 + ,IplImage* img3 + ,const int channels) +{ + CvSize s; + IplImage *r; + s = cvGetSize(img0); + r = cvCreateImage(s,img0->depth,channels); + cvSetZero(r); + cvMerge(img0,img1,img2,img3,r); + return r; +} +void wrapSubRS(const CvArr *src, double s, CvArr *dst) +{ + cvSubRS(src,cvRealScalar(s),dst,0); +} + +void wrapSubS(const CvArr *src, double s, CvArr *dst) +{ + cvSubS(src,cvRealScalar(s),dst,0); +} + +void wrapAddS(const CvArr *src, double s, CvArr *dst) +{ + cvAddS(src,cvRealScalar(s),dst,0); +} + +void wrapAbsDiffS(const CvArr *src, double s, CvArr *dst) +{ + cvAbsDiffS(src,dst,cvScalarAll(s)); +} + +double wrapAvg(const CvArr *src) +{ + CvScalar avg = cvAvg(src,0); + return avg.val[0]; +} + +double wrapStdDev(const CvArr *src) +{ + CvScalar dev; + cvAvgSdv(src,0,&dev,0); + return dev.val[0]; +} + +double wrapStdDevMask(const CvArr *src,const CvArr *mask) +{ + CvScalar dev; + IplImage *mask8 = ensure8U(mask); + cvAvgSdv(src,0,&dev,mask8); + cvReleaseImage(&mask8); + return dev.val[0]; +} +double wrapMeanMask(const CvArr *src,const CvArr *mask) +{ + CvScalar mean; + IplImage *mask8 = ensure8U(mask); + cvAvgSdv(src,&mean,0,mask8); + cvReleaseImage(&mask8); + return mean.val[0]; +} + +double wrapSum(const CvArr *src) +{ + CvScalar sum = cvSum(src); + return sum.val[0]; +} + +void wrapMinMax(const CvArr *src,const CvArr *mask + ,double *minVal, double *maxVal) +{ + //cvMinMaxLoc(src,minVal,maxVal,NULL,NULL,NULL); + int i,j; + int minx,miny,maxx,maxy; + double pixel; + double maskP; + int t; + double min=100000,max=-100000; // Some problem with DBL_MIN. + + CvSize s = cvGetSize(src); + for(i=0; i0.5 ) && (pixel < min) ? pixel : min; + max = (maskP >0.5 ) && (pixel > max) ? pixel : max; + } + (*minVal) = min; (*maxVal) = max; +} + +void wrapSetImageROI(IplImage *i,int x, int y, int w, int h) +{ + CvRect r = cvRect(x,y,w,h); + cvSetImageROI(i,r); +} + + +// Return image that is IPL_DEPTH_8U version of +// given src +IplImage* ensure8U(const IplImage *src) +{ + CvSize size; + IplImage *result; + int channels = src->nChannels; + int dstDepth = IPL_DEPTH_8U; + size = cvGetSize(src); + result = cvCreateImage(size,dstDepth,channels); + + switch(src->depth) { + case IPL_DEPTH_32F: + case IPL_DEPTH_64F: + cvConvertScale(src,result,255.0,0); // Scale the values to [0,255] + return result; + case IPL_DEPTH_8U: + cvConvertScale(src,result,1,0); + return result; + default: + printf("Cannot convert to floating image"); + abort(); + + } +} + +// Return image that is IPL_DEPTH_32F version of +// given src +IplImage* ensure32F(const IplImage *src) +{ + CvSize size; + IplImage *result; + int channels = src->nChannels; + int dstDepth = IPL_DEPTH_32F; + size = cvGetSize(src); + result = cvCreateImage(size,dstDepth,channels); + + switch(src->depth) { + case IPL_DEPTH_32F: + case IPL_DEPTH_64F: + cvConvertScale(src,result,1,0); // Scale the values to [0,255] + return result; + case IPL_DEPTH_8U: + case IPL_DEPTH_8S: + cvConvertScale(src,result,1.0/255.0,0); + return result; + case IPL_DEPTH_16S: + cvConvertScale(src,result,1.0/65535.0,0); + return result; + case IPL_DEPTH_32S: + cvConvertScale(src,result,1.0/4294967295.0,0); + return result; + default: + printf("Cannot convert to floating image"); + abort(); + + } +} + +void wrapSet32F2D(CvArr *arr, int x, int y, double value) +{ + cvSet2D(arr,x,y,cvRealScalar(value)); +} + +double wrapGet32F2D(CvArr *arr, int x, int y) +{ + CvScalar r; + r = cvGet2D(arr,x,y); + return r.val[0]; +} + +void wrapDrawCircle(CvArr *img, int x, int y, int radius, double color, int thickness) +{ + cvCircle(img,cvPoint(x,y),radius,CV_RGB(color,color,color),thickness,8,0); +} + +void wrapDrawText(CvArr *img, char *text, float s, int x, int y) +{ +CvFont font; //? +cvInitFont(&font, CV_FONT_HERSHEY_PLAIN, s, s, 0, 2, 8); +cvPutText(img, text, cvPoint(x,y), &font, CV_RGB(1,1,1)); +} + +void wrapDrawRectangle(CvArr *img, int x1, int y1, + int x2, int y2, double color, + int thickness) +{ + cvRectangle(img,cvPoint(x1,y1),cvPoint(x2,y2),CV_RGB(color,color,color),thickness,8,0); +} + + +void wrapDrawLine(CvArr *img, int x, int y, int x1, int y1, double color, int thickness) +{ + cvLine(img,cvPoint(x,y),cvPoint(x1,y1),CV_RGB(color,color,color),thickness,8,0); +} + +void wrapFillPolygon(IplImage *img, int pc, int *xs, int *ys, double color) +{ + int i=0; + int pSizes[] = {pc}; + CvPoint *pts = (CvPoint*)malloc(pc*sizeof(CvPoint)); + for (i=0; idepth,img->nChannels); + cvCopy(img, newImage,0); + cvResetImageROI(img); + return newImage; +} + +IplImage* simpleMergeImages(IplImage *a, IplImage *b,int offset_x, int offset_y) +{ + CvSize aSize = cvGetSize(a); + CvSize bSize = cvGetSize(b); + int startx = 0 < offset_x ? 0 : offset_x; + int endx = aSize.width > bSize.width+offset_x ? aSize.width : bSize.width+offset_x ; + + int starty = 0 < offset_y ? 0 : offset_y; + int endy = aSize.height > bSize.height+offset_y ? aSize.height : bSize.height+offset_y ; + + CvSize size; + size.width = endx-startx; + size.height = endy-starty; + + CvRect aPos = cvRect(offset_x<0?-offset_x:0 + ,offset_y<0?-offset_y:0 + ,aSize.width + ,aSize.height); + + CvRect bPos = cvRect(offset_x<0?0:offset_x + ,offset_y<0?0:offset_y + ,bSize.width + ,bSize.height); + + IplImage *resultImage = cvCreateImage(size,a->depth,a->nChannels); + + // Blit the images into bigger result image using cvCopy + cvSetImageROI(resultImage,aPos); + cvCopy(a,resultImage,NULL); + cvSetImageROI(resultImage,bPos); + cvCopy(b,resultImage,NULL); + cvResetImageROI(resultImage); + return resultImage; +} + +void blitImg(IplImage *a, IplImage *b,int offset_x, int offset_y) +{ + CvSize bSize = cvGetSize(b); + CvRect pos = cvRect(offset_x + ,offset_y + ,bSize.width + ,bSize.height); + + // Blit the images b into a using cvCopy + printf("Doing a blit\n"); fflush(stdout); + cvSetImageROI(a,pos); + cvCopy(b,a,NULL); + cvResetImageROI(a); + printf("Done!\n"); fflush(stdout); +} +#define FGET(img,x,y) (((float *)((img)->imageData + (y)*(img)->widthStep))[(x)]) + +IplImage* makeEvenDown(IplImage *src) +{ + CvSize size = cvGetSize(src); + int w = size.width-(size.width % 2); + int h = size.height-(size.height % 2); + IplImage *result = wrapCreateImage32F(w,h,1); + CvRect pos = cvRect(0 + ,0 + ,size.width + ,size.height); + // Blit the images b into a using cvCopy + cvSetImageROI(src,pos); + cvCopy(src,result,NULL); + cvResetImageROI(result); + return result; +} + +IplImage* makeEvenUp(IplImage *src) +{ + CvSize size = cvGetSize(src); + int w = size.width+(size.width % 2); + int h = size.height+(size.height % 2); + int j; + IplImage *result = wrapCreateImage32F(w,h,1); + CvRect pos = cvRect(0 + ,0 + ,size.width + ,size.height); + // Blit the images b into a using cvCopy + cvSetImageROI(result,pos); + cvCopy(src,result,NULL); + cvResetImageROI(result); + if (size.width % 2 == 1) + {for (j=0; j<=size.height; j++) { + FGET(result,size.width,j) = FGET(result,size.width-1,j); } } + if (size.width % 2 == 1) + {for (j=0; j<=size.width; j++) { + FGET(result,j,(size.height)) = FGET(result,j,(size.height-1)); } } + return result; +} + +IplImage* padUp(IplImage *src,int right, int bottom) +{ + CvSize size = cvGetSize(src); + int w = size.width + (right ? 1 : 0); + int h = size.height+ (bottom ? 1 : 0); + int j; + IplImage *result = wrapCreateImage32F(w,h,1); + CvRect pos = cvRect(0 + ,0 + ,size.width + ,size.height); + // Blit the images b into a using cvCopy + cvSetImageROI(result,pos); + cvCopy(src,result,NULL); + cvResetImageROI(result); + if (right) + {for (j=0; j<=size.height; j++) { + FGET(result,size.width,j) = 2*FGET(result,size.width-1,j) + -FGET(result,size.width-2,j); } } + if (bottom) + {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)); + } } + return result; +} + +void masked_merge(IplImage *src1, IplImage *mask, IplImage *src2, IplImage *dst) +{ + int i,j; + CvSize size = cvGetSize(dst); + for (i=0; i edgeW ? 1 : dx/edgeW; + float y = dy > edgeW ? 1 : dy/edgeW; + FGET(result,j,i) = x*y; + } + return result; +} + +IplImage* rectangularDistance(int w, int h) { + IplImage *result; + int i,j; + result = wrapCreateImage32F(w,h,1); + for (i=0; i=aSize.width || i+offset_y>=aSize.height || i+offset_y < 0 || j+offset_x<0) continue; + + aA = FGET(aAlpha,j+offset_x,i+offset_y); + bA = FGET(bAlpha,j,i); + fV = aA+bA > 0 ? (FGET(b,j,i)*bA+FGET(a,j+offset_x,i+offset_y)*aA)/(aA+bA) : FGET(b,j,i) ; + FGET(a,j+offset_x,i+offset_y) =fV; + FGET(aAlpha,j+offset_x,i+offset_y) =aA+bA; + } +} + + +void plainBlit(IplImage *a, IplImage *b, int offset_y, int offset_x) +{ + // TODO: Add checks for image type and size + int i,j; + CvSize aSize = cvGetSize(a); + CvSize bSize = cvGetSize(b); + for (i=0; i=aSize.width || i+offset_y<0 || i+offset_y>=aSize.height ) continue; + FGET(a,j+offset_x,i+offset_y) =FGET(b,j,i); + } +} + +void subpixel_blit(IplImage *a, IplImage *b, double offset_y, double offset_x) +{ + // TODO: Add checks for image type and size + int i,j; + CvSize aSize = cvGetSize(a); + CvSize bSize = cvGetSize(b); + for (i=0; i= bSize.width + || y_at_b <0 || y_at_b >= bSize.height) continue; + FGET(a,j,i) =bilinearInterp(b,x_at_b,y_at_b); + // TODO: Check boundaries! #SAFETY + + } +} + + +// Histograms. +void wrapReleaseHist(CvHistogram *hist) +{ + cvReleaseHist(&hist); +} + +CvHistogram* calculateHistogram(IplImage *img,int bins) +{ + float st_range[] = {-1,1}; + float *ranges[] = {st_range}; + int hist_size[] = {bins}; + CvHistogram *result = cvCreateHist(1,hist_size,CV_HIST_ARRAY,ranges,1); + cvCalcHist(&img,result,0,0); + return result; +} + +void get_histogram(IplImage *img,IplImage *mask + ,float a, float b,int isCumulative + ,int binCount + ,double *values) +{ + int i=0; + float st_range[] = {a,b}; + float *ranges[] = {st_range}; + int hist_size[] = {binCount}; + CvHistogram *result = cvCreateHist(1,hist_size,CV_HIST_ARRAY + ,ranges,1); + cvCalcHist(&img,result,isCumulative,mask); + for (i=0;itotal,*maxLines); i++ ) + { + CvPoint* line = (CvPoint*)cvGetSeqElem(lines,i); + xs[i] = line[0].x; xs1[i] = line[1].x; + ys[i] = line[0].y; ys1[i] = line[1].y; + } + *maxLines = MIN(lines->total,*maxLines); + + cvReleaseImage(&tmp); + cvReleaseMemStorage(&storage); + +} + + + +//@-node:aleator.20050908100314.2:Wrappers +//@+node:aleator.20050908100314.3:Utilities +/* These are utilities that operate on opencv primitives but + are not really wrappers.. Due to the fact that I seem to + be incapable to link multiple objects including openCV + headers this seems to be the next best solution. + + Watch out for name collisions! + +*/ +//@+node:aleator.20070906153003:Trigonometric operations + +void calculateAtan(IplImage *src, IplImage *dst) +{ + CvSize imageSize = cvGetSize(dst); + double r=0; int i; int j; + for(i=0; iy) ? x:y;} +inline int imin(int x, int y) {return (x 0) ratio = fabs(desArea/area); + // else ratio=1; + //printf("Ratio(%d,%d) is %lf\n",rx1,ry1,ratio); + s = blurGet2D(intImg,rx1,ry1) + -blurGet2D(intImg,rx1,ry2) + -blurGet2D(intImg,rx2,ry1) + +blurGet2D(intImg,rx2,ry2); + cvSet2D(target,j,i,cvScalarAll(s/area)); + } +} + +double haar_at(IplImage *intImg, + int x1, int y1, int w, int h) +{ + int i,j; + double s = 0; + s = blurGet2D(intImg,x1,y1) + -blurGet2D(intImg,x1,y1+h) + -blurGet2D(intImg,x1+w,y1) + +blurGet2D(intImg,x1+w,y1+h); + return s; +} + +//@nonl +//@-node:aleator.20070827150608:Haar Filters +//@+node:aleator.20070130144337:Statistics along a line +#define SWAP(a,b) { \ + int c = (a); \ + (a) = (b); \ + (b) = c; \ + } + + +double average_of_line(int x0, int y0 + ,int x1, int y1 + ,IplImage *src) { + int steep = abs(y1 - y0) > abs(x1 - x0); + int deltax=0; int deltay=0; + int error=0; + int ystep=0; + int x=0; int y=0; + float sum=0; int len=0; + + if (steep) { SWAP(x0, y0); SWAP(x1, y1); } + if (x0 > x1) { SWAP(x0, x1); SWAP(y0, y1); } + deltax = x1 - x0; + deltay = abs(y1 - y0); + error = 0; + y = y0; + if (y0 < y1) {ystep = 1;} else {ystep = -1;} + for (x=x0; x= deltax) { + y = y + ystep; + error = error - deltax; } + } + return (sum/len); +} + +//@-node:aleator.20070130144337:Statistics along a line +//@+node:aleator.20051130130836:Taking square roots of images + +void sqrtImage(IplImage *src,IplImage *dst) +{ +int i;int j; +double result; +CvSize size = cvGetSize(src); + +for(i=0;iy) return y; else return x;} +int SMABx(double x, CvHistogram *h,int binCount,double t) +{ + int binnedX; double leftSM=0; + double rightSM=0; + int i=0; + binnedX = round(min(1,max(x,0))*(binCount-1)); + + // Calculate left second moment: + for(i=0; i 0.8) && (testij > 0.8))) + {rij=0;} + result += rij; + } + +return result; +} +//@-node:aleator.20070511142414.1:Fitness +//@+node:aleator.20070511145251:Updating distributions + +// This function is used to update distribution. +// Notice that alpha_t must be calculated separately +// and normalization is not applied. +IplImage* adaUpdateDistrImage(IplImage *target + ,IplImage *weigths + ,IplImage *test + ,double at) +{ +CvSize size = cvGetSize(target); +int i,j; +int width = size.width; +int height = size.height; +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))) + {rij = wij*exp(-at); + cvSetReal2D(result,j,i,rij); } + else + {rij = wij*exp(at); + cvSetReal2D(result,j,i,rij); } + } + +return result; +} + +//@-node:aleator.20070511145251:Updating distributions +//@-node:aleator.20070511142414:Adaboost Learning +//@+node:aleator.20051207074905:LBP + +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); + for(i=0;i=bins) continue; + histo[index] += weight; + } + +} + +// 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) +{ + int i,j; + int pattern = 0; + double center = 0; + 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; + LBP[pattern]++; + pattern = 0; + } +} + +void localBinaryPattern3(IplImage *src, int *LBP) +{ + int i,j; + int pattern = 0; + double center = 0; + 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; + LBP[pattern]++; + pattern = 0; + } +} +void localBinaryPattern5(IplImage *src, int *LBP) +{ + int i,j; + int pattern = 0; + double center = 0; + 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; + LBP[pattern]++; + pattern = 0; + } +} + +void weighted_localBinaryPattern(IplImage *src,int offsetX,int offsetXY + , IplImage* weights, double *LBP) +{ + int i,j; + int pattern = 0; + double center = 0; + double weight = 0; + 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; + LBP[pattern] += weight; + pattern = 0; + } +} + +void localHorizontalBinaryPattern(IplImage *src, int *LBP) +{ + int i,j; + int pattern = 0; + double center = 0; + CvSize imageSize = cvGetSize(src); + for(i=0; i center) *1; + pattern += (blurGet2D(src,i-3,j) > center) *2; + pattern += (blurGet2D(src,i-2,j) > center) *4; + pattern += (blurGet2D(src,i-1,j) > center) *8; + pattern += (blurGet2D(src,i+1,j) > center) *16; + pattern += (blurGet2D(src,i+2,j) > center) *32; + pattern += (blurGet2D(src,i+3,j) > center) *64; + pattern += (blurGet2D(src,i+4,j) > center) *128; + LBP[pattern]++; + pattern = 0; + } +} + +void localVerticalBinaryPattern(IplImage *src, int *LBP) +{ + int i,j; + int pattern = 0; + double center = 0; + CvSize imageSize = cvGetSize(src); + for(i=0; i center) *1; + pattern += (blurGet2D(src,i,j-3) > center) *2; + pattern += (blurGet2D(src,i,j-2) > center) *4; + pattern += (blurGet2D(src,i,j-1) > center) *8; + pattern += (blurGet2D(src,i,j+1) > center) *16; + pattern += (blurGet2D(src,i,j+2) > center) *32; + pattern += (blurGet2D(src,i,j+3) > center) *64; + pattern += (blurGet2D(src,i,j+4) > center) *128; + LBP[pattern]++; + pattern = 0; + } +} + + +//@-node:aleator.20051207074905:LBP +//@+node:aleator.20051109102750:Selective Average +// Assuming grayscale image calculate local selective average of point x y +inline double calcSelectiveAvg(IplImage *img,double t + ,int x, int y + ,int wwidth, int wheight) +{ +int i,j; +double accum=0; +double count=0; +double centerValue; double processed=0; +CvSize size = cvGetSize(img); +centerValue = blurGet2D(img,x,y); + +for (i=-wwidth; 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]; + } + } + return img; +} + +IplImage *acquireImageSlowComplex(int w, int h, complex double *d) +{ + IplImage *img; + int i,j; + img = cvCreateImage(cvSize(w,h), IPL_DEPTH_32F,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); +} + +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 +} + +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) + { + pt = (CvPoint*)cvGetSeqElem(fc->contour,i); + printf("PT=%d,%d\n",pt->x,pt->y); + } +} + +/* void draw_contour(FoundContours *fc,double color + , IplImage *img, IplImage *dst) +{ + cvDrawContours( dst, fc->start, color, color, -1, 0, 8 + , cvPoint(0,0)); +} */ + + +FoundContours* get_contours(IplImage *src1) +{ + CvSize size; + IplImage *src = ensure8U(src1); + //int dstDepth = IPL_DEPTH_8U; + //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 + ,CV_CHAIN_APPROX_NONE + ,cvPoint(0,0) ); + +// result->contour = cvApproxPoly( result->contour, sizeof(CvContour) +// , result->storage, CV_POLY_APPROX_DP +// , 3, 1 ); + result->start = contour; + result->contour = contour; + result->storage = storage; + + cvReleaseImage(&src); + return result; + + } +//@-node:aleator.20071016114634:Contours +//@+node:aleator.20070814123008:moments +CvMoments* getMoments(IplImage *src, int isBinary) +{ + CvMoments* moments = (CvMoments*) malloc(sizeof(CvMoments)); + cvMoments( src, moments, isBinary); + return moments; +} + +void freeCvMoments(CvMoments *x) +{ + free(x); +} + + +void getHuMoments(CvMoments *src,double *hu) +{ + CvHuMoments* hu_moments = (CvHuMoments*) malloc(sizeof(CvHuMoments)); + cvGetHuMoments( src, hu_moments); + *hu = hu_moments->hu1; ++hu; + *hu = hu_moments->hu2; ++hu; + *hu = hu_moments->hu3; ++hu; + *hu = hu_moments->hu4; ++hu; + *hu = hu_moments->hu5; ++hu; + *hu = hu_moments->hu6; ++hu; + *hu = hu_moments->hu7; + return; +} + +void freeCvHuMoments(CvHuMoments *x) +{ + free(x); +} +//@-node:aleator.20070814123008:moments +//@+node:aleator.20060727102514:blobCount +int blobCount(IplImage *src) +{ + int contourCount=0; + CvMemStorage* storage = cvCreateMemStorage(0); + CvSeq* contour = 0; + + contourCount = cvFindContours( src, storage, &contour, sizeof(CvContour), CV_RETR_EXTERNAL, CV_CHAIN_APPROX_SIMPLE, cvPoint(0,0) ); + + cvReleaseMemStorage(&storage); + return contourCount; +} + +//@-node:aleator.20060727102514:blobCount +//@+node:aleator.20060413093124.1:sizeFilter +IplImage* sizeFilter(IplImage *src, double minSize, double maxSize) +{ + IplImage* dst = cvCreateImage( cvGetSize(src), IPL_DEPTH_32F, 1 ); + CvMemStorage* storage = cvCreateMemStorage(0); + CvSeq* contour = 0; + + cvFindContours( src, storage, &contour, sizeof(CvContour), CV_RETR_EXTERNAL, CV_CHAIN_APPROX_SIMPLE, cvPoint(0,0) ); + cvZero( dst ); + + for( ; contour != 0; contour = contour->h_next ) + { + double area=fabs(cvContourArea(contour,CV_WHOLE_SEQ)); + if (area <=minSize || area >= maxSize) continue; + CvScalar color = cvScalar(1,1,1,1); + cvDrawContours( dst, contour, color, color, -1, CV_FILLED, 8, + cvPoint(0,0)); + } + cvReleaseMemStorage(&storage); + return dst; +} +//@-node:aleator.20060413093124.1:sizeFilter +//@-node:aleator.20060413093124:Connected components +//@+node:aleator.20050908101148.1:function for rotating image +IplImage* rotateImage(IplImage* src,double scale,double angle) +{ + + IplImage* dst = cvCloneImage( src ); + angle = angle * (180 / CV_PI); + int w = src->width; + int h = src->height; + CvMat *M; + M = cvCreateMat(2,3,CV_32FC1); + 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)); + return dst; + cvReleaseMat(&M); +} + + +inline double cubicInterpolate( + double y0,double y1, + double y2,double y3, + double mu) +{ + double a0,a1,a2,a3,mu2; + + mu2 = mu*mu; + a0 = y3 - y2 - y0 + y1; + a1 = y0 - y1 - a0; + a2 = y2 - y0; + a3 = y1; + return(a0*mu*mu2+a1*mu2+a2*mu+a3); +} + +double bilinearInterp(IplImage *tex, double u, double v) { + CvSize s = cvGetSize(tex); + int x = floor(u); + int y = floor(v); + double u_ratio = u - x; + double v_ratio = v - y; + 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+1) * u_opposite + FGET(tex,x+1,y+1) * u_ratio) * v_ratio; + return result; + } + +// TODO: Check boundaries! #SAFETY +double bicubicInterp(IplImage *tex, double u, double v) { + CvSize s = cvGetSize(tex); + int x = floor(u); + int y = floor(v); + double u_ratio = u - x; + double v_ratio = v - y; + double p[4][4] = {FGET(tex,x-1,y-1), FGET(tex,x,y-1), FGET(tex,x+1,y-1), FGET(tex,x+2,y-1), + FGET(tex,x-1,y), FGET(tex,x,y), FGET(tex,x+1,y), FGET(tex,x+2,y), + FGET(tex,x-1,y+1), FGET(tex,x,y+1), FGET(tex,x+1,y+1), FGET(tex,x+2,y+1), + FGET(tex,x-1,y+2), FGET(tex,x,y+2), FGET(tex,x+1,y+2), FGET(tex,x+2,y+2) + }; + double a00 = p[1][1]; + double a01 = -p[1][0] + p[1][2]; + double a02 = 2*p[1][0] - 2*p[1][1] + p[1][2] - p[1][3]; + 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] + + 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] + + 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] + - 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] + - 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] + - 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] + - p[3][2] + p[3][3]; + + double x2 = u_ratio * u_ratio; + double x3 = x2 * u_ratio; + double y2 = v_ratio * v_ratio; + double y3 = y2 * v_ratio; + + return a00 + a01 * v_ratio + a02 * y2 + a03 * y3 + + a10 * u_ratio + a11 * u_ratio * v_ratio + a12 * u_ratio * y2 + a13 * u_ratio * y3 + + a20 * x2 + a21 * x2 * v_ratio + a22 * x2 * y2 + a23 * x2 * y3 + + a30 * x3 + a31 * x3 * v_ratio + a32 * x3 * y2 + a33 * x3 * y3; + } + +void radialRemap(IplImage *source, IplImage *dest, double k) +{ + int i,j; + CvSize s = cvGetSize(dest); + double x,y,cx,cy,nx,ny,r2; + cx = s.width/2.0; + cy = s.height/2.0; + for (i=0; i=s.width || y<0 || y>=s.height) + { FGET(dest,j,i) = 0; + continue;} + FGET(dest,j,i) = bilinearInterp(source,x,y); + } + + +} + + +//@-node:aleator.20050908101148.1:function for rotating image +//@+node:aleator.20051220091717:Matrix multiplication + +void wrapMatMul(int w, int h, double *mat + , double *vec, double *t) +{ + +CvMat matrix; +CvMat vector; +CvMat target; +cvInitMatHeader(&matrix,w,h,CV_64FC1,mat,CV_AUTOSTEP); +cvInitMatHeader(&vector,h,1,CV_64FC1,vec,CV_AUTOSTEP); +cvInitMatHeader(&target,w,1,CV_64FC1,t,CV_AUTOSTEP); +cvMatMul(&matrix,&vector,&target); +} + + +double juliaF(double a, double b,double x, double y) { + int limit = 1000; + double complex z; + int i=0; + double complex c; + double cr,ci; + c = a + b*I; + z = x+y*I; + for (i=0;i4) return (i*1.0)/limit; + z=z*z+c; + } + return 0; + } + +//@-node:aleator.20051220091717:Matrix multiplication +//@-all +//@-node:aleator.20050908100314:@thin cvWrapLEO.c +//@-leo diff --git a/CV/cvWrapLEO.h b/CV/cvWrapLEO.h new file mode 100644 index 0000000..1aaff6b --- /dev/null +++ b/CV/cvWrapLEO.h @@ -0,0 +1,261 @@ +//@+leo-ver=4-thin +//@+node:aleator.20050908101148.2:@thin cvWrapLEO.h +//@@language c +#ifndef __CVWRAP__ +#define __CVWRAP__ + +#include +#include +#include +#include + +IplImage* wrapCreateImage32F(const int width, const int height, const int channels); +IplImage* wrapCreateImage64F(const int width, const int height, const int channels); + +IplImage* wrapCreateImage8U(const int width, const int height, const int channels); + +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 wrapStdDev(const CvArr *src); +double wrapStdDevMask(const CvArr *src,const CvArr *mask); +double wrapSum(const CvArr *src); +void wrapMinMax(const CvArr *src,const CvArr *mask + ,double *minVal, double *maxVal); +void wrapAbsDiffS(const CvArr *src, double s, CvArr *dst); + +void wrapSetImageROI(IplImage *i,int x, int y, int w, int h); + +IplImage* wrapSobel(IplImage *src,int dx + ,int dy,int size); + +IplImage* wrapLaplace(IplImage *src,int size); + +IplImage* ensure8U(const IplImage *src); +IplImage* ensure32F(const IplImage *src); + +void wrapSet32F2D(CvArr *arr, int x, int y, double value); +double wrapGet32F2D(CvArr *arr, int x, int y); + +void wrapDrawCircle(CvArr *img, int x, int y, int radius, double color, int thickness); + +void wrapDrawLine(CvArr *img, int x, int y, int x1, int y1, double color, int thickness); + +void wrapFillPolygon(IplImage *img, int pc, int *xs, int *ys, double color); + +void wrapMatMul(int w, int h, double *mat + , double *vec, double *t); + +// Utils. Place them in another file +IplImage* rotateImage(IplImage* src,double scale,double angle); +CvHistogram* calculateHistogram(IplImage *img,int bins); +void wrapReleaseHist(CvHistogram *hist); +double getHistValue(CvHistogram *h,int bin); +void get_histogram(IplImage *img,IplImage *mask + ,float a, float b,int isCumulative + ,int binCount + ,double *values); + +IplImage* getSubImage(IplImage *img, int sx,int sy,int w,int h); +int getImageHeight(IplImage *img); +int getImageWidth(IplImage *img); + + +IplImage* susanSmooth(IplImage *src, int w, int h + ,double t, double sigma); + +IplImage* susanEdge(IplImage *src,int w,int h,double t); +IplImage* getNthCentralMoment(IplImage *src, int n, int w, int h); +IplImage* getNthAbsCentralMoment(IplImage *src, int n, int w, int h); +IplImage* getNthMoment(IplImage *src, int n, int w, int h); + +double calcGabor(double x, double y + ,double stdX, double stdY + ,double theta, double phase + ,double cycles); + +void gaborFilter(const CvArr *src, CvArr *dst + ,int maskWidth, int maskHeight + ,double stdX, double stdY + ,double theta,double phase + ,double cycles); + +void radialGaborFilter(const CvArr *src, CvArr *dst + ,int maskWidth, int maskHeight + ,double sigma + ,double phase,double center + ,double cycles); + +void renderRadialGabor(CvArr *dst,int width, int height + ,double sigma + ,double phase, double center + ,double cycles); + +void render_gaussian(IplImage *dst + ,double stdX, double stdY); + +void renderGabor(CvArr *dst,int width, int height + ,double dx, double dy + ,double stdX, double stdY + ,double theta, double phase + ,double cycles); + +void smb(IplImage *image,double t); +void smab(IplImage *image,int w, int h,double t); + +IplImage* selectiveAvgFilter(IplImage *src,double t + ,int wwidth, int wheight); + +IplImage* wrapFilter2D(IplImage *src, int ax,int ay, + int w, int h, double *kernel); +IplImage* wrapFilter2DImg(IplImage *src + ,IplImage *mask + ,int ax,int ay); + +void wrapFloodFill(IplImage *i, int x, int y, double c + ,double low, double high,int fixed); + +void sqrtImage(IplImage *src,IplImage *dst); + +void weighted_localBinaryPattern(IplImage *src,int offsetX,int offsetXY + , IplImage* weights, double *LBP); + +void localBinaryPattern(IplImage *src, int *LBP); +void localBinaryPattern3(IplImage *src, int *LBP); +void localBinaryPattern5(IplImage *src, int *LBP); +void localHorizontalBinaryPattern(IplImage *src, int *LBP); +void localVerticalBinaryPattern(IplImage *src, int *LBP); + +void get_weighted_histogram(IplImage *src, IplImage *weights, + double start, double end, + int bins, double *histo); + + +void eigenValsViaSVD(double *A, int size, double *eVals + ,double *eVects); + +IplImage* sizeFilter(IplImage *src, double minSize, double maxSize); +int blobCount(IplImage *src); + + +IplImage *acquireImage(int w, int h, double *d); + +void wrapProbHoughLines(IplImage *img, double rho, double theta + , int threshold, double minLength + , double gapLength + , int *maxLines + , int *xs, int *ys + , int *xs1, int *ys1); + + +double average_of_line(int x0, int y0 + ,int x1, int y1 + ,IplImage *src); + +IplImage* adaUpdateDistrImage(IplImage *target + ,IplImage *weigths + ,IplImage *test + ,double at); + +double adaFitness1(IplImage *target + ,IplImage *weigths + ,IplImage *test); + +CvMoments* getMoments(IplImage *src, int isBinary); + +void freeCvMoments(CvMoments *x); + +void getHuMoments(CvMoments *src,double *hu); + +void freeCvHuMoments(CvHuMoments *x); + +void haarFilter(IplImage *intImg, + int a, int b, int c, int d, + IplImage *target); + +double haar_at(IplImage *intImg, + int x1, int y1, int w, int h); + +void wrapDrawRectangle(CvArr *img, int x1, int y1, + int x2, int y2, double color, + int thickness); + +void calculateAtan(IplImage *src, IplImage *dst); + + +// Contours +typedef struct { + CvMemStorage *storage; + CvSeq *contour; + CvSeq *start; + +} FoundContours; + +CvMoments* contour_moments(FoundContours *f); +void contour_points(FoundContours *f, int *xs, int *ys); +CvMoments* contour_Moments(FoundContours *f); +int cur_contour_size(FoundContours *f); +double contour_area(FoundContours *f); +double contour_perimeter(FoundContours *f); +int more_contours(FoundContours *f); +int next_contour(FoundContours *f); +int reset_contour(FoundContours *f); +void free_found_contours(FoundContours *f); +void get_next_contour(FoundContours *fc); +void print_contour(FoundContours *fc); +FoundContours* get_contours(IplImage *src); + +double juliaF(double a, double b,double x, double y); +void simpleMatchTemplate(const IplImage* target, const IplImage* template, int* x, int* y, double *val, int type); +IplImage* templateImage(const IplImage* target, const IplImage* template); +IplImage* simpleMergeImages(IplImage *a, IplImage *b,int offset_x, int offset_y); + +void alphaBlit(IplImage *a, IplImage *aAlpha, IplImage *b, IplImage *bAlpha, int offset_x, int offset_y); +void blitImg(IplImage *a, IplImage *b,int offset_x, int offset_y); +IplImage* fadedEdges(int w, int h, int edgeW); +IplImage* rectangularDistance(int w, int h); +void radialRemap(IplImage *source, IplImage *dest, double k); +void plainBlit(IplImage *a, IplImage *b, int offset_y, int offset_x); +void wrapMinMaxLoc(const IplImage* target, int* minx, int* miny, int* maxx, int* maxy, double *minval, double *maxval); +void incrImageC(void); +IplImage* vignettingModelCos4(int w, int h) ; +IplImage* vignettingModelCos4XCyl(int w, int h) ; +IplImage* vignettingModelX2Cyl(int w, int h,double m, double s, double c); +void wrapDrawText(CvArr *img, char *text, float s, int x, int y); + +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); +IplImage* padUp(IplImage *src,int right, int bottom); +IplImage* makeEvenDown(IplImage *src); +void vertical_average(IplImage *src1, IplImage *dst); + +IplImage* composeMultiChannel(IplImage* img0 + ,IplImage* img1 + ,IplImage* img2 + ,IplImage* img3 + ,const int channels); + +IplImage *acquireImageSlow(int w, int h, double *d); +void exportImageSlow(IplImage *img, double *d); + +IplImage *acquireImageSlowComplex(int w, int h, complex double *d); +void exportImageSlowComplex(IplImage *img, complex double *d); +void subpixel_blit(IplImage *a, IplImage *b, double offset_y, double offset_x); +double bicubicInterp(IplImage *tex, double u, double v); +#endif +//@-node:aleator.20050908101148.2:@thin cvWrapLEO.h +//@-leo diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..e69de29