CV (empty) → 0.3
raw patch · 56 files changed
+6743/−0 lines, 56 filesdep +JYU-Utilsdep +QuickCheckdep +arraysetup-changedbinary-added
Dependencies added: JYU-Utils, QuickCheck, array, base, binary, carray, containers, deepseq, haskell98, mtl, parallel, random, storable-complex, unix
Files
- C2HS.hs +220/−0
- C2HSTools.hs +220/−0
- CV.cabal +47/−0
- CV/Binary.hs +22/−0
- CV/ColourUtils.chs +52/−0
- CV/ConnectedComponents.chs +124/−0
- CV/Conversions.hs +90/−0
- CV/Drawing.chs +157/−0
- CV/Edges.chs +79/−0
- CV/Filters.chs +179/−0
- CV/FunnyStatistics.hs +31/−0
- CV/Gabor.chs +58/−0
- CV/Histogram.chs +172/−0
- CV/Image.chs +432/−0
- CV/ImageMath.chs +311/−0
- CV/ImageMathOp.hs +28/−0
- CV/ImageOp.hs +41/−0
- CV/LightBalance.chs +18/−0
- CV/Marking.hs +62/−0
- CV/Morphology.chs +144/−0
- CV/MultiresolutionSpline.hs +32/−0
- CV/Sampling.hs +116/−0
- CV/TemplateMatching.chs +100/−0
- CV/Textures.chs +46/−0
- CV/Thresholding.hs +76/−0
- CV/Transforms.chs +256/−0
- CV/Video.chs +138/−0
- CV/cvWrapLEO.c +2244/−0
- CV/cvWrapLEO.h +271/−0
- LICENSE +674/−0
- Setup.lhs +4/−0
- examples/ShapeMatch.hs +27/−0
- examples/channels.hs +20/−0
- examples/colourUtils.hs +16/−0
- examples/distance.hs +21/−0
- examples/draw.hs +15/−0
- examples/edges.hs +14/−0
- examples/elaine.jpg binary
- examples/filters.hs +15/−0
- examples/maximalCC.hs +20/−0
- examples/montageDebug.hs +16/−0
- examples/morphology.hs +18/−0
- examples/shapePhoto.jpg binary
- examples/shapes/close.png binary
- examples/shapes/down.png binary
- examples/shapes/left.png binary
- examples/shapes/open.png binary
- examples/shapes/right.png binary
- examples/shapes/up.png binary
- examples/smallLena.jpg binary
- examples/spline.hs +22/−0
- examples/splitMerge.hs +16/−0
- examples/templateMatching.hs +24/−0
- examples/thresholding.hs +14/−0
- examples/transforms.hs +22/−0
- examples/video.hs +19/−0
+ C2HS.hs view
@@ -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
+ C2HSTools.hs view
@@ -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
+ CV.cabal view
@@ -0,0 +1,47 @@+Name: CV+Version: 0.3+Description: OpenCV Bindings+License: GPL+License-file: LICENSE+Category: AI, Graphics, Machine Vision+Synopsis: OpenCV based machine vision library+Description: This is a machine vision package that wraps some functionality+ of OpenCV library. This package has been developed for personal use and+ is not meant to be a complete wrapper, though it will most likely grow to+ cover most of functionaly exposed by OpenCV C interface.++ Currently this package is quite dirty and requires much work on documentation+ and code clean-up, but is somewhat tested.+Author: Ville Tirronen+Maintainer: ville.tirronen@jyu.fi+Build-Type: Simple+Cabal-Version: >=1.6+Extra-Source-Files:+ examples/*.hs+ examples/shapes/*.png+ examples/shapePhoto.jpg+ examples/smallLena.jpg+ examples/elaine.jpg++Library+ Build-Tools: c2hs >= 0.16.0+ Include-dirs: CV/ + Includes: opencv/cv.h, opencv/cxcore.h, opencv/highgui.h, CV/cvWrapLEO.h+ c-sources: CV/cvWrapLEO.c+ install-includes: CV/cvWrapLEO.h+ cc-options: --std=c99 + extra-libraries: opencv_calib3d,opencv_contrib,opencv_core,opencv_features2d,opencv_highgui,opencv_imgproc,opencv_legacy,opencv_ml,opencv_objdetect,opencv_video+ + Build-Depends: haskell98, base >= 3 && < 5, parallel > 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 >= 0.1 && < 0.2,+ storable-complex, binary >= 0.5, deepseq >= 1.1+ Exposed-modules: CV.Image, CV.ImageOp, CV.ImageMath CV.Sampling, CV.Edges, CV.Filters, + CV.Morphology, CV.ColourUtils, CV.ImageMathOp, CV.Video,+ CV.Textures,CV.Drawing, CV.Thresholding, CV.Histogram, CV.LightBalance,+ CV.TemplateMatching, CV.Transforms, CV.Conversions,+ CV.Binary, CV.Marking, CV.FunnyStatistics,+ CV.MultiresolutionSpline, CV.Gabor,+ CV.ConnectedComponents+ Other-modules: C2HSTools, C2HS+
+ CV/Binary.hs view
@@ -0,0 +1,22 @@+{-#LANGUAGE ScopedTypeVariables, FlexibleInstances#-}+module CV.Binary where+import CV.Image (Image,GrayScale,D32)+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 GrayScale D32) 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 +
+ CV/ColourUtils.chs view
@@ -0,0 +1,52 @@+{-#LANGUAGE ForeignFunctionInterface,ScopedTypeVariables#-}+#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++-- TODO: Rename this entire module to something else. Everything here is grayscale :/++-- Balance image grayscales so that it has m mean and md standard deviation+balance (m,md) i = m |+ (scale |* (i |- im) ) + where+ imd :: D32 = realToFrac $ IM.stdDeviation i+ im :: D32 = IM.average i+ scale :: D32 = realToFrac $ md/imd+++logarithmicCompression image = stretchHistogram $ + IM.log $ 1 `IM.addS` image +++getStretchScaling reference image = stretched+ where+ stretched = (1/realToFrac length) `IM.mulS` normed+ normed = image `IM.subS` (realToFrac min)+ length = max-min+ (min,max) = IM.findMinMax reference+++stretchHistogram :: Image GrayScale D32 -> Image GrayScale D32 +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 GrayScale D8 -> Image GrayScale D8+equalizeHistogram image = unsafePerformIO $ do+ withClone image $ \x ->+ withGenImage x $ \i ->+ {#call cvEqualizeHist#} i i+
+ CV/ConnectedComponents.chs view
@@ -0,0 +1,124 @@+{-#LANGUAGE ForeignFunctionInterface, ScopedTypeVariables#-}+#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 GrayScale D8 -> Int +countBlobs image = fromIntegral $ unsafePerformIO $ do+ withGenImage image $ \i ->+ {#call blobCount#} i++selectSizedComponents minSize maxSize image = unsafePerformIO $ do+ withGenImage image $ \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
+ CV/Conversions.hs view
@@ -0,0 +1,90 @@+{-#LANGUAGE ForeignFunctionInterface#-}+-- |This module provides slow but functional means for exporting images from and to +-- CArrays, which can easily be passed into foreign functions.+module CV.Conversions (+ copyCArrayToImage+ ,copyFCArrayToImage+ ,copyComplexCArrayToImage+ ,copyImageToFCArray+ ,copyImageToCArray+ ,copyImageToComplexCArray+ ) 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 GrayScale D32+copyCArrayToImage carr = S $ unsafePerformIO $+ creatingBareImage (withCArray carr (acquireImageSlow' w h))+ where+ ((sx,sy),(ex,ey)) = bounds carr+ (w,h) = (fromIntegral $ ex-sx+1, fromIntegral $ ey-sy+1)++-- |Copy CArray of floats to image+copyFCArrayToImage :: CArray (Int,Int) Float -> Image GrayScale D32+copyFCArrayToImage carr = S $ unsafePerformIO $+ creatingBareImage (withCArray carr (acquireImageSlowF' w h))+ where+ ((sx,sy),(ex,ey)) = bounds carr+ (w,h) = (fromIntegral $ ex-sx+1, fromIntegral $ ey-sy+1)++-- |Copy D32 grayscale image to CArray+copyImageToFCArray :: Image GrayScale D32 -> CArray (Int,Int) Float+copyImageToFCArray (S img) = unsafePerformIO $+ withBareImage img $ \cimg -> + createCArray ((0,0),(w-1,h-1)) (exportImageSlowF' cimg) --({#call exportImageSlow#} cimg)+ where+ (w,h) = getSize img++-- |Copy the real part of an array to image+copyComplexCArrayToImage :: CArray (Int,Int) (Complex Double) -> Image GrayScale D32+copyComplexCArrayToImage carr = S $ unsafePerformIO $+ creatingBareImage (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 GrayScale D32 -> CArray (Int,Int) Double+copyImageToCArray (S img) = unsafePerformIO $+ withBareImage img $ \cimg -> + createCArray ((0,0),(w-1,h-1)) (exportImageSlow' cimg) --({#call exportImageSlow#} cimg)+ where+ (w,h) = getSize img++-- |Copy image as a real part of a complex CArray+copyImageToComplexCArray :: Image GrayScale D32 -> CArray (Int,Int) (Complex Double)+copyImageToComplexCArray (S img) = unsafePerformIO $+ withBareImage 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 (BareImage)) -> ((Ptr Double) -> (IO ())))++foreign import ccall safe "CV/cvWrapLeo.h exportImageSlowF"+ exportImageSlowF' :: ((Ptr (BareImage)) -> ((Ptr Float) -> (IO ())))++foreign import ccall safe "CV/cvWrapLeo.h exportImageSlowComplex"+ exportImageSlowComplex' :: ((Ptr (BareImage)) -> ((Ptr (Complex Double)) -> (IO ())))++foreign import ccall safe "CV/cvWrapLeo.h acquireImageSlow"+ acquireImageSlow' :: (Int -> (Int -> ((Ptr Double) -> (IO (Ptr (BareImage))))))++foreign import ccall safe "CV/cvWrapLeo.h acquireImageSlowF"+ acquireImageSlowF' :: (Int -> (Int -> ((Ptr Float) -> (IO (Ptr (BareImage))))))++foreign import ccall safe "CV/cvWrapLeo.h acquireImageSlowComplex"+ acquireImageSlowComplex' :: (Int -> (Int -> ((Ptr (Complex Double)) -> (IO (Ptr (BareImage))))))+
+ CV/Drawing.chs view
@@ -0,0 +1,157 @@+{-#LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, TypeSynonymInstances#-}+#include "cvWrapLEO.h"++module CV.Drawing(ShapeStyle(Filled,Stroked),circle+ ,Drawable(..)+ ,floodfill,drawLinesOp,drawLines,rectangle+ ,rectOpS,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 Control.Monad(when)++{#import CV.Image#}++import CV.ImageOp++data ShapeStyle = Filled | Stroked Int+ deriving(Eq,Show)++styleToCV Filled = -1+styleToCV (Stroked w) = fromIntegral w++-- TODO: Add fillstyle for rectOp+++-- TODO: The instances in here could be significantly smaller..+class Drawable a b where+ type Color a b :: * + putTextOp :: (Color a b) -> Float -> String -> (Int,Int) -> ImageOperation a b+ lineOp :: (Color a b) -> Int -> (Int,Int) -> (Int,Int) -> ImageOperation a b+ circleOp :: (Color a b) -> (Int,Int) -> Int -> ShapeStyle -> ImageOperation a b+ rectOp :: (Color a b) -> Int -> (Int,Int) -> (Int,Int) -> ImageOperation a b+ fillPolyOp :: (Color a b) -> [(Int,Int)] -> ImageOperation a b++instance Drawable RGB D32 where+ type Color RGB D32 = (D32,D32,D32)+ putTextOp (r,g,b) size text (x,y) = ImgOp $ \img -> do+ withGenImage img $ \cimg ->+ withCString text $ \(ctext) ->+ {#call wrapDrawText#} cimg ctext (realToFrac size) + (fromIntegral x) (fromIntegral y) + (realToFrac r) (realToFrac g) (realToFrac b) ++ lineOp (r,g,b) t (x,y) (x1,y1) = ImgOp $ \i -> do+ withGenImage i $ \img -> + {#call wrapDrawLine#} img (fromIntegral x) (fromIntegral y) + (fromIntegral x1) (fromIntegral y1) + (realToFrac r) (realToFrac g) + (realToFrac b) (fromIntegral t) + + circleOp (red,g,b) (x,y) r s = ImgOp $ \i -> do+ when (r>0) $ withGenImage i $ \img -> + ({#call wrapDrawCircle#} img (fromIntegral x) (fromIntegral y) + (fromIntegral r) (realToFrac red) + (realToFrac g) (realToFrac b)+ $ styleToCV s)+ rectOp (r,g,b) t (x,y) (x1,y1) = ImgOp $ \i -> do+ withGenImage i $ \img -> + {#call wrapDrawRectangle#} img (fromIntegral x)+ (fromIntegral y) (fromIntegral x1) (fromIntegral y1)+ (realToFrac r) (realToFrac g)(realToFrac b)(fromIntegral t)+ fillPolyOp (r,g,b) 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 r) (realToFrac g) (realToFrac b) + free xs'+ free ys'+++instance Drawable GrayScale D32 where+ type Color GrayScale D32 = D32++ putTextOp color size text (x,y) = ImgOp $ \img -> do+ withGenImage img $ \cimg ->+ withCString text $ \(ctext) ->+ {#call wrapDrawText#} cimg ctext (realToFrac size) + (fromIntegral x) (fromIntegral y) + (realToFrac color) (realToFrac color) (realToFrac color) ++ lineOp c t (x,y) (x1,y1) = ImgOp $ \i -> do+ withGenImage i $ \img -> + {#call wrapDrawLine#} img (fromIntegral x) (fromIntegral y) + (fromIntegral x1) (fromIntegral y1) + (realToFrac c) (realToFrac c) + (realToFrac c) (fromIntegral t) ++ circleOp c (x,y) r s = ImgOp $ \i -> do+ when (r>0) $ withGenImage i $ \img -> + ({#call wrapDrawCircle#} img (fromIntegral x) (fromIntegral y) + (fromIntegral r) + (realToFrac c) (realToFrac c) (realToFrac c) + $ styleToCV s)++ rectOp c t (x,y) (x1,y1) = ImgOp $ \i -> do+ withGenImage i $ \img -> + {#call wrapDrawRectangle#} img (fromIntegral x)+ (fromIntegral y) (fromIntegral x1) (fromIntegral y1)+ (realToFrac c)(realToFrac c)(realToFrac c) (fromIntegral t)++ 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) (realToFrac c) (realToFrac c) + free xs'+ free ys'+++rectOpS c t pos@(x,y) (w,h) = rectOp c t pos (x+w,y+h)++fillOp :: (Int,Int) -> D32 -> D32 -> D32 -> Bool -> ImageOperation GrayScale D32+fillOp (x,y) color low high floats = + ImgOp $ \i -> do+ withImage i $ \img -> + ({#call wrapFloodFill#} img (fromIntegral x) (fromIntegral y)+ (realToFrac color) (realToFrac low) (realToFrac high) (toCINT $ floats))+ where+ toCINT False = 0+ toCINT True = 1++-- Shorthand for single drawing operations. You should however use #> and <## in CV.ImageOp +-- rather than these++--line color thickness start end i = +-- operate (lineOp color thickness start end ) i++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 color center r s) i++floodfill (x,y) color low high floats = + unsafeOperate (fillOp (x,y) color low high floats) ++ +
+ CV/Edges.chs view
@@ -0,0 +1,79 @@+{-#LANGUAGE ForeignFunctionInterface#-}+#include "cvWrapLEO.h"+module CV.Edges (sobelOp,sobel+ ,sScharr,s1,s3,s5,s7+ ,l1,l3,l5,l7+ ,laplaceOp,laplace,canny,susan) 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++-- | Perform Sobel filtering on image. First argument gives order of horizontal and vertical+-- derivative estimates and second one is the aperture. This function can also calculate+-- Scharr filter with aperture specification of sScharr+-- TODO: Type the aperture size and possibly the derivative orders as well+-- TODO: It is possible to define sobel with different target image with other bit depths.+sobelOp :: (Int,Int) -> SobelAperture -> ImageOperation GrayScale D32+sobelOp (dx,dy) (Sb aperture)+ | dx >=0 && dx <3+ && 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++-- | Aperture sizes for sobel operator+newtype SobelAperture = Sb Int+sScharr = Sb (-1)+s1 = Sb 1+s3 = Sb 3+s5 = Sb 5+s7 = Sb 7+++-- | Aperture sizes for laplacian operator+newtype LaplacianAperture = L Int+l1 = L 1+l3 = L 3+l5 = L 5+l7 = L 7++-- |Perform laplacian filtering of given aperture to image+laplaceOp :: LaplacianAperture -> ImageOperation GrayScale D32+laplaceOp (L s) = ImgOp $ \img -> withGenImage img $ \image -> + ({#call cvLaplace #} image image (fromIntegral s)) ++laplace s i = unsafeOperate (laplaceOp s) i++-- |Perform canny thresholding using two threshold values and given aperture+-- Works only on 8-bit images+canny :: Int -> Int -> Int -> Image GrayScale D8 -> Image GrayScale D8+canny t1 t2 aperture src = unsafePerformIO $ do+ withClone src $ \clone -> + withGenImage src $ \si ->+ withGenImage clone $ \ci -> do+ {#call cvCanny#} si ci (fromIntegral t1) + (fromIntegral t2) + (fromIntegral aperture)+ return clone+ + + +-- | SUSAN edge detection filter, see http://users.fmrib.ox.ac.uk/~steve/susan/susan/susan.html+-- TODO: Should return a binary image+susan :: (Int,Int) -> D32 -> Image GrayScale D32 -> Image GrayScale D8+susan (w,h) t image = unsafePerformIO $ do+ withGenImage image $ \img ->+ creatingImage+ ({#call susanEdge#} img (fromIntegral w) (fromIntegral h) (realToFrac t))
+ CV/Filters.chs view
@@ -0,0 +1,179 @@+{-#LANGUAGE ForeignFunctionInterface#-}+#include "cvWrapLEO.h"+module CV.Filters(gaussian,gaussianOp,bilateral+ ,blurOp,blur,blurNS+ ,median+ ,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#}++-- 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 GrayScale D32'+ ,withGenImage* `Image GrayScale D32'+ ,`Int',`Int',`Int',`Float',`Float'}+ -> `()'#}++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++-- | TODO: This doesn't give a reasonable result. Investigate+bilateral :: Int -> Int -> Image GrayScale D8 -> Image GrayScale D8+bilateral colorS spaceS img = unsafePerformIO $ + withClone img $ \clone ->+ withGenImage img $ \cimg ->+ withGenImage clone $ \ccln -> do+ {#call cvSmooth#} cimg ccln (fromIntegral $ fromEnum Bilateral)+ (fromIntegral colorS) (fromIntegral spaceS) 0 0+++median :: (Int,Int) -> Image GrayScale D8 -> Image GrayScale D8+median (w,h) img + | maskIsOk (w,h) = unsafePerformIO $ do+ clone2 <- cloneImage img+ withGenImage img $ \c1 -> + withGenImage clone2 $ \c2 -> + {#call cvSmooth#} c1 c2 (fromIntegral $ fromEnum Median) + (fromIntegral w) (fromIntegral h) 0 0+ return 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 GrayScale D32 -> Image GrayScale D32+verticalAverage image = unsafePerformIO $ do + let (w,h) = getSize image+ s <- create (w,h) + withGenImage image $ \i -> do+ withGenImage s $ \sum -> do+ {#call vertical_average#} i sum + return s++newtype IntegralImage = IntegralImage (Image GrayScale D64)++getIISize (IntegralImage i) = getSize i++integralImage :: Image GrayScale D32 -> IntegralImage+integralImage image = unsafePerformIO $ do + let (w,h) = getSize image+ s <- create (w+1,h+1)+ withGenImage image $ \i -> do+ withGenImage s $ \sum -> do+ {#call cvIntegral#} i sum nullPtr nullPtr+ return $ IntegralImage s+++haar :: IntegralImage -> (Int,Int,Int,Int) -> Image GrayScale D32+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 <- create (w,h)+ 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
+ CV/FunnyStatistics.hs view
@@ -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 #- unsafeImageTo32F (median s (unsafeImageTo32F image))) + (stdDev s image)
+ CV/Gabor.chs view
@@ -0,0 +1,58 @@+{-#LANGUAGE ForeignFunctionInterface, ScopedTypeVariables#-}+#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 :: Image GrayScale D32<- create (width,height) + withGenImage img $ \i ->+ {#call renderGabor#} i (fromIntegral width) (fromIntegral 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 :: Image GrayScale D32 <- create (width,height) + withGenImage img $ \i ->+ {#call renderRadialGabor#} i (fromIntegral width) (fromIntegral height) sigma + phase center cycles+ return img+
+ CV/Histogram.chs view
@@ -0,0 +1,172 @@+{-#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 :: [Double]+ values :: [Double]+ (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++-- TODO: Add binary images+simpleGetHistogram :: Image GrayScale D32 -> Maybe (Image GrayScale D8) + -> D32 -> D32 -> Int -> Bool -> [D32]+simpleGetHistogram img mask start end binCount cumulative = unsafePerformIO $+ withImage img $ \i -> do+ bins <- mallocArray binCount + let isCum | cumulative == True = 1+ | cumulative == False = 0+ + case mask of+ (Just msk) -> do+ withImage msk $ \m -> do+ {#call get_histogram#} i m (realToFrac start) (realToFrac end) + 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 :: [Double]+ bin :: [Double]+ (bin,value) = unzip lst+ new = zip bin $ map (/size) value+ size = fromIntegral $ uncurry (*) $ getSize image++getHistogram :: Int -> Image GrayScale D32 -> HistogramData Double+getHistogram bins image = unsafePerformIO $ do + h <- buildHistogram cbins image + values <- mapM (getBin h) + [0..fromIntegral bins-1] + return.HGD $ + zip [-1,-1+2/(realToFrac bins)..1] values+ where+ cbins = fromIntegral bins+++--getHistgramHS bins image = calcHistogram bins $ getAllPixels image+--+---- Calculate image histogram from _Floating Point_ Image+--calcHistogram :: Int -> [CDouble] -> HistogramData Int 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 Double+getBin hist bin = withHistogram hist $ \h ->+ ({#call getHistValue#} h bin) >>= return.realToFrac
+ CV/Image.chs view
@@ -0,0 +1,432 @@+{-#LANGUAGE ForeignFunctionInterface, ViewPatterns,ParallelListComp, FlexibleInstances, FlexibleContexts, TypeFamilies, EmptyDataDecls #-}+#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 Control.DeepSeq++-- import C2HSTools++import Data.Maybe(catMaybes)+import Data.List(genericLength)+import Foreign.Marshal.Array+import Foreign.Marshal.Alloc+import Foreign.Ptr+import Foreign.Storable+import System.IO.Unsafe+import Data.Word+++-- Colorspaces+data GrayScale+data RGB+data RGB_Channel = Red | Green | Blue deriving (Eq,Ord,Enum)+data RGBA+data LAB+data LAB_Channel = LAB_L | LAB_A | LAB_B deriving (Eq,Ord,Enum)+type family ChannelOf a :: *+type instance ChannelOf RGB_Channel = RGB+type instance ChannelOf LAB_Channel = LAB++-- Bit Depths+type D8 = Word8+type D32 = Float+type D64 = Double++newtype Image channels depth = S BareImage++unS (S i) = i -- Unsafe and ugly++withImage :: Image c d -> (Ptr BareImage ->IO a) -> IO a+withImage (S i) op = withBareImage i op+--withGenNewImage (S i) op = withGenImage i op ++-- Ok. this is just the example why I need image types+withUniPtr with x fun = with x $ \y -> + fun (castPtr y)++withGenImage = withUniPtr withImage+withGenBareImage = withUniPtr withBareImage++{#pointer *IplImage as BareImage foreign newtype#}++foreign import ccall "& wrapReleaseImage" releaseImage :: FinalizerPtr BareImage++instance NFData (Image a b) where+ rnf a@(S (BareImage 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 . S . BareImage $ fptr++creatingBareImage fun = do+ iptr <- fun+-- {#call incrImageC#} -- Uncomment this line to get statistics of number of images allocated by ghc+ fptr <- newForeignPtr releaseImage iptr+ return . BareImage $ fptr++unImage (S (BareImage fptr)) = fptr++data Tag tp;+rgb = undefined :: Tag RGB+rgba = undefined :: Tag RGBA+lab = undefined :: Tag LAB+++composeMultichannelImage :: (CreateImage (Image tp a)) => Maybe (Image GrayScale a) -> Maybe (Image GrayScale a) -> Maybe (Image GrayScale a) -> Maybe (Image GrayScale a) -> Tag tp -> Image tp a+composeMultichannelImage (c1) + (c2)+ (c3)+ (c4)+ totag+ = unsafePerformIO $ do+ res <- create (size) -- TODO: Check channel count -- This is NOT correct+ 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++loadImage :: FilePath -> IO (Maybe (Image GrayScale D32))+loadImage n = do+ exists <- fileExist n+ if not exists then return Nothing+ else do+ i <- withCString n $ \name -> + creatingBareImage ({#call cvLoadImage #} name (0))+ bw <- imageTo32F i+ return . Just . S $ bw++loadColorImage :: FilePath -> IO (Maybe (Image RGB D32))+loadColorImage n = do+ exists <- fileExist n+ if not exists then return Nothing+ else do+ i <- withCString n $ \name -> + creatingBareImage ({#call cvLoadImage #} name 1)+ bw <- imageTo32F i+ return . Just . S $ bw++class IntSized a where+ getSize :: a -> (Int,Int)++instance IntSized BareImage where+ -- getSize :: (Integral a, Integral b) => Image c d -> (a,b)+ getSize image = unsafePerformIO $ withBareImage image $ \i -> do+ w <- {#call getImageWidth#} i+ h <- {#call getImageHeight#} i+ return (fromIntegral w,fromIntegral h)++instance IntSized (Image c d) where+ getSize = getSize . unS+++cvRGBtoGRAY = 7 :: CInt-- NOTE: This will break.+cvRGBtoLAB = 45 :: CInt-- NOTE: This will break.+++rgbToLab :: Image RGB D32 -> Image LAB D32+rgbToLab = S . convertTo cvRGBtoLAB 3 . unS++rgbToGray :: Image RGB D32 -> Image GrayScale D32+rgbToGray = S . convertTo cvRGBtoGRAY 1 . unS+++class GetPixel a where+ type P a :: *+ getPixel :: (Integral i) => (i,i) -> a -> P a++instance GetPixel (Image GrayScale D32) where+ type P (Image GrayScale D32) = D32 + getPixel (fromIntegral -> x, fromIntegral -> y) image = realToFrac $ unsafePerformIO $+ withGenImage image $ \img -> {#call wrapGet32F2D#} img y x++instance GetPixel (Image RGB D32) where+ type P (Image RGB D32) = (D32,D32,D32) + getPixel (fromIntegral -> x, fromIntegral -> y) image + = unsafePerformIO $ do + withGenImage image $ \img -> do+ r <- {#call wrapGet32F2DC#} img y x 0+ g <- {#call wrapGet32F2DC#} img y x 1+ b <- {#call wrapGet32F2DC#} img y x 2+ return (realToFrac r,realToFrac g, realToFrac b)+++convertTo :: CInt -> CInt -> BareImage -> BareImage+convertTo code channels img = unsafePerformIO $ creatingBareImage $ do+ res <- {#call wrapCreateImage32F#} w h channels+ withBareImage img $ \cimg -> + {#call cvCvtColor#} (castPtr cimg) (castPtr res) code+ return res+ where + (fromIntegral -> w,fromIntegral -> h) = getSize img++class CreateImage a where+ create :: (Int,Int) -> IO a+++instance CreateImage (Image GrayScale D32) where+ create (w,h) = creatingImage $ {#call wrapCreateImage32F#} (fromIntegral w) (fromIntegral h) 1+instance CreateImage (Image LAB D32) where+ create (w,h) = creatingImage $ {#call wrapCreateImage32F#} (fromIntegral w) (fromIntegral h) 3+instance CreateImage (Image RGB D32) where+ create (w,h) = creatingImage $ {#call wrapCreateImage32F#} (fromIntegral w) (fromIntegral h) 3+instance CreateImage (Image RGBA D32) where+ create (w,h) = creatingImage $ {#call wrapCreateImage32F#} (fromIntegral w) (fromIntegral h) 4++instance CreateImage (Image GrayScale D64) where+ create (w,h) = creatingImage $ {#call wrapCreateImage64F#} (fromIntegral w) (fromIntegral h) 1+instance CreateImage (Image LAB D64) where+ create (w,h) = creatingImage $ {#call wrapCreateImage64F#} (fromIntegral w) (fromIntegral h) 3+instance CreateImage (Image RGB D64) where+ create (w,h) = creatingImage $ {#call wrapCreateImage64F#} (fromIntegral w) (fromIntegral h) 3+instance CreateImage (Image RGBA D64) where+ create (w,h) = creatingImage $ {#call wrapCreateImage64F#} (fromIntegral w) (fromIntegral h) 4++instance CreateImage (Image GrayScale D8) where+ create (w,h) = creatingImage $ {#call wrapCreateImage8U#} (fromIntegral w) (fromIntegral h) 1+instance CreateImage (Image LAB D8) where+ create (w,h) = creatingImage $ {#call wrapCreateImage8U#} (fromIntegral w) (fromIntegral h) 3+instance CreateImage (Image RGB D8) where+ create (w,h) = creatingImage $ {#call wrapCreateImage8U#} (fromIntegral w) (fromIntegral h) 3+instance CreateImage (Image RGBA D8) where+ create (w,h) = creatingImage $ {#call wrapCreateImage8U#} (fromIntegral w) (fromIntegral h) 4++++empty :: (CreateImage (Image a b)) => (Int,Int) -> (Image a b)+empty size = unsafePerformIO $ create size ++emptyCopy :: (CreateImage (Image a b)) => Image a b -> IO (Image a b)+emptyCopy img = create (getSize img) ++emptyCopy' :: (CreateImage (Image a b)) => Image a b -> (Image a b)+emptyCopy' img = unsafePerformIO $ create (getSize img) ++-- | Save image. This will convert the image to 8 bit one before saving+saveImage :: FilePath -> Image c d -> IO ()+saveImage filename image = do+ fpi <- imageTo8Bit $ unS image+ withCString filename $ \name -> + withGenBareImage fpi $ \cvArr ->+ alloca (\defs -> poke defs 0 >> {#call cvSaveImage #} name cvArr defs >> return ())+++getArea :: (IntSized a) => a -> Int+getArea = uncurry (*).getSize++getRegion :: (Int,Int) -> (Int,Int) -> Image c d -> Image c d+getRegion (fromIntegral -> x,fromIntegral -> y) (fromIntegral -> w,fromIntegral -> h) image + | x+w <= width && y+h <= height = S . getRegion' (x,y) (w,h) $ unS image+ | otherwise = error $ "Region outside image:"+ ++ show (getSize image) +++ "/"++show (x+w,y+h)+ where+ (fromIntegral -> width,fromIntegral -> height) = getSize image+ +getRegion' (x,y) (w,h) image = unsafePerformIO $+ withBareImage image $ \i ->+ creatingBareImage ({#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. +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 (fromIntegral y) (fromIntegral x))+ where + ((w1,h1),(w2,h2)) = (getSize image1,getSize image2)+ badSizes = x+w2>w1 || y+h2>h1 || x<0 || y<0++blitM :: (CreateImage (Image c d)) => (Int,Int) -> [((Int,Int),Image c d)] -> Image c d+blitM (rw,rh) imgs = resultPic+ where+ resultPic = unsafePerformIO $ do+ r <- create (fromIntegral rw,fromIntegral rh) + sequence_ [blit r i (fromIntegral x, fromIntegral y) + | ((x,y),i) <- imgs ]+ return r+++subPixelBlit+ :: Image c d -> Image c d -> (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++unsafeImageTo32F img = unsafePerformIO $ withGenImage img $ \image -> + creatingImage + ({#call ensure32F #} image)++unsafeImageTo8Bit :: Image cspace a -> Image cspace D8+unsafeImageTo8Bit img = unsafePerformIO $ withGenImage img $ \image -> + creatingImage + ({#call ensure8U #} image)++imageTo32F img = withGenBareImage img $ \image -> + creatingBareImage + ({#call ensure32F #} image)++imageTo8Bit img = withGenBareImage img $ \image -> + creatingBareImage + ({#call ensure8U #} image)+#c+enum ImageDepth {+ Depth32F = IPL_DEPTH_32F,+ Depth64F = IPL_DEPTH_64F,+ Depth8U = IPL_DEPTH_8U, + Depth8S = IPL_DEPTH_8S, + Depth16U = IPL_DEPTH_16U, + Depth16S = IPL_DEPTH_16S,+ Depth32S = IPL_DEPTH_32S+ };+#endc+ +{#enum ImageDepth {}#}++getImageDepth i = withImage i $ \c_img -> {#get IplImage->depth #} c_img++-- Manipulating regions of interest:+setROI (fromIntegral -> x,fromIntegral -> y) + (fromIntegral -> w,fromIntegral -> 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+++-- #TODO: Replace the Int below with proper channel identifier+getChannel :: (Enum a) => a -> Image (ChannelOf a) d -> Image GrayScale d+getChannel no image = unsafePerformIO $ creatingImage $ do+ let (w,h) = getSize image+ setCOI (1+fromEnum no) image+ cres <- {#call wrapCreateImage32F#} (fromIntegral w) (fromIntegral h) 1+ withGenImage image $ \cimage ->+ {#call cvCopy#} cimage (castPtr cres) (nullPtr)+ resetCOI image+ return cres++withIOROI pos size image op = do+ setROI pos size image+ x <- op+ resetROI image+ return x++withROI :: (Int, Int) -> (Int, Int) -> Image c d -> (Image c d -> a) -> a+withROI pos size image op = unsafePerformIO $ do+ setROI pos size image+ let x = op image -- BUG+ resetROI image+ return x++-- Manipulating image pixels+--setPixel :: (CInt,CInt) -> CDouble -> Image c d -> IO ()+setPixel :: (Int,Int) -> D32 -> Image GrayScale D32 -> IO ()+setPixel (x,y) v image = withGenImage image $ \img ->+ {#call wrapSet32F2D#} img (fromIntegral y) (fromIntegral x) (realToFrac v)+++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 :: (CreateImage (Image c d)) => (Int,Int) -> Int -> [Image c d] -> Image c d+montage (u',v') space' imgs + | u'*v' /= (length imgs) = error ("Montage mismatch: "++show (u,v, length imgs))+ | otherwise = 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 <- create (rw,rh)+ sequence_ [blit r i (edge + x*xstep, edge + y*ystep) + | y <- [0..v-1] , x <- [0..u-1] + | i <- imgs ]+ return r+
+ CV/ImageMath.chs view
@@ -0,0 +1,311 @@+{-#LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, FlexibleContexts#-}+#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 Control.Applicative ((<$>))++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+addOp imageToBeAdded = ImgOp $ \target ->+ withGenImage target $ \ctarget -> + withGenImage imageToBeAdded $ \cadd ->+ {#call cvAdd#} ctarget cadd ctarget nullPtr++add = mkBinaryImageOp $ abcNullPtr {#call cvAdd#}+sub = mkBinaryImageOp $ abcNullPtr {#call cvSub#}+subFrom what = ImgOp $ \from ->+ withGenImage from $ \ifrom -> + withGenImage what $ \iwhat ->+ {#call cvSub#} ifrom iwhat ifrom nullPtr++logOp :: ImageOperation GrayScale D32+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 <- create (w,h) + 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 (realToFrac av) i -- TODO: check C datatype sizes++-- Logical inversion of image (Ie. invert, but stay on [0..1] range)+invert i = addS 1 $ mulS (-1) i++absOp = ImgOp $ \image -> do+ withGenImage image $ \i -> + {#call wrapAbsDiffS#} i 0 i++abs = unsafeOperate absOp++subtractMeanOp :: ImageOperation GrayScale D32+subtractMeanOp = ImgOp $ \image -> do+ let s = CV.ImageMath.sum image+ let mean = s / (fromIntegral $ getArea image )+ let (ImgOp subop) = subRSOp (realToFrac mean)+ subop image++subRSOp :: D32 -> ImageOperation GrayScale D32+subRSOp scalar = ImgOp $ \a -> + withGenImage a $ \ia -> do+ {#call wrapSubRS#} ia (realToFrac scalar) ia ++subRS s a= unsafeOperate (subRSOp s) a++subSOp scalar = ImgOp $ \a -> + withGenImage a $ \ia -> do+ {#call wrapSubS#} ia (realToFrac scalar) ia ++subS a s = unsafeOperate (subSOp s) a++-- Multiply the image with scalar +mulSOp :: D32 -> ImageOperation GrayScale D32+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 (realToFrac scalar) ia + return ()+ -- where s = realToFrac scalar + -- I've heard this will lose information++-- TODO: Relax the addition so it works on multiple image depths+addSOp :: D32 -> ImageOperation GrayScale D32+addSOp = mkImgScalarOp $ {#call wrapAddS#}+addS s = unsafeOperate $ addSOp s++minSOp = mkImgScalarOp $ {#call cvMinS#} +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++-- TODO: For some reason the below was going through 8U images. Investigate+mkCmpOp :: CInt -> D32 -> (Image GrayScale D32 -> Image GrayScale D8)+mkCmpOp cmp = \scalar a -> unsafePerformIO $ do+ withGenImage a $ \ia -> do+ new <- create (getSize a) --8UC1+ withGenImage new $ \cl -> do+ {#call cvCmpS#} ia (realToFrac scalar) cl cmp+ --imageTo32F new+ return new++-- TODO: For some reason the below was going through 8U images. Investigate+mkCmp2Op :: (CreateImage (Image GrayScale d)) => + CInt -> (Image GrayScale d -> Image GrayScale d -> Image GrayScale D8)+mkCmp2Op cmp = \imgA imgB -> unsafePerformIO $ do+ withGenImage imgA $ \ia -> do+ withGenImage imgB $ \ib -> do+ new <- create (getSize imgA) -- 8U+ withGenImage new $ \cl -> do+ {#call cvCmp#} ia ib cl cmp+ return new+ --imageTo32F new++-- Compare Image to Scalar+lessThan, moreThan :: D32 -> Image GrayScale D32 ->Image GrayScale D8++lessThan = mkCmpOp cmpLT+moreThan = mkCmpOp cmpGT++less2Than,lessEq2Than,more2Than :: (CreateImage (Image GrayScale d)) => Image GrayScale d + -> Image GrayScale d -> Image GrayScale D8 +less2Than = mkCmp2Op cmpLT+lessEq2Than = mkCmp2Op cmpLE+more2Than = mkCmp2Op cmpGT++-- Statistics+average' :: Image GrayScale a -> IO D32+average' img = withGenImage img $ \image -> -- TODO: Check c datatype size+ {#call wrapAvg#} image >>= return . realToFrac ++average :: Image GrayScale D32 -> D32+average = realToFrac.unsafePerformIO.average'++-- | Sum the pixels in the image. Notice that OpenCV automatically casts the+-- result to double sum :: Image GrayScale D32 -> D32+sum :: Image GrayScale a -> Double+sum img = realToFrac $ 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 :: Image GrayScale D32 -> D32+stdDeviation = realToFrac . unsafePerformIO . stdDeviation' ++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' + { withGenBareImage* `BareImage'+ , withGenBareImage* `BareImage'+ , alloca- `D32' peekFloatConv*+ , alloca- `D32' peekFloatConv*} -- TODO: Check datatype sizes used in C!+ -> `()'#}++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 <- fromIntegral <$> peek ptrintminx;+ miny <- fromIntegral <$> peek ptrintminy;+ maxx <- fromIntegral <$> peek ptrintmaxx;+ maxy <- fromIntegral <$> peek ptrintmaxy;+ maxval <- realToFrac <$> peek ptrintmax;+ minval <- realToFrac <$> peek ptrintmin;+ return (((minx,miny),minval),((maxx,maxy),maxval));}++findMinMax i = unsafePerformIO $ do+ nullp <- newForeignPtr_ nullPtr+ (findMinMax' (unS i) (BareImage nullp)) ++-- |Find minimum and maximum value of image i in area specified by the mask.+findMinMaxMask i mask = unsafePerformIO (findMinMax' i mask) +-- let a = getAllPixels i in (minimum a,maximum a)++maxValue,minValue :: Image GrayScale D32 -> D32+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 :: (Int,Int) -> (Double,Double) -> Image GrayScale D32+gaussianImage (w,h) (stdX,stdY) = unsafePerformIO $ do+ dst <- create (w,h) -- 32F_C1+ 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) .+-- TODO: Fix C-code of masked_merge to accept D8 input for the mask+maskedMerge :: Image GrayScale D8 -> Image GrayScale D32 -> Image GrayScale D32 -> Image GrayScale D32+maskedMerge mask img img2 = unsafePerformIO $ do+ res <- create (getSize img) -- 32FC1+ withImage img $ \cimg ->+ withImage img2 $ \cimg2 ->+ withImage res $ \cres ->+ withImage (unsafeImageTo32F mask) $ \cmask ->+ {#call masked_merge#} cimg cmask cimg2 cres+ return res++++-- | Given a distance map and a circle, return the biggest circle with radius less+-- than given in the distance map that fully covers the previous one++maximalCoveringCircle distMap (x,y,r) + = unsafePerformIO $ + withImage distMap $ \c_distmap ->+ alloca $ \(ptr_int_max_x :: Ptr CInt) ->+ alloca $ \(ptr_int_max_y :: Ptr CInt) ->+ alloca $ \(ptr_double_max_r :: Ptr CDouble) -> + do+ {#call maximal_covering_circle#} x y r c_distmap ptr_int_max_x ptr_int_max_y ptr_double_max_r+ max_x <- fromIntegral <$> peek ptr_int_max_x+ max_y <- fromIntegral <$> peek ptr_int_max_y+ max_r <- realToFrac <$> peek ptr_double_max_r+ return (max_x,max_y,max_r)++ ++
+ CV/ImageMathOp.hs view
@@ -0,0 +1,28 @@+{-#LANGUAGE FlexibleContexts#-}+module CV.ImageMathOp where+import CV.Image+import CV.ImageMath as IM+import Data.List(iterate)++(#+), (#-), (#*) :: (CreateImage (Image c d)) => Image c d -> Image c d -> Image c d+(#+) = IM.add+(#-) = IM.sub+(#*) = IM.mul++(#<), (#>) :: (CreateImage (Image GrayScale d)) => Image GrayScale d -> Image GrayScale d + -> Image GrayScale D8+(#<) = IM.less2Than+(#>) = IM.more2Than++(|*), (|+), (-|) :: D32 -> Image GrayScale D32 -> Image GrayScale D32+(|*) = IM.mulS+(|+) = IM.addS+(-|) = IM.subRS++(|>), (|<) :: D32 -> Image GrayScale D32 -> Image GrayScale D8+(|>) = IM.moreThan+(|<) = IM.lessThan+-- (|^) i n = (iterate (#* i) i) !! (n-1)++(|-) :: Image GrayScale D32 -> D32 -> Image GrayScale D32+(|-) = IM.subS
+ CV/ImageOp.hs view
@@ -0,0 +1,41 @@+module CV.ImageOp where++import Foreign+import CV.Image++-- |ImageOperation is a device for mutating images inplace.+newtype ImageOperation c d= ImgOp (Image c d-> IO ())++-- |Compose two image operations+(#>) :: ImageOperation c d-> ImageOperation c d -> ImageOperation c d+(#>) (ImgOp a) (ImgOp b) = ImgOp (\img -> (a img >> b img))++-- |An unit operation for compose (#>) +nonOp = ImgOp (\i -> return ())++-- |Apply image operation to a Copy of an image+img <# op = unsafeOperate op img++-- |Apply list of image operations to a Copy of an image. (Makes a single copy and is+-- faster than folding over (<#)+img <## [] = img+img <## op = unsafeOperate (foldl1 (#>) op) img++-- |Iterate an operation N times+times n op = foldl (#>) nonOp (replicate n op) ++-- This could, if I take enough care, be pure.+runImageOperation :: Image c d -> ImageOperation c d -> IO (Image c d)+runImageOperation img (ImgOp op) = withClone img $ \clone -> + op clone >> return clone++directOp i (ImgOp op) = op i+operateInPlace (ImgOp op) img = op img ++operate op img = runImageOperation img op+operateOn = runImageOperation+unsafeOperate op img = unsafePerformIO $ operate op img+unsafeOperateOn img op = unsafePerformIO $ operate op img++operateWithROI pos size (ImgOp op) img = withClone img $ \clone ->+ withIOROI pos size clone (op clone)
+ CV/LightBalance.chs view
@@ -0,0 +1,18 @@+{-#LANGUAGE ForeignFunctionInterface, ViewPatterns#-}+#include "cvWrapLEO.h"+module CV.LightBalance where++import Foreign.C.Types+import Foreign.Ptr++import C2HSTools+{#import CV.Image#}+f::Int -> CInt+f = fromIntegral+x2cylinder (f->w,f->h) m s c = unsafePerformIO $ creatingImage ({#call vignettingModelX2Cyl#} w h + (realToFrac m) (realToFrac s) (realToFrac c))+cos4cylinder (f->w,f->h) = unsafePerformIO $ creatingImage ({#call vignettingModelCos4XCyl#} w h)+cos4vignetting (f->w,f->h) = unsafePerformIO $ creatingImage ({#call vignettingModelCos4#} w h)+threeB (f->w,f->h) b1 b2 b3 = unsafePerformIO $ creatingImage ({#call vignettingModelB3#} w h b1 b2 b3)+twoPar (f->w,f->h) sx sy m = unsafePerformIO $ creatingImage ({#call vignettingModelP#} w h sx sy m)+
+ CV/Marking.hs view
@@ -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 Edges.l1 $ 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 l1 +++type Marker c d = (Int,Int) -> (Int,Int)+ -> ImageOperation c d++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 1+ (x,y) (w*2) (Stroked 1) ImageOp.#> circleOp 0 (x,y) (w*2-1) (Stroked 1) + where w = 2 ++cuteCircle1 (x,y) = + circleOp 1 + (x+w,y+w) (w*2) (Stroked 1) ImageOp.#> circleOp 0 (x+w,y+w) (w*2-1) (Stroked 1) + where w = 6 ++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 GrayScale D32+cuteCircle (tw,th) (x,y) = + (circleOp 1+ (x+tw`div`2,y+tw`div`2) (w) (Stroked 1) ) ImageOp.#> circleOp 0 (x+tw`div`2,y+tw`div`2) (w-1) (Stroked 1) + 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 + +
+ CV/Morphology.chs view
@@ -0,0 +1,144 @@+{-#LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, UnicodeSyntax#-}+#include "cvWrapLEO.h"+module CV.Morphology (StructuringElement+ ,structuringElement+ ,customSE+ ,basicSE,bigSE+ ,geodesic+ ,openOp,closeOp+ ,open,close+ ,erode,dilate+ ,blackTopHat,whiteTopHat+ ,dilateOp,erodeOp,KernelShape(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 GrayScale D32+openOp se = erodeOp se 1 #> dilateOp se 1 +open se = unsafeOperate (openOp se) +a ○ b = open b a+-- a ○ b = (a ⊖ b) ⊕ b +++-- Morphological closing+closeOp :: StructuringElement -> ImageOperation GrayScale D32+closeOp se = dilateOp se 1 #> erodeOp se 1 +close se = unsafeOperate (closeOp se) +a ● b = close b a++geodesic :: Image GrayScale D32 -> ImageOperation GrayScale D32 -> ImageOperation GrayScale D32+geodesic mask op = op #> IM.limitToOp mask++-- | Perform a black tophat filtering of size+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++-- | Perform a white tophat filtering of size+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+#c+enum KernelShape {+ RectShape = CV_SHAPE_RECT+ ,CrossShape = CV_SHAPE_CROSS+ ,EllipseShape = CV_SHAPE_ELLIPSE+ ,CustomShape = CV_SHAPE_CUSTOM+ };+#endc+{#enum KernelShape {} #}++{#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<w && y<h + = True++ | otherwise = False +++-- Create a structuring element for morphological operations+structuringElement s d | isGoodSE s d = createSE s d + | otherwise = error "Bad values in structuring element"++-- Create SE with custom shape that is taken from flat list shape.+createSE (w,h) (x,y) shape = unsafePerformIO $ do+ iptr <- {#call cvCreateStructuringElementEx#}+ w h x y (fromIntegral . fromEnum $ shape) nullPtr+ fptr <- newForeignPtr releaseSE iptr+ return (ConvKernel fptr)++customSE s@(w,h) o shape | isGoodSE s o + && length shape == fromIntegral (w*h)+ = createCustomSE s o shape++createCustomSE (w,h) (x,y) shape = unsafePerformIO $ do+ iptr <- withArray shape $ \arr ->+ {#call cvCreateStructuringElementEx#}+ w h x y (fromIntegral . fromEnum $ CustomShape) arr+ fptr <- newForeignPtr releaseSE iptr+ return (ConvKernel fptr)++{#fun cvErode as erosion + {withGenBareImage* `BareImage'+ ,withGenBareImage* `BareImage'+ ,withConvKernel* `ConvKernel'+ ,`Int'} -> `()' #}+{#fun cvDilate as dilation + {withGenBareImage* `BareImage'+ ,withGenBareImage* `BareImage'+ ,withConvKernel* `ConvKernel'+ ,`Int'} -> `()' #}+++erodeOp se count = ImgOp $ \(S img) -> erosion img img se count+dilateOp se count = ImgOp $ \(S img) -> dilation img img se count++erode se count i = unsafeOperate (erodeOp se count) i+dilate se count i = unsafeOperate (dilateOp se count) i++a ⊕ b = erode b 1 a+a ⊖ b = erode b 1 a+ +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
+ CV/MultiresolutionSpline.hs view
@@ -0,0 +1,32 @@+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.+-- Notice, that the mask should contain a tiny blurred region between images +burtAdelsonMerge :: Int -> Image GrayScale D8 -> Image GrayScale D32 -> Image GrayScale D32 + -> Image GrayScale D32+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 [img1,img2]++[getSize mask]+ badSize = any (\(x,y) -> notDivisible x || notDivisible y) sizes+ maskPyr = reverse $ take levels $ iterate pyrDown $ mask+ pyr = laplacianPyramid levels img1+ pyr2 = laplacianPyramid levels img2 + pyrMerge = zipWith3 IM.maskedMerge maskPyr pyr2 pyr+
+ CV/Sampling.hs view
@@ -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)++-- 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+getTilesC size image = getOverlappedTilesC 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 s o i = map snd $ getOverlappedTilesC s o i +getOverlappedTilesC :: (Int,Int) -> (CDouble,CDouble) -> Image c d -> [((Int,Int),Image c d)]+getOverlappedTilesC size overlap image + = map (\c -> (both fromIntegral c,getRegion c size image))+ $ getOverlappedTileCoords size + overlap image+both f (a,b) = (f a, f b)+ +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) = vb<x && x< iw-vb+ && hb<y && y< ih-hb+++-- Retrive coordinates of white pixels (>0.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 -> (Int,Int) -> m [(Int,Int)]+--randomCoords count area = replicateM count $ randomCoord area++--randomCoord :: MonadRandom m => (Int,Int) -> m (Int,Int)+--randomCoord (w,h) = do+-- x <- (getRandomR (0::Int,fromIntegral $ w-1))+-- y <- (getRandomR (0::Int,fromIntegral $ h-1))+-- return (x,y)
+ CV/TemplateMatching.chs view
@@ -0,0 +1,100 @@+{-#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 hiding (scale)++{#import CV.Image#}+import C2HSTools++getTemplateMap image template = unsafePerformIO $+ withImage image $ \cvimg ->+ withImage template $ \cvtemp ->+ creatingImage $ {#call templateImage#} cvimg cvtemp+ ++#c+enum MatchType {+ SQDIFF = CV_TM_SQDIFF+ ,SQDIFF_NORMED = CV_TM_SQDIFF_NORMED+ ,CCORR = CV_TM_CCORR+ ,CCORR_NORMED = CV_TM_CCORR_NORMED+ ,CCOEFF = CV_TM_CCOEFF+ ,CCOEFF_NORMED = CV_TM_CCOEFF_NORMED+};+#endc+{#enum MatchType {}#}+++simpleTemplateMatch :: MatchType -> Image GrayScale D32 -> Image GrayScale D32 -> ((Int,Int),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 ((fromIntegral x,fromIntegral y),realToFrac v); }++matchTemplate :: MatchType-> Image GrayScale D32 -> Image GrayScale D32 -> Image GrayScale D32 +matchTemplate mt image template = unsafePerformIO $ do+ let isize = getSize image+ tsize = getSize template+ size = isize - tsize + (1,1) + res <- create size + 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+subPixelTemplateMatch :: MatchType -> Image GrayScale D32 -> Image GrayScale D32 -> Double -> (Double,Double)+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 CCORR_NORMED image template+ (tx,ty) = (orX-otw`div`2, orY-oth`div`2)++ bigTempl = scaleSingleRatio Linear n template+ (tw,th) = getSize bigTempl+ region = scaleSingleRatio Linear n . getRegion (tx,ty) (otw*2,oth*2) $ image+ ((sbx,sby),_) = simpleTemplateMatch CCORR_NORMED region bigTempl+ +regionToInt rc = mkRectangle (floor x,floor y) (ceiling w,ceiling h)+ where+ (x,y) = topLeft rc+ (w,h) = rSize rc++#c+enum ShapeMatchMethod {+ Method1 = CV_CONTOURS_MATCH_I1,+ Method2 = CV_CONTOURS_MATCH_I2,+ Method3 = CV_CONTOURS_MATCH_I3+};+#endc+{#enum ShapeMatchMethod {}#}+++-- | Match shapes+matchShapes :: ShapeMatchMethod -> Image GrayScale D8 -> Image GrayScale D8 -> Double+matchShapes m a b = unsafePerformIO $ do+ withGenImage a $ \c_a ->+ withGenImage b $ \c_b ->+ {#call cvMatchShapes#} c_a c_b (fromIntegral . fromEnum $ m) 0 + >>= return.realToFrac
+ CV/Textures.chs view
@@ -0,0 +1,46 @@+{-#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#}+++-- | Various simple Local Binary Pattern operators++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++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
+ CV/Thresholding.hs view
@@ -0,0 +1,76 @@+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+++-- TODO: Convert Histograms from Doubles to Floats..+otsu bs image = IM.moreThan (realToFrac threshold) image+ where+ histogram = getHistogram bs $ image+ partitions = histogramPartitions histogram + (threshold,_,_) = maximumBy (comparing otsuCmp) partitions + otsuCmp (t,as,bs) = betweenClassVariance (as) (bs)++-- This is excruciatingly slow means of finding kittler-illingworth threshold+-- for an image+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 = unsafeImageTo32F (IM.lessThan t image)+ p_t = IM.sum ( thresholded) / fromIntegral (getArea image)+ bgDev = realToFrac $ IM.stdDeviationMask image thresholded + fgDev = realToFrac $ IM.stdDeviationMask image (IM.invert thresholded)+++histogramPartitions (HGD a) = zip3 (head.tails.map fst $ a) + (tail.inits.map snd $ a) + (reverse.tail.reverse.tails.map snd $ a)++betweenClassVariance as bs = sum as * sum bs + * (average bs - average as)^2+
+ CV/Transforms.chs view
@@ -0,0 +1,256 @@+{-#LANGUAGE ForeignFunctionInterface, ViewPatterns, ScopedTypeVariables, PatternGuards, FlexibleContexts#-}+#include "cvWrapLEO.h"+-- |Various image transformations from opencv and other sources.+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"++-- |Perform Inverse Discrete Cosine Transform+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)++-- |Mirror an image over a cardinal axis+flip axis img = unsafePerformIO $ do+ 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)++-- |Simulate a radial distortion over an image+radialDistort :: Image GrayScale D32 -> Double -> Image GrayScale D32+radialDistort img k = unsafePerformIO $ do+ target <- emptyCopy img + withImage img $ \cimg ->+ withImage target $ \ctarget ->+ {#call radialRemap#} cimg ctarget (realToFrac k)+ return target++-- |Scale image by one ratio on both of the axes+scaleSingleRatio tpe x img = scale tpe (x,x) img+++-- |Scale an image with different ratios for axes+scale :: (RealFloat a) => Interpolation -> (a,a) -> Image GrayScale D32 -> Image GrayScale D32+scale tpe (x,y) img = unsafePerformIO $ do+ target <- create (w',h') + 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*y+ ,round $ fromIntegral h*x)++-- |Scale an image to a given size+scaleToSize :: Interpolation -> Bool -> (Int,Int) -> Image GrayScale D32 -> Image GrayScale D32+scaleToSize tpe retainRatio (w,h) img = unsafePerformIO $ do+ target <- create (w',h') + 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)++-- | DEPRECATED: A simple one parameter shrinking of the image+oneParamPerspective img k+ = unsafePerformIO $ + withImage img $ \cimg -> creatingImage $ {#call simplePerspective#} k cimg++-- |Apply a perspective transform to the image. The transformation 3x3 matrix is supplied as+-- a row ordered, flat, list.+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+++-- |Find a homography between two sets of points in. The resulting 3x3 matrix is returned as a list.+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+-- |Return a copy of an image with an even size+evenize img = if (odd w || odd h)+ then + unsafePerformIO $ + creatingImage $+ withGenImage img $ \cImg -> {#call makeEvenUp#} cImg+ else img+ where+ (w,h) = getSize img++-- |Return a copy of an image with an odd size+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++-- |Pad images to same size+sameSizePad img img2 = if (size1 /= size2)+ then unsafePerformIO $ do+ r <- creatingImage $+ withGenImage img2 $ \cImg -> {#call padUp#} cImg (toI $ w2<w1) (toI $ h2<h1)+ if getSize r /= getSize img + then error ("Couldn't pad: "++show size1++"/"++show size2) + else return r+ else img+ where+ toI True = 1+ toI False = 0+ size1@(w1,h1) = getSize img+ size2@(w2,h2) = getSize img2++++cv_Gaussian = 7+-- |Downsize image by 50% efficiently. Image dimensions must be even.+pyrDown ::(CreateImage (Image GrayScale a)) => Image GrayScale a -> Image GrayScale a+pyrDown image = unsafePerformIO $ do+ res <- create size + 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 ++-- |Enlarge image to double in each dimension. Used to recover pyramidal layers+pyrUp :: (CreateImage (Image GrayScale a)) => Image GrayScale a -> Image GrayScale a+pyrUp image = unsafePerformIO $ do+ res <- create size + 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 ++-- |Calculate the laplacian pyramid of an image up to the nth level.+-- Notice that the image size must be divisible by 2^n or opencv +-- will abort (TODO!)+laplacianPyramid :: Int -> Image GrayScale D32 -> [Image GrayScale D32]+laplacianPyramid depth image = reverse laplacian+ where+ downs :: [Image GrayScale D32] = take depth $ iterate pyrDown (image)+ upsampled :: [Image GrayScale D32] = 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 ++-- TODO: Could have wider type+-- |Enlarge image so, that it's size is divisible by 2^n +enlarge :: Int -> Image GrayScale D32 -> Image GrayScale D32+enlarge n img = unsafePerformIO $ do+ i <- create (w2,h2)+ 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++#c+enum DistanceType {+ C = CV_DIST_C+ ,L1 = CV_DIST_L1+ ,L2 = CV_DIST_L2+};+#endc+{#enum DistanceType {}#}++-- |Mask sizes accepted by distanceTransform+data MaskSize = M3 | M5 deriving (Eq,Ord,Enum,Show)++-- |Perform a distance transform on the image+distanceTransform :: DistanceType -> MaskSize -> Image GrayScale D8 -> Image GrayScale D32 --TODO: Input should be a black and white image+distanceTransform dtype maskSize source = unsafePerformIO $ do+ result :: Image GrayScale D32 <- create (getSize source)+ withGenImage source $ \c_source ->+ withGenImage result $ \c_result ->+ {#call cvDistTransform #} c_source c_result + (fromIntegral . fromEnum $ dtype) + (fromIntegral . fromEnum $ maskSize)+ nullPtr nullPtr+ return result+ -- TODO: Add handling for labels+ -- TODO: Add handling for custom masks
+ CV/Video.chs view
@@ -0,0 +1,138 @@+{-#LANGUAGE ForeignFunctionInterface, ViewPatterns#-}+#include "cvWrapLEO.h"+module CV.Video where+{#import CV.Image#}++import Foreign.Marshal.Array+import Foreign.Marshal.Alloc+import Foreign.Ptr+import Foreign.ForeignPtr+import Foreign.Storable+import Foreign.C.Types+import Foreign.C.String+import System.IO.Unsafe+import Utils.Stream++-- NOTE: For some reason, this module fails to work with ghci for me++{#pointer *CvCapture as Capture foreign newtype#}++foreign import ccall "& wrapReleaseCapture" releaseCapture :: FinalizerPtr Capture++{#pointer *CvVideoWriter as VideoWriter foreign newtype#}++foreign import ccall "& wrapReleaseVideoWriter" releaseVideoWriter :: FinalizerPtr VideoWriter+-- NOTE: This use of foreignPtr is quite likely to cause trouble by retaining+-- videos longer than necessary.++type VideoStream c d = Stream IO (Image c d)++streamFromVideo cap = dropS 1 $ streamFromVideo' (undefined) cap +streamFromVideo' p cap = Value $ do+ x <- getFrame cap+ case x of+ Just f -> return (p,(streamFromVideo' f cap))+ Nothing -> return (p,Terminated)+ ++captureFromFile fn = withCString fn $ \cfn -> do+ ptr <- {#call cvCreateFileCapture#} cfn+ fptr <- newForeignPtr releaseCapture ptr+ return . Capture $ fptr++captureFromCam int = do+ ptr <- {#call cvCreateCameraCapture#} (fromIntegral int)+ if ptr==nullPtr + then + return Nothing+ else do+ fptr <- newForeignPtr releaseCapture ptr+ return . Just . Capture $ fptr++dropFrame cap = withCapture cap $ \ccap -> {#call cvGrabFrame#} ccap >> return ()++getFrame :: Capture -> IO (Maybe (Image RGB D32))+getFrame cap = withCapture cap $ \ccap -> do+ p_frame <- {#call cvQueryFrame#} ccap + if p_frame==nullPtr then return Nothing+ else creatingImage (ensure32F p_frame) >>= return . Just+ -- NOTE: This works because Image module has generated wrappers for ensure32F++-- These are likely to break..+#c+enum CapProp {+ CAP_PROP_POS_MSEC = CV_CAP_PROP_POS_MSEC + , CAP_PROP_POS_FRAMES = CV_CAP_PROP_POS_FRAMES + , CAP_PROP_POS_AVI_RATIO = CV_CAP_PROP_POS_AVI_RATIO+ , CAP_PROP_FRAME_WIDTH = CV_CAP_PROP_FRAME_WIDTH + , CAP_PROP_FRAME_HEIGHT = CV_CAP_PROP_FRAME_HEIGHT + , CAP_PROP_FPS = CV_CAP_PROP_FPS + , CAP_PROP_FOURCC = CV_CAP_PROP_FOURCC + , CAP_PROP_FRAME_COUNT = CV_CAP_PROP_FRAME_COUNT + , CAP_PROP_FORMAT = CV_CAP_PROP_FORMAT + , CAP_PROP_MODE = CV_CAP_PROP_MODE + , CAP_PROP_BRIGHTNESS = CV_CAP_PROP_BRIGHTNESS + , CAP_PROP_CONTRAST = CV_CAP_PROP_CONTRAST + , CAP_PROP_SATURATION = CV_CAP_PROP_SATURATION + , CAP_PROP_HUE = CV_CAP_PROP_HUE + , CAP_PROP_GAIN = CV_CAP_PROP_GAIN + , CAP_PROP_EXPOSURE = CV_CAP_PROP_EXPOSURE + , CAP_PROP_CONVERT_RGB = CV_CAP_PROP_CONVERT_RGB + , CAP_PROP_WHITE_BALANCE = CV_CAP_PROP_WHITE_BALANCE+ , CAP_PROP_RECTIFICATION = CV_CAP_PROP_RECTIFICATION + , CAP_PROP_MONOCROME = CV_CAP_PROP_MONOCROME +};+#endc+{#enum CapProp {}#}++fromProp = fromIntegral . fromEnum++getFrameRate cap = unsafePerformIO $+ withCapture cap $ \ccap ->+ {#call cvGetCaptureProperty#} + ccap (fromProp CAP_PROP_FPS) >>= return . realToFrac++getFrameSize cap = unsafePerformIO $+ withCapture cap $ \ccap -> do+ w <- {#call cvGetCaptureProperty#} ccap (fromProp CAP_PROP_FRAME_WIDTH) + >>= return . round+ h <- {#call cvGetCaptureProperty#} ccap (fromProp CAP_PROP_FRAME_HEIGHT)+ >>= return . round+ return (w,h)+++setCapProp cap prop val = withCapture cap $ \ccap ->+ {#call cvSetCaptureProperty#} + ccap (fromProp prop) (realToFrac val)++numberOfFrames cap = unsafePerformIO $+ withCapture cap $ \ccap ->+ {#call cvGetCaptureProperty#} + ccap (fromProp CAP_PROP_FRAME_COUNT)+ >>= return . floor++frameNumber cap = unsafePerformIO $+ withCapture cap $ \ccap ->+ {#call cvGetCaptureProperty#} + ccap (fromProp CAP_PROP_POS_FRAMES) >>= return . floor++-- Video Writing++data Codec = MPG4 deriving (Eq,Show)++createVideoWriter filename codec framerate frameSize isColor = + withCString filename $ \cfilename -> do+ ptr <- {#call wrapCreateVideoWriter#} cfilename fourcc + framerate w h ccolor+ if ptr == nullPtr then error "Could not create video writer" else return ()+ fptr <- newForeignPtr releaseVideoWriter ptr+ return . VideoWriter $ fptr+ where+ (w,h) = frameSize+ ccolor | isColor = 1+ | otherwise = 0+ fourcc | codec == MPG4 = 0x4d504734 -- This is so wrong..++writeFrame writer img = withVideoWriter writer $ \cwriter ->+ withImage img $ \cimg -> + {#call cvWriteFrame #} cwriter cimg
+ CV/cvWrapLEO.c view
@@ -0,0 +1,2244 @@+//@+leo-ver=4-thin+//@+node:aleator.20050908100314:@thin cvWrapLEO.c+//@@language c++//@+all+//@+node:aleator.20050908100314.1:Includes+#include "cvWrapLEO.h"+#include <stdio.h>+#include <complex.h>++//@-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 wrapReleaseCapture(CvCapture *t)+{+ cvReleaseCapture(&t);+}++void wrapReleaseVideoWriter(CvCapture *t)+{+ cvReleaseCapture(&t);+}++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; i<s.width; i++)+ for(j=0; j<s.height; j++)+ {+ pixel = cvGetReal2D(src,j,i);+ maskP = mask != 0 ? cvGetReal2D(mask,j,i) : 1;+ // TODO: Fix below.. + min = (maskP >0.5 ) && (pixel < min) ? pixel : min; + max = (maskP >0.5 ) && (pixel > max) ? pixel : max; + }+ (*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];+}++double wrapGet32F2DC(CvArr *arr, int x, int y,int c)+{ + CvScalar r;+ r = cvGet2D(arr,x,y); + return r.val[c];+}+++void wrapDrawCircle(CvArr *img, int x, int y, int radius, float r,float g,float b, int thickness)+{+ cvCircle(img,cvPoint(x,y),radius,CV_RGB(r,g,b),thickness,8,0);+}++void wrapDrawText(CvArr *img, char *text, float s, int x, int y,float r,float g,float b)+{+CvFont font; //?+cvInitFont(&font, CV_FONT_HERSHEY_PLAIN, s, s, 0, 2, 8);+cvPutText(img, text, cvPoint(x,y), &font, CV_RGB(r,g,b));+}++void wrapDrawRectangle(CvArr *img, int x1, int y1, + int x2, int y2, float r, float g, float b,+ int thickness)+{+ cvRectangle(img,cvPoint(x1,y1),cvPoint(x2,y2),CV_RGB(r,g,b),thickness,8,0);+}+++void wrapDrawLine(CvArr *img, int x, int y, int x1, int y1, double r, double g, double b, int thickness)+{+ cvLine(img,cvPoint(x,y),cvPoint(x1,y1),CV_RGB(r,g,b),thickness,4,0);+}++void wrapFillPolygon(IplImage *img, int pc, int *xs, int *ys, float r, float g, float b)+{ + int i=0;+ int pSizes[] = {pc};+ CvPoint *pts = (CvPoint*)malloc(pc*sizeof(CvPoint));+ for (i=0; i<pc; ++i)+ {pts[i].x = xs[i]; + pts[i].y = ys[i]; + }+ cvFillPoly(img, &pts, pSizes, 1, CV_RGB(r,g,b), 8, 0 );+ free(pts);+}++++int getImageWidth(IplImage *img)+{+ return cvGetSize(img).width;+}+int getImageHeight(IplImage *img)+{+ return cvGetSize(img).height;+}++IplImage* getSubImage(IplImage *img, int sx,int sy,int w,int h)+{+ CvRect r;+ CvSize s;+ IplImage *newImage;+ + r.x = sx; r.y = sy;+ r.width = w; r.height = h;+ s.width = w; s.height = h;+ + cvSetImageROI(img,r);+ newImage = cvCreateImage(s,img->depth,img->nChannels);+ cvCopy(img, newImage,0);+ 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<size.width; i++)+ for (j=0; j<size.height; j++) {+ FGET(dst,i,j) = FGET(src1,i,j)*FGET(mask,i,j) + +FGET(src2,i,j)*(1-FGET(mask,i,j));+ }+}++void vertical_average(IplImage *src, IplImage *dst)+{+ int i,j;+ double avg;+ CvSize size = cvGetSize(dst);+ for (i=0; i<size.width; i++) {+ avg = 0;+ for (j=0; j<size.height; j++) { avg += FGET(src,i,j); }+ avg = avg / size.height;+ for (j=0; j<size.height; j++) { FGET(dst,i,j) = avg; }+ }+}+++IplImage* fadedEdges(int w, int h, int edgeW) {+ IplImage *result;+ int i,j;+ result = wrapCreateImage32F(w,h,1); + for (i=0; i<h; i++)+ for (j=0; j<w; j++) {+ float dx = i < (h/2.0) ? i : h-i ;+ float dy = j < (w/2.0) ? j : w-j ;+ float x = dx > 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<h; i++)+ for (j=0; j<w; j++) {+ float dx = i < (h/2.0) ? i/(h*1.0) : (h-i)/(h*1.0) ;+ float dy = j < (w/2.0) ? j/(w*1.0) : (w-j)/(w*1.0) ;+ FGET(result,j,i) = dx<dy?dx:dy;+ }+ return result;+}+IplImage* vignettingModelCos4(int w, int h) {+ IplImage *result;+ int i,j;+ double nx,ny;+ double r;+ const double x0 = w/2.0;+ const double y0 = h/2.0;+ result = wrapCreateImage32F(w,h,1); + for (i=0; i<h; i++)+ for (j=0; j<w; j++) {+ nx = (y0-i)/h;+ ny = (x0-j)/w;+ r = sqrt(nx*nx+ny*ny);+ FGET(result,j,i) = pow(cos (r),4);+ }+ return result;+}++IplImage* vignettingModelCos4XCyl(int w, int h) {+ IplImage *result;+ int i,j;+ double r;+ const double x0 = w/2.0;+ const double y0 = h/2.0;+ result = wrapCreateImage32F(w,h,1); + for (i=0; i<h; i++)+ for (j=0; j<w; j++) {+ r = fabs((i-y0)/y0) ;+ FGET(result,j,i) = pow(cos (r),4);+ }+ return result;+}++IplImage* vignettingModelX2Cyl(int w, int h,double m, double s, double c) {+ IplImage *result;+ int i,j;+ double r;+ result = wrapCreateImage32F(w,h,1); + for (i=0; i<h; i++)+ for (j=0; j<w; j++) {+ FGET(result,j,i) = -((i-c)*s)*((i-c)*s)-m;+ }+ return result;+}+inline double eucNorm(CvPoint2D64f p) {return (p.x*p.x+p.y*p.y);}++IplImage* vignettingModelB3(int w, int h,double b1, double b2, double b3) {+ IplImage *result;+ int i,j;+ double r;+ result = wrapCreateImage32F(w,h,1); + for (i=0; i<h; i++)+ for (j=0; j<w; j++) {+ CvPoint2D64f nor = toNormalizedCoords(cvSize(w,h),cvPoint(j,i));+ r = eucNorm(nor);+ FGET(result,j,i) = b3*pow(r,6)+b2*pow(r,4)+b3*pow(r,2)+1;+ }+ return result;+}+IplImage* vignettingModelP(int w, int h,double scalex, double scaley, double max) {+ IplImage *result;+ int i,j;+ double r;+ double mx = w/2.0;+ double my = w/2.0;+ result = wrapCreateImage32F(w,h,1); + for (i=0; i<h; i++)+ for (j=0; j<w; j++) {+ FGET(result,j,i) =-((i-my)*scaley)*((i-my)*scaley)*((j-mx)*scalex)*((j-mx)*scalex)-max ;+ }+ return result;+}++IplImage* simplePerspective(double k,IplImage *src) {+ IplImage *result;+ int i,j;+ double r;+ result = cvCloneImage(src); + int h = cvGetSize(src).height;+ int w = cvGetSize(src).width;+ CvPoint2D32f srcPts[4] = {{0,0},{w-1,0},{w-1,h-1},{0,h-1}};+ CvPoint2D32f dstPts[4] = {{-k,0},{w-1+k,0},{w-1,h-1},{0,h-1}};+ CvMat* M = cvCreateMat(3,3,CV_32FC1);+ cvGetPerspectiveTransform(srcPts, dstPts, M);+ cvWarpPerspective(src, result, M, CV_INTER_LINEAR+CV_WARP_FILL_OUTLIERS, cvScalarAll(0));+ cvReleaseMat(&M);+ return result;+}++IplImage* wrapPerspective(IplImage* src, double a1, double a2, double a3+ , double a4, double a5, double a6+ , double a7, double a8, double a9)+{+ IplImage *res = cvCloneImage(src);+ double a[] = { a1,a2,a3,+ a4,a5,a6,+ a7,a8,a9};++ CvMat M = cvMat(3,3,CV_64FC1,a);+ cvWarpPerspective(src, res, &M, CV_INTER_LINEAR+CV_WARP_FILL_OUTLIERS, cvScalarAll(0));+ return res;+}++void findHomography(double* srcPts, double *dstPts, int noPts, double *homography)+{+CvMat src = cvMat(noPts, 2, CV_64FC1, srcPts);+CvMat dst = cvMat(noPts, 2, CV_64FC1, dstPts);+CvMat *hmg = cvCreateMat(3,3,CV_32FC1);+int i;+cvFindHomography(&src, &dst, hmg, 0, 0, 0);+for (i=0;i<3*3;++i)+ homography[i] = cvmGet(hmg,i/3,i%3);+cvReleaseMat(&hmg);+}++inline CvPoint2D64f toNormalizedCoords(CvSize area, CvPoint from)+{+ CvPoint2D64f res;+ res.x = (from.x-area.width/2.0)/area.width;+ res.y = (from.y-area.height/2.0)/area.height; + return res;+}++inline CvPoint fromNormalizedCoords(CvSize area, CvPoint2D64f from)+{+ CvPoint res;+ res.x = (from.x+0.5)*area.width;+ res.y = (from.y+0.5)*area.height; + return res;+}++inline CvPoint2D64f fromNormalizedCoords64f(CvSize area, CvPoint2D64f from)+{+ CvPoint2D64f res;+ res.x = (from.x+0.5)*area.width;+ res.y = (from.y+0.5)*area.height; + return res;+}++void alphaBlit(IplImage *a, IplImage *aAlpha, IplImage *b, IplImage *bAlpha, int offset_y, int offset_x)+{+ // TODO: Add checks for image type and size+ int i,j;+ CvSize bSize = cvGetSize(b);+ CvSize aSize = cvGetSize(a);+ CvRect pos = cvRect(offset_x+ ,offset_y+ ,bSize.width+ ,bSize.height);+ for (i=0; i<bSize.height; i++)+ for (j=0; j<bSize.width; j++) {+ float aA, bA,fV;+ if (j+offset_x>=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<bSize.height; i++) {+ for (j=0; j<bSize.width; j++) {+ if (j+offset_x<0 || j+offset_x>=aSize.width || i+offset_y<0 || i+offset_y>=aSize.height ) continue;+ if (a->nChannels == 1) + {FGET(a,j+offset_x,i+offset_y) =FGET(b,j,i);}+ else if (a->nChannels ==3) + {+ int dx = j+offset_x; int dy = i+offset_y;+ ((float *)(a->imageData + dy*a->widthStep))[dx*a->nChannels + 0] =+ ((float *)(b->imageData + i*b->widthStep))[j*b->nChannels + 0] ; // B+ ((float *)(a->imageData + dy*a->widthStep))[dx*a->nChannels + 1] =+ ((float *)(b->imageData + i*b->widthStep))[j*b->nChannels + 1] ; // G+ ((float *)(a->imageData + dy*a->widthStep))[dx*a->nChannels + 2] =+ ((float *)(b->imageData + i*b->widthStep))[j*b->nChannels + 2] ; // R+ }+ else {printf("Can't blit this - pic weird number of channels\n"); abort();}++ }}+}++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<aSize.height; i++)+ for (j=0; j<aSize.width; j++) {+ double x_at_b=j-offset_x;+ double y_at_b=i-offset_y;+ if (x_at_b <0 || x_at_b >= 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;i<binCount;++i)+ {+ *values = cvQueryHistValue_1D(result,i); values++;+ }+ cvReleaseHist(&result);+ return;+}++double getHistValue(CvHistogram *h,int bin)+{+ return *cvGetHistValue_1D(h,bin);+}++// Convolutions+IplImage* wrapFilter2D(IplImage *src, int ax,int ay, + int w, int h, double *kernel){+int i,j;+IplImage *target = cvCloneImage(src);+CvMat *kernelMat = cvCreateMat(w,h,CV_32FC1);+for(i=0;i<w*h;i++)+ cvSetReal2D(kernelMat,i%w,i/w,kernel[i]); +cvFilter2D(src,target,kernelMat,cvPoint(ay,ax));+cvReleaseMat(&kernelMat);+return target;+}++IplImage* wrapFilter2DImg(IplImage *src+ ,IplImage *mask+ ,int ax,int ay)+{+int i,j;+IplImage *target = cvCloneImage(src);+CvSize size = cvGetSize(mask);+CvMat *kernelMat = cvCreateMat(size.width,size.height,CV_32FC1);+for(i=0;i<size.width;i++)+ for(j=0;j<size.height;j++)+ cvSetReal2D(kernelMat,i,j,cvGetReal2D(mask,j,i)); +cvFilter2D(src,target,kernelMat,cvPoint(ay,ax));+cvReleaseMat(&kernelMat);+return target;+}++// Connected components++void wrapFloodFill(IplImage *i, int x, int y, double c+ ,double low, double high,int fixed)+{+ int flag = 8 | (fixed ? CV_FLOODFILL_FIXED_RANGE : 0);+ cvFloodFill(i,cvPoint(x,y),cvRealScalar(c),cvRealScalar(low)+ ,cvRealScalar(high),NULL,flag,NULL);+}+ +// hough-lines++void wrapProbHoughLines(IplImage *img, double rho, double theta+ , int threshold, double minLength+ , double gapLength+ , int *maxLines+ , int *xs, int *ys+ , int *xs1, int *ys1)+{+ IplImage *tmp;+ CvSeq *lines = 0;+ int i;+ CvMemStorage *storage = cvCreateMemStorage(0); + + tmp = ensure8U(img);++ lines = cvHoughLines2(tmp,storage,CV_HOUGH_PROBABILISTIC+ ,rho,theta,threshold,minLength,gapLength);+ for( i = 0; i < MIN(lines->total,*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; i<imageSize.width; ++i)+ for(j=0; j<imageSize.height; ++j) {+ r = cvGetReal2D(src,j,i);+ cvSet2D(dst,j,i,cvScalarAll(atan(r)));+ }+}+//@nonl+//@-node:aleator.20070906153003:Trigonometric operations+//@+node:aleator.20051109111547:Pixel accessors+// All these will work only on grayscale.+inline int imax(int x, int y) {return (x>y) ? x:y;}+inline int imin(int x, int y) {return (x<y) ? x:y;}+inline double blurGet2D(IplImage *img,int x, int y)+{+ CvSize size = cvGetSize(img);+ x = imax(0,imin(x,size.width-1));+ y = imax(0,imin(y,size.height-1));++ return cvGetReal2D(img,y,x);+}++//@-node:aleator.20051109111547:Pixel accessors+//@+node:aleator.20070827150608:Haar Filters++// Simple routines for calculating pixelwise+// haar responses++void haarFilter(IplImage *intImg, + int x1, int y1, int x2, int y2,+ IplImage *target)+{+ int i,j;+ double s = 0;+ double ratio = 1;+ double desArea = (x2-x1)*(y1-y2);+ double area = 0;+ int rx1,rx2,ry1,ry2;+ CvSize imageSize = cvGetSize(target); + for(i=0; i<imageSize.width; ++i)+ for(j=0; j<imageSize.height; ++j) {+ rx1 = imax(0,imin(i+x1,imageSize.width-1)); + ry1 = imax(0,imin(j+y1,imageSize.height-1));+ rx2 = imax(0,imin(i+x2,imageSize.width-1)); + ry2 = imax(0,imin(j+y2,imageSize.height-1));+ area = (float)((rx2-rx1)*(ry2-ry1));+ // if (area > 0) ratio = fabs(desArea/area);+ // 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<x1; ++x) {+ if (steep) {sum+=blurGet2D(src,y,x);+ ++len;} + // _plot(y,x);} + else {sum+=blurGet2D(src,x,y);+ ++len; } + //_plot(x,y);}+ error = error + deltay;+ if (2*error >= 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;i<size.width;++i)+ for(j=0;j<size.height;++j)+ {+ result = cvSqrt(cvGetReal2D(src,j,i));+ cvSetReal2D(dst,j,i,result);+ }+}+//@-node:aleator.20051130130836:Taking square roots of images+//@+node:aleator.20050930104348:Histogram Features+#define HISTOGRAMSIZE 10++double calculateMoment(int i,double arr[], int l)+{+int j=0;+double result = 0;+for(j=0; j<l; j++)+ { result += pow((j*1.0)/HISTOGRAMSIZE,i)*arr[j]; }+return result;+}++double calculateAbsCentralMoment(int i,double arr[], int l)+{+int j=0;+double m1 = calculateMoment(1,arr,l);+double result = 0;+for(j=0; j<l; j++)+ {+ result += pow(fabs(((j*1.0)/HISTOGRAMSIZE)-m1),i)*arr[j];}+return result;+}++double calculateCentralMoment(int i,double arr[], int l)+{+int j=0;+double m1 = calculateMoment(1,arr, l);+double result = 0;+for(j=0; j<l; j++)+ { + result += pow(((j*1.0)/HISTOGRAMSIZE)-m1,i)*arr[j];++ }+return result;+}+//@+node:aleator.20050930104348.1:Central Moments++IplImage* getNthCentralMoment(IplImage *src,int n, int w, int h)+{++CvSize size = cvGetSize(src);+int iw = size.width-w;+int ih = size.height-h;+IplImage *target = wrapCreateImage32F(iw,ih,1);+int x = 0;+int y = 0;+int i = 0;+int j = 0;+double histogram[HISTOGRAMSIZE]; +for (x=0; x<ih; x++)+ for (y=0; y<iw; y++)+ {+memset(histogram,0,HISTOGRAMSIZE*sizeof(double));+double result = 0;++// Calculate the local histogram+for (i=0; i<w; i++)+ for (j=0; j<h; j++)+ {+ int slot = HISTOGRAMSIZE*cvGet2D(src,x+i,y+j).val[0];+ histogram[slot] += 1.0/(w*h*1.0);+ }+++result = calculateCentralMoment(n,histogram,HISTOGRAMSIZE); +cvSet2D(target,x,y,cvScalarAll(result));+ }++return target;+}++IplImage* getNthAbsCentralMoment(IplImage *src,int n, int w, int h)+{++CvSize size = cvGetSize(src);+int iw = size.width-w;+int ih = size.height-h;+IplImage *target = wrapCreateImage32F(iw,ih,1);+int x = 0;+int y = 0;+int i = 0;+int j = 0;+double histogram[HISTOGRAMSIZE]; +for (x=0; x<ih; x++)+ for (y=0; y<iw; y++)+ {+memset(histogram,0,HISTOGRAMSIZE*sizeof(double));+double result = 0;++// Calculate the local histogram+for (i=0; i<w; i++)+ for (j=0; j<h; j++)+ {+ int slot = HISTOGRAMSIZE*cvGet2D(src,x+i,y+j).val[0];+ histogram[slot] += 1.0/(w*h*1.0);+ }+++result = calculateAbsCentralMoment(n,histogram,HISTOGRAMSIZE); +cvSet2D(target,x,y,cvScalarAll(result));+ }++return target;+}++IplImage* getNthMoment(IplImage *src,int n, int w, int h)+{++CvSize size = cvGetSize(src);+int iw = size.width-w;+int ih = size.height-h;+IplImage *target = wrapCreateImage32F(iw,ih,1);+int x = 0;+int y = 0;+int i = 0;+int j = 0;+double histogram[HISTOGRAMSIZE]; +for (x=0; x<ih; x++)+ for (y=0; y<iw; y++)+ {+memset(histogram,0,HISTOGRAMSIZE*sizeof(double));+double result = 0;++// Calculate the local histogram+for (i=0; i<w; i++)+ for (j=0; j<h; j++)+ {+ int slot = HISTOGRAMSIZE*cvGet2D(src,x+i,y+j).val[0];+ histogram[slot] += 1.0/(w*h*1.0);+ }++result = calculateMoment(n,histogram,HISTOGRAMSIZE); +cvSet2D(target,x,y,cvScalarAll(result));+ }++return target;+}++//@-node:aleator.20050930104348.1:Central Moments+//@+node:aleator.20051103110155:SMAB+ +// Perform second moment adaptive binarization for a single pixel `x`+// using given histogram.+double max(double x,double y) {if (x<y) return y; else return x;}+double min(double x,double y) {if (x>y) 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<binnedX; i++)+ { leftSM += pow(x - ((1.0*i)/(1.0*binCount)),2) * getHistValue(h,i); }+ for(i=binnedX; i<binCount; i++)+ { rightSM += pow(x - ((1.0*i)/(1.0*binCount)),2) * getHistValue(h,i); }+ return (leftSM - (rightSM * t));+}++// Perform SMAB for image+void smb(IplImage *image,double t)+{+int i;int j;+double result;+CvSize size = cvGetSize(image);+CvHistogram *h = calculateHistogram(image,255);+for(i=0;i<size.width;++i)+ for(j=0;j<size.height;++j)+ {+ result = SMABx(cvGet2D(image,j,i).val[0],h,255,t);+ cvSet2D(image,j,i,cvScalarAll(result));+ }+}++void smab(IplImage *image,int w, int h,double t)+{+int i;int j;+int wi;int wj;+double result;+CvHistogram *histogram;+CvRect roi;+CvSize size = cvGetSize(image);+roi.width = w;+roi.height = h;++for(i=0;i<size.width;++i)+ for(j=0;j<size.height;++j)+ {+ roi.x = i-(w/2);+ roi.y = j-(h/2);+ cvSetImageROI(image,roi);+ histogram = calculateHistogram(image,50);+ cvResetImageROI(image);+ result = SMABx(cvGetReal2D(image,j,i),histogram,50,t);+ cvReleaseHist(&histogram);+ cvSet2D(image,j,i,cvScalarAll(result));+ }+}+//@-node:aleator.20051103110155:SMAB+//@+node:aleator.20051108093248:Skewness++//@-node:aleator.20051108093248:Skewness+//@-node:aleator.20050930104348:Histogram Features+//@+node:aleator.20050926095227:Susan+/* + Susan (Smallest Univalue Segmenting Nucleus) is + family of image processing methods, including+ edge preserving noise reduction.+*/+//@+node:aleator.20050926095227.1:Susan Smoothing Function++/* + Calculate susan smoothing for `src` around `x`,`y` coordinates.+ `t` determines brightness treshold and sigma controls scale of+ spatial smoothing. `w` and `h` determine window size.+*/++inline double calcSusanSmooth(IplImage* src, int x, int y+ ,double t,double sigma,int w, int h)+{++int i = 0;+int j = 0;++long double numerator = 0;+long double denominator = 0;+for (i = 0; i<w; i++)+ for (j = 0; j<h; j++)+ {+ if (i==w/2 && j==h/2) continue;+ double r2 = i*i+j*j;+ double expFrac = (cvGet2D(src,x+i,y+j).val[0] + - cvGet2D(src,x,y).val[0]);+ expFrac *= expFrac;++ double exponential = exp( (-r2/(2*sigma*sigma)) - (expFrac/(t*t)) );++ numerator += cvGet2D(src,x+i,y+j).val[0] * exponential;+ denominator += exponential;+ }+return numerator/denominator;+}+//@-node:aleator.20050926095227.1:Susan Smoothing Function+//@+node:aleator.20050926100856:Susan Smoothing++IplImage* susanSmooth(IplImage *src, int w, int h+ ,double t, double sigma)++{++CvSize size = cvGetSize(src);+int iw = size.width-w;+int ih = size.height-h;+IplImage *target = wrapCreateImage32F(iw,ih,1);+int x = 0;+int y = 0;+double result = 0;+++for (x=0; x<iw; x++)+ for (y=0; y<ih; y++)+ {+ result = calcSusanSmooth(src,y,x,t,sigma,h,w);+ cvSet2D(target,y,x,cvScalarAll(result));+ }+return target;+}+//@-node:aleator.20050926100856:Susan Smoothing+//@+node:aleator.20050927083244:Susan Edge+/* + Susan Edge Detector.+*/++// susan threshold function+inline double susanC(double r, double r0,double t)+{+ return exp(-((r-r0)/t));+}++inline double susanValue(IplImage *src,int x, int y+ ,int w, int h, double t)+{+int i; int j;+double geometricTreshold = (3*(w*h)) / 4;+double sum = 0;++for (i = 0; i<w; i++)+ for (j = 0; j<h; j++)+ {+ sum += susanC(cvGet2D(src,x+i,y+j).val[0]+ ,cvGet2D(src,x,y).val[0]+ ,t);+ }+if (sum < geometricTreshold)+ return geometricTreshold - sum;+else return 0;+}++IplImage* susanEdge(IplImage *src,int w,int h,double t)+{+CvSize size = cvGetSize(src);+int iw = size.width-w;+int ih = size.height-h;+IplImage *target = wrapCreateImage32F(iw,ih,1);+int x = 0;+int y = 0;+double result = 0;+++for (x=0; x<iw; x++)+ for (y=0; y<ih; y++)+ {+ result = susanValue(src,y,x,h,w,t);+ cvSet2D(target,y,x,cvScalarAll(result));+ }+return target;++}+//@-node:aleator.20050927083244:Susan Edge+//@-node:aleator.20050926095227:Susan+//@+node:aleator.20050908112008:Gabors+/* + Gabor functions are modulated gaussians which bear some resemblance+ to human visual cortex neurons. */+//@+node:aleator.20050908104238:gabor function in C+/* This function calculates value of simple gabor function+ at given x,y coordinates. Parameters for the gabor are:+ + stdX - standard deviation in oscillation direction+ stdY - standard deviation tangential to stdX+ theta - angle (in radians) of the gabor+ phase - phase of the gabor+++*/+double calcGabor(double x, double y+ ,double stdX, double stdY+ ,double theta, double phase+ ,double cycles)+{+ double xth = x*cos(theta) - y*sin(theta);+ double yth = x*sin(theta) + y*cos(theta);+ double oscillationPart = cos(2*M_PI*xth/cycles+phase);+ double gaussianPart = exp((-0.5*xth*xth)/(stdX*stdX))+ *exp((-0.5*yth*yth)/(stdY*stdY));+ + return gaussianPart * oscillationPart;+}++double calc1DGabor(double x+ ,double sigma+ ,double phase, double center+ ,double cycles)+{+ double oscillationPart = cos(2*M_PI*(x-center)/cycles+phase);+ double gaussianPart = exp((-0.5*(x-center)*(x-center))+ /(sigma*sigma));+ + return gaussianPart * oscillationPart;+}+++//@-node:aleator.20050908104238:gabor function in C+//@+node:aleator.20050908112116:rendering gabors to arrays+void renderGabor(CvArr *dst,int width, int height+ ,double dx, double dy+ ,double stdX, double stdY+ ,double theta, double phase+ ,double cycles)++{+ int i,j;+ int mx = width/2;+ int my = height/2;+ for (i=0; i<width; i++)+ for (j=0; j<height; j++) // TODO: This might be a bug+ cvSet2D(dst,i,j,cvScalarAll(calcGabor(i-dx,j-dy,stdX,stdY+ ,theta,phase,cycles)));+}++void render_gaussian(IplImage *dst+ ,double stdX, double stdY)++{+ int i,j;+ double distX;+ double distY;+ CvSize size = cvGetSize(dst);+ double centerX = size.width/2.0;+ double centerY = size.height/2.0;+ for (i=0; i<size.width-1; i++)+ for (j=0; j<size.height-1; j++)+ { distX = ((centerX-i*1.0)*(centerX-i*1.0)) / (2*stdX*stdX);+ distY = ((centerY-j*1.0)*(centerY-j*1.0)) / (2*stdY*stdY);+ // printf("w: %d, h: %d, i: %d, j:%d,dx: %e,dy: %e,exp:%e\n",size.width,size.height,i,j,distX,distY,exp(-distX-distY));+ fflush(stdout);+ cvSet2D(dst,j,i,cvScalarAll( exp(-distX-distY) ));+ }+}+++void renderRadialGabor(CvArr *dst,int width, int height+ ,double sigma+ ,double phase, double center+ ,double cycles)++{+ int i,j;+ int mx = width/2;+ int my = height/2;+ double rad = 0;+ for (i=0; i<width; i++)+ for (j=0; j<width; j++)+ {+ rad = sqrt((i-mx)*(i-mx)+(j-my)*(j-my));+ cvSet2D(dst,i,j,cvScalarAll(calc1DGabor(rad,sigma+ ,phase,center,cycles)));+ }+}++void wrapMinMaxLoc(const IplImage* target, int* minx, int* miny, int* maxx, int* maxy, double *minval, double *maxval)+{+ CvPoint maxPoint;+ CvPoint minPoint;+ cvMinMaxLoc(target,minval,maxval,&minPoint, &maxPoint, NULL);+ *maxx = maxPoint.x ;+ *maxy = maxPoint.y ;+ *minx = minPoint.x ;+ *miny = minPoint.y ;+} ++void simpleMatchTemplate(const IplImage* target, const IplImage* template, int* x, int* y, double *val,int type)+{+ int rw = cvGetSize(target).width-cvGetSize(template).width+1;+ int rh = cvGetSize(target).height-cvGetSize(template).height+1;+ IplImage* result = wrapCreateImage32F(rw,rh,1);+ cvMatchTemplate(target,template,result,type);+ double min,max;+ CvPoint maxPoint;+ maxPoint.x=-1;+ maxPoint.y=-1;+ min =0;+ max =0;+ cvMinMaxLoc(result,&min,&max,NULL, &maxPoint, NULL);+ *x = maxPoint.x;+rw/2;+ *y = maxPoint.y;+rh/2;+ *val = max;+ cvReleaseImage(&result);+ } ++IplImage* templateImage(const IplImage* target, const IplImage* template)+{+ int rw = cvGetSize(target).width-cvGetSize(template).width+1;+ int rh = cvGetSize(target).height-cvGetSize(template).height+1;+ IplImage* result = wrapCreateImage32F(rw,rh,1);+ cvMatchTemplate(target,template,result,CV_TM_CCORR);+ return result;+ } +++//@-node:aleator.20050908112116:rendering gabors to arrays+//@+node:aleator.20050908101148:gabor filter using cvFilter2D+void gaborFilter(const CvArr *src, CvArr *dst+ ,int maskWidth, int maskHeight+ ,double stdX, double stdY+ ,double theta,double phase+ ,double cycles)++{+ int mx = maskWidth/2;+ int my = maskHeight/2;+ CvMat *kernel = cvCreateMat(maskWidth,maskHeight,CV_32F);+ renderGabor(kernel,maskWidth,maskHeight,mx,my,stdX,stdY+ ,theta,phase,cycles);+ cvFilter2D(src,dst,kernel,cvPoint(-1,-1));+}++void radialGaborFilter(const CvArr *src, CvArr *dst+ ,int maskWidth, int maskHeight+ ,double sigma+ ,double phase,double center+ ,double cycles)++{+ CvMat *kernel = cvCreateMat(maskWidth,maskHeight,CV_32F);+ renderRadialGabor(kernel,maskWidth,maskHeight,sigma+ ,phase,center,cycles);+ cvFilter2D(src,dst,kernel,cvPoint(-1,-1));+}+++//@-node:aleator.20050908101148:gabor filter using cvFilter2D+//@-node:aleator.20050908112008:Gabors+//@+node:aleator.20070511142414:Adaboost Learning+// This doesn't really work properly yet.. No+// time to do anything about it really.+//@nonl+//@+node:aleator.20070511142414.1:Fitness+// In the following the class is encoded bit+// differently. 0 is one class and +1 is another.+// if target is gray it is considered null area.++double adaFitness1(IplImage *target+ ,IplImage *weigths+ ,IplImage *test)+{+CvSize size = cvGetSize(target);+int i,j;+int width = size.width;+int height = size.height;+double result=0;+double tij=0,wij=0,testij=0,rij=0; +for (i=0; i<width; i++)+ for (j=0; j<height; j++)+ { + tij = cvGetReal2D(target,j,i);+ wij = cvGetReal2D(weigths,j,i);+ testij = cvGetReal2D(test,j,i);+ rij=wij;+ if (((tij < 0.2) && (testij < 0.2)) || ((tij > 0.8) && (testij > 0.8))) + {rij=0;} + 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; i<width; i++)+ for (j=0; j<height; j++)+ { + tij = cvGetReal2D(target,j,i);+ wij = cvGetReal2D(weigths,j,i);+ testij = cvGetReal2D(test,j,i);+ if ( (tij>0.2) && (tij<0.8) ) continue;+ if (((tij < 0.2) && (testij < 0.2)) + || ((tij > 0.8) && (testij > 0.8))) + {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;++i) histo[i]=0;+ for(i=0; i<imageSize.width-1; ++i)+ for(j=0; j<imageSize.height-1; ++j)+ {+ value = cvGetReal2D(src,j,i);+ weight = cvGetReal2D(weights,j,i);+ index = floor(bins*((value - start)/(end - start)));+ //printf("Adding weight %e to index %d\n",weight,index);+ if (index<0 || index>=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<imageSize.width-1; ++i)+ for(j=1; j<imageSize.height-1; ++j)+ {+ center = cvGetReal2D(src,j,i);++ pattern += (blurGet2D(src,i-1,j-1) > center) *1;+ pattern += (blurGet2D(src,i,j-1) > center) *2;+ pattern += (blurGet2D(src,i+1,j-1) > center) *4;+ + pattern += (blurGet2D(src,i-1,j) > center) *8;+ pattern += (blurGet2D(src,i+1,j) > center) *16;+ + pattern += (blurGet2D(src,i-1,j+1) > center) *32;+ pattern += (blurGet2D(src,i,j+1) > center) *64;+ pattern += (blurGet2D(src,i+1,j+1) > center) *128;+ 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<imageSize.width-1; ++i)+ for(j=1; j<imageSize.height-1; ++j)+ {+ center = cvGetReal2D(src,j,i);++ pattern += (blurGet2D(src,i-2,j-2) > center) *1;+ pattern += (blurGet2D(src,i,j-3) > center) *2;+ pattern += (blurGet2D(src,i+2,j-2) > center) *4;+ + pattern += (blurGet2D(src,i-3,j) > center) *8;+ pattern += (blurGet2D(src,i+3,j) > center) *16;+ + pattern += (blurGet2D(src,i-2,j+2) > center) *32;+ pattern += (blurGet2D(src,i,j+3) > center) *64;+ pattern += (blurGet2D(src,i+2,j+2) > center) *128;+ 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<imageSize.width-1; ++i)+ for(j=1; j<imageSize.height-1; ++j)+ {+ center = cvGetReal2D(src,j,i);++ pattern += (blurGet2D(src,i-4,j-4) > center) *1;+ pattern += (blurGet2D(src,i,j-5) > center) *2;+ pattern += (blurGet2D(src,i+4,j-4) > center) *4;+ + pattern += (blurGet2D(src,i-5,j) > center) *8;+ pattern += (blurGet2D(src,i+5,j) > center) *16;+ + pattern += (blurGet2D(src,i-4,j+4) > center) *32;+ pattern += (blurGet2D(src,i,j+5) > center) *64;+ pattern += (blurGet2D(src,i+4,j+4) > center) *128;+ 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<imageSize.width-1; ++i)+ for(j=1; j<imageSize.height-1; ++j)+ {+ center = cvGetReal2D(src,j,i);+ weight = cvGetReal2D(weights,j,i);++ pattern += (blurGet2D(src,i-offsetXY,j-offsetXY) > center) *1;+ pattern += (blurGet2D(src,i,j-offsetX) > center) *2;+ pattern += (blurGet2D(src,i+offsetXY,j-offsetXY) > center) *4;+ + pattern += (blurGet2D(src,i-offsetX,j) > center) *8;+ pattern += (blurGet2D(src,i+offsetX,j) > center) *16;+ + pattern += (blurGet2D(src,i-offsetXY,j+offsetXY) > center) *32;+ pattern += (blurGet2D(src,i,j+offsetX) > center) *64;+ pattern += (blurGet2D(src,i+offsetXY,j+offsetXY) > center) *128;+ 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<imageSize.width-1; ++i)+ for(j=0; j<imageSize.height-1; ++j)+ {+ center = cvGetReal2D(src,j,i);++ pattern += (blurGet2D(src,i-4,j) > 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<imageSize.width-1; ++i)+ for(j=0; j<imageSize.height-1; ++j)+ {+ center = cvGetReal2D(src,j,i);++ pattern += (blurGet2D(src,i,j-4) > 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<wwidth;++i)+ for (j=-wheight; j<wheight;++j)+ { + if ( x+i<0 || x+i>=size.width+ || y+j<0 || y+j>=size.height)+ continue;+ + processed = blurGet2D(img,x+i,y+j);+ if (fabs(processed-centerValue)<t)+ {accum+=processed;++count;}+ }+return accum/count;+}+++IplImage* selectiveAvgFilter(IplImage *src,double t+ ,int wwidth, int wheight)+{+CvSize size = cvGetSize(src);+int i,j;+int width = size.width;+int height = size.height;+double result;++IplImage *target = wrapCreateImage32F(width,height,1);+for (i=0; i<width; i++)+ for (j=0; j<height; j++)+ {+ result = calcSelectiveAvg(src,t,i,j,wwidth,wheight);+ cvSetReal2D(target,j,i,result);+ }+ +return target;+}++//@-node:aleator.20051109102750:Selective Average+//@+node:aleator.20060104154125:AcquireImage++// Copy array into single channel iplImage+IplImage *acquireImageSlow(int w, int h, double *d)+{+ IplImage *img;+ int i,j;+ img = cvCreateImage(cvSize(w,h), IPL_DEPTH_32F,1);+ for (i=0; i<h; i++) {+ for (j=0; j<w; j++) { + //printf("(%d,%d) => %d is %f\n",j,i,(i+j*h),d[i+j*h]);+ FGET(img,j,i) = d[j*h+i]; + }+ }+ return img;+}++IplImage *acquireImageSlowF(int w, int h, float *d)+{+ IplImage *img;+ int i,j;+ img = cvCreateImage(cvSize(w,h), IPL_DEPTH_32F,1);+ for (i=0; i<h; i++) {+ for (j=0; j<w; j++) { + //printf("(%d,%d) => %d is %f\n",j,i,(i+j*h),d[i+j*h]);+ FGET(img,j,i) = d[j*h+i]; + }+ }+ return img;+}++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; i<h; i++) {+ for (j=0; j<w; j++) { + FGET(img,j,i) = (float)(creal(d[j*h+i])); + }+ }+ return img;+}++void exportImageSlowComplex(IplImage *img, complex double *d)+{+ int i,j;+ CvSize s= cvGetSize(img);+ for (i=0; i<s.height; i++) {+ for (j=0; j<s.width; j++) { + d[j*s.height+i] = (complex float)(FGET(img,j,i) + 0*I); + }+ }+}++void exportImageSlow(IplImage *img, double *d)+{+ int i,j;+ CvSize s= cvGetSize(img);+ for (i=0; i<s.height; i++) {+ for (j=0; j<s.width; j++) { + d[j*s.height+i] = FGET(img,j,i); + }+ }+}+void exportImageSlowF(IplImage *img, float *d)+{+ int i,j;+ CvSize s= cvGetSize(img);+ for (i=0; i<s.height; i++) {+ for (j=0; j<s.width; j++) { + d[j*s.height+i] = FGET(img,j,i); + }+ }+}+//@-node:aleator.20060104154125:AcquireImage+//@-node:aleator.20050908100314.3:Utilities+//@+node:aleator.20060413093124:Connected components+//@+node:aleator.20071016114634:Contours+++void free_found_contours(FoundContours *f)+{+ cvReleaseMemStorage(&(f->storage));+ free(f);+ +}++int reset_contour(FoundContours *f)+{ + f->contour = f->start;+}++int cur_contour_size(FoundContours *f)+{ + return f->contour->total;+}++double contour_area(FoundContours *f)+{ + return cvContourArea(f->contour,CV_WHOLE_SEQ,0);+}++CvMoments* contour_moments(FoundContours *f)+{ + CvMoments* moments = (CvMoments*) malloc(sizeof(CvMoments));+ cvMoments(f->contour,moments,0);+ return moments;+}++double contour_perimeter(FoundContours *f)+{ + return cvContourPerimeter(f->contour);+}++int more_contours(FoundContours *f)+{ + if (f->contour != 0)+ {return 1;}+ {return 0;} // no more contours+}++int next_contour(FoundContours *f)+{ + if (f->contour != 0)+ {f->contour = f->contour->h_next; return 1;}+ {return 0;} // no more contours+}++void contour_points(FoundContours *f, int *xs, int *ys)+{+ if (f->contour==0) {printf("unavailable contour\n"); exit(1);}+ + CvPoint *pt=0;+ int total,i=0;+ total = f->contour->total;+ for (i=0; i<total;i++) + {+ pt = (CvPoint*)cvGetSeqElem(f->contour,i);+ if (pt==0) {printf("point out of contour\n"); exit(1);}+ xs[i] = pt->x;+ ys[i] = pt->y;+ } + +}++void print_contour(FoundContours *fc)+{+ int i=0;+ CvPoint *pt=0;+ for (i=0; i<fc->contour->total;++i) + {+ 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,0));+ 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.height; i++)+ for (j=0; j<s.width; j++) {+ nx = (j-cx)/s.width;+ ny = (i-cy)/s.height;+ r2 = nx*nx+ny*ny;+ nx = nx*(1+k*r2);+ ny = ny*(1+k*r2);+ x = (nx+0.5)*s.width;+ y = (ny+0.5)*s.height;+ if (x<0 || x>=s.width || y<0 || y>=s.height) + { FGET(dest,j,i) = 0; + 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);+}++void maximal_covering_circle(int ox,int oy, double or, IplImage *distmap+ ,int *max_x, int *max_y, double *max_r)+{+ double distance,radius;++ *max_x = ox;+ *max_y = oy;+ *max_r = or;++ CvSize s = cvGetSize(distmap);+ for(int i=0; i<s.width; i++) // TODO: Limit with max_r+ for(int j=0; j<s.height; j++)+ {+ distance = sqrt((i-ox)*(i-ox) + (j-oy)*(j-oy));+ radius = FGET(distmap,i,j);+ if (radius > *max_r && radius >= or+distance )+ { *max_x=i; *max_y=j; *max_r=radius;}+ }+}++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;i<limit;i++)+ {+ cr=creal(z); ci=cimag(i);+ if (cr*cr+ci*ci>4) return (i*1.0)/limit;+ z=z*z+c;+ }+ return 0;+ }++CvVideoWriter* wrapCreateVideoWriter(char *fn, int fourcc,+ double fps,int w, int h,+ int color) + {+ CvVideoWriter *res = cvCreateVideoWriter(fn,CV_FOURCC('M','P','G','4'),fps,cvSize(w,h), color);+ return res;+ }++//@-node:aleator.20051220091717:Matrix multiplication+//@-all+//@-node:aleator.20050908100314:@thin cvWrapLEO.c+//@-leo
+ CV/cvWrapLEO.h view
@@ -0,0 +1,271 @@+//@+leo-ver=4-thin+//@+node:aleator.20050908101148.2:@thin cvWrapLEO.h+//@@language c+#ifndef __CVWRAP__+#define __CVWRAP__++#include <opencv/cv.h>+#include <opencv/cxcore.h>+#include <opencv/highgui.h>+#include <complex.h>++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, float r,float g,float b, int thickness);++void wrapDrawLine(CvArr *img, int x, int y, int x1, int y1, double r, double g, double b, int thickness);++void wrapFillPolygon(IplImage *img, int pc, int *xs, int *ys, float r, float g, float b);++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, float r, float g, float b,+ 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,float r,float g,float b);++IplImage* vignettingModelB3(int w, int h,double b1, double b2, double b3);+inline CvPoint2D64f toNormalizedCoords(CvSize area, CvPoint from);+inline CvPoint fromNormalizedCoords(CvSize area, CvPoint2D64f from);+inline double eucNorm(CvPoint2D64f p);+IplImage* vignettingModelP(int w, int h,double scalex, double scaley, double max);+IplImage* wrapPerspective(IplImage* src, double a1, double a2, double a3+ , double a4, double a5, double a6+ , double a7, double a8, double a9);+IplImage* simplePerspective(double k,IplImage *src);+double bilinearInterp(IplImage *tex, double u, double v);+inline CvPoint2D64f fromNormalizedCoords64f(CvSize area, CvPoint2D64f from);+void findHomography(double* srcPts, double *dstPts, int noPts, double *homography);+void masked_merge(IplImage *src1, IplImage *mask, IplImage *src2, IplImage *dst);+IplImage* makeEvenUp(IplImage *src);+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);+IplImage *acquireImageSlowF(int w, int h, float *d);+void exportImageSlow(IplImage *img, double *d);+void exportImageSlowF(IplImage *img, float *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);++CvVideoWriter* wrapCreateVideoWriter(char *fn, int fourcc, double fps,int w, int h, int color); ++double wrapGet32F2DC(CvArr *arr, int x, int y,int c);+void maximal_covering_circle(int ox,int oy, double or, IplImage *distmap+ ,int *max_x, int *max_y, double *max_r);+++#endif+//@-node:aleator.20050908101148.2:@thin cvWrapLEO.h+//@-leo
+ LICENSE view
@@ -0,0 +1,674 @@+ GNU GENERAL PUBLIC LICENSE+ Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The GNU General Public License is a free, copyleft license for+software and other kinds of works.++ The licenses for most software and other practical works are designed+to take away your freedom to share and change the works. By contrast,+the GNU General Public License is intended to guarantee your freedom to+share and change all versions of a program--to make sure it remains free+software for all its users. We, the Free Software Foundation, use the+GNU General Public License for most of our software; it applies also to+any other work released this way by its authors. You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+them if you wish), that you receive source code or can get it if you+want it, that you can change the software or use pieces of it in new+free programs, and that you know you can do these things.++ To protect your rights, we need to prevent others from denying you+these rights or asking you to surrender the rights. Therefore, you have+certain responsibilities if you distribute copies of the software, or if+you modify it: responsibilities to respect the freedom of others.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must pass on to the recipients the same+freedoms that you received. You must make sure that they, too, receive+or can get the source code. And you must show them these terms so they+know their rights.++ Developers that use the GNU GPL protect your rights with two steps:+(1) assert copyright on the software, and (2) offer you this License+giving you legal permission to copy, distribute and/or modify it.++ For the developers' and authors' protection, the GPL clearly explains+that there is no warranty for this free software. For both users' and+authors' sake, the GPL requires that modified versions be marked as+changed, so that their problems will not be attributed erroneously to+authors of previous versions.++ Some devices are designed to deny users access to install or run+modified versions of the software inside them, although the manufacturer+can do so. This is fundamentally incompatible with the aim of+protecting users' freedom to change the software. The systematic+pattern of such abuse occurs in the area of products for individuals to+use, which is precisely where it is most unacceptable. Therefore, we+have designed this version of the GPL to prohibit the practice for those+products. If such problems arise substantially in other domains, we+stand ready to extend this provision to those domains in future versions+of the GPL, as needed to protect the freedom of users.++ Finally, every program is threatened constantly by software patents.+States should not allow patents to restrict development and use of+software on general-purpose computers, but in those that do, we wish to+avoid the special danger that patents applied to a free program could+make it effectively proprietary. To prevent this, the GPL assures that+patents cannot be used to render the program non-free.++ The precise terms and conditions for copying, distribution and+modification follow.++ TERMS AND CONDITIONS++ 0. Definitions.++ "This License" refers to version 3 of the GNU General Public License.++ "Copyright" also means copyright-like laws that apply to other kinds of+works, such as semiconductor masks.++ "The Program" refers to any copyrightable work licensed under this+License. Each licensee is addressed as "you". "Licensees" and+"recipients" may be individuals or organizations.++ To "modify" a work means to copy from or adapt all or part of the work+in a fashion requiring copyright permission, other than the making of an+exact copy. The resulting work is called a "modified version" of the+earlier work or a work "based on" the earlier work.++ A "covered work" means either the unmodified Program or a work based+on the Program.++ To "propagate" a work means to do anything with it that, without+permission, would make you directly or secondarily liable for+infringement under applicable copyright law, except executing it on a+computer or modifying a private copy. Propagation includes copying,+distribution (with or without modification), making available to the+public, and in some countries other activities as well.++ To "convey" a work means any kind of propagation that enables other+parties to make or receive copies. Mere interaction with a user through+a computer network, with no transfer of a copy, is not conveying.++ An interactive user interface displays "Appropriate Legal Notices"+to the extent that it includes a convenient and prominently visible+feature that (1) displays an appropriate copyright notice, and (2)+tells the user that there is no warranty for the work (except to the+extent that warranties are provided), that licensees may convey the+work under this License, and how to view a copy of this License. If+the interface presents a list of user commands or options, such as a+menu, a prominent item in the list meets this criterion.++ 1. Source Code.++ The "source code" for a work means the preferred form of the work+for making modifications to it. "Object code" means any non-source+form of a work.++ A "Standard Interface" means an interface that either is an official+standard defined by a recognized standards body, or, in the case of+interfaces specified for a particular programming language, one that+is widely used among developers working in that language.++ The "System Libraries" of an executable work include anything, other+than the work as a whole, that (a) is included in the normal form of+packaging a Major Component, but which is not part of that Major+Component, and (b) serves only to enable use of the work with that+Major Component, or to implement a Standard Interface for which an+implementation is available to the public in source code form. A+"Major Component", in this context, means a major essential component+(kernel, window system, and so on) of the specific operating system+(if any) on which the executable work runs, or a compiler used to+produce the work, or an object code interpreter used to run it.++ The "Corresponding Source" for a work in object code form means all+the source code needed to generate, install, and (for an executable+work) run the object code and to modify the work, including scripts to+control those activities. However, it does not include the work's+System Libraries, or general-purpose tools or generally available free+programs which are used unmodified in performing those activities but+which are not part of the work. For example, Corresponding Source+includes interface definition files associated with source files for+the work, and the source code for shared libraries and dynamically+linked subprograms that the work is specifically designed to require,+such as by intimate data communication or control flow between those+subprograms and other parts of the work.++ The Corresponding Source need not include anything that users+can regenerate automatically from other parts of the Corresponding+Source.++ The Corresponding Source for a work in source code form is that+same work.++ 2. Basic Permissions.++ All rights granted under this License are granted for the term of+copyright on the Program, and are irrevocable provided the stated+conditions are met. This License explicitly affirms your unlimited+permission to run the unmodified Program. The output from running a+covered work is covered by this License only if the output, given its+content, constitutes a covered work. This License acknowledges your+rights of fair use or other equivalent, as provided by copyright law.++ You may make, run and propagate covered works that you do not+convey, without conditions so long as your license otherwise remains+in force. You may convey covered works to others for the sole purpose+of having them make modifications exclusively for you, or provide you+with facilities for running those works, provided that you comply with+the terms of this License in conveying all material for which you do+not control copyright. Those thus making or running the covered works+for you must do so exclusively on your behalf, under your direction+and control, on terms that prohibit them from making any copies of+your copyrighted material outside their relationship with you.++ Conveying under any other circumstances is permitted solely under+the conditions stated below. Sublicensing is not allowed; section 10+makes it unnecessary.++ 3. Protecting Users' Legal Rights From Anti-Circumvention Law.++ No covered work shall be deemed part of an effective technological+measure under any applicable law fulfilling obligations under article+11 of the WIPO copyright treaty adopted on 20 December 1996, or+similar laws prohibiting or restricting circumvention of such+measures.++ When you convey a covered work, you waive any legal power to forbid+circumvention of technological measures to the extent such circumvention+is effected by exercising rights under this License with respect to+the covered work, and you disclaim any intention to limit operation or+modification of the work as a means of enforcing, against the work's+users, your or third parties' legal rights to forbid circumvention of+technological measures.++ 4. Conveying Verbatim Copies.++ You may convey verbatim copies of the Program's source code as you+receive it, in any medium, provided that you conspicuously and+appropriately publish on each copy an appropriate copyright notice;+keep intact all notices stating that this License and any+non-permissive terms added in accord with section 7 apply to the code;+keep intact all notices of the absence of any warranty; and give all+recipients a copy of this License along with the Program.++ You may charge any price or no price for each copy that you convey,+and you may offer support or warranty protection for a fee.++ 5. Conveying Modified Source Versions.++ You may convey a work based on the Program, or the modifications to+produce it from the Program, in the form of source code under the+terms of section 4, provided that you also meet all of these conditions:++ a) The work must carry prominent notices stating that you modified+ it, and giving a relevant date.++ b) The work must carry prominent notices stating that it is+ released under this License and any conditions added under section+ 7. This requirement modifies the requirement in section 4 to+ "keep intact all notices".++ c) You must license the entire work, as a whole, under this+ License to anyone who comes into possession of a copy. This+ License will therefore apply, along with any applicable section 7+ additional terms, to the whole of the work, and all its parts,+ regardless of how they are packaged. This License gives no+ permission to license the work in any other way, but it does not+ invalidate such permission if you have separately received it.++ d) If the work has interactive user interfaces, each must display+ Appropriate Legal Notices; however, if the Program has interactive+ interfaces that do not display Appropriate Legal Notices, your+ work need not make them do so.++ A compilation of a covered work with other separate and independent+works, which are not by their nature extensions of the covered work,+and which are not combined with it such as to form a larger program,+in or on a volume of a storage or distribution medium, is called an+"aggregate" if the compilation and its resulting copyright are not+used to limit the access or legal rights of the compilation's users+beyond what the individual works permit. Inclusion of a covered work+in an aggregate does not cause this License to apply to the other+parts of the aggregate.++ 6. Conveying Non-Source Forms.++ You may convey a covered work in object code form under the terms+of sections 4 and 5, provided that you also convey the+machine-readable Corresponding Source under the terms of this License,+in one of these ways:++ a) Convey the object code in, or embodied in, a physical product+ (including a physical distribution medium), accompanied by the+ Corresponding Source fixed on a durable physical medium+ customarily used for software interchange.++ b) Convey the object code in, or embodied in, a physical product+ (including a physical distribution medium), accompanied by a+ written offer, valid for at least three years and valid for as+ long as you offer spare parts or customer support for that product+ model, to give anyone who possesses the object code either (1) a+ copy of the Corresponding Source for all the software in the+ product that is covered by this License, on a durable physical+ medium customarily used for software interchange, for a price no+ more than your reasonable cost of physically performing this+ conveying of source, or (2) access to copy the+ Corresponding Source from a network server at no charge.++ c) Convey individual copies of the object code with a copy of the+ written offer to provide the Corresponding Source. This+ alternative is allowed only occasionally and noncommercially, and+ only if you received the object code with such an offer, in accord+ with subsection 6b.++ d) Convey the object code by offering access from a designated+ place (gratis or for a charge), and offer equivalent access to the+ Corresponding Source in the same way through the same place at no+ further charge. You need not require recipients to copy the+ Corresponding Source along with the object code. If the place to+ copy the object code is a network server, the Corresponding Source+ may be on a different server (operated by you or a third party)+ that supports equivalent copying facilities, provided you maintain+ clear directions next to the object code saying where to find the+ Corresponding Source. Regardless of what server hosts the+ Corresponding Source, you remain obligated to ensure that it is+ available for as long as needed to satisfy these requirements.++ e) Convey the object code using peer-to-peer transmission, provided+ you inform other peers where the object code and Corresponding+ Source of the work are being offered to the general public at no+ charge under subsection 6d.++ A separable portion of the object code, whose source code is excluded+from the Corresponding Source as a System Library, need not be+included in conveying the object code work.++ A "User Product" is either (1) a "consumer product", which means any+tangible personal property which is normally used for personal, family,+or household purposes, or (2) anything designed or sold for incorporation+into a dwelling. In determining whether a product is a consumer product,+doubtful cases shall be resolved in favor of coverage. For a particular+product received by a particular user, "normally used" refers to a+typical or common use of that class of product, regardless of the status+of the particular user or of the way in which the particular user+actually uses, or expects or is expected to use, the product. A product+is a consumer product regardless of whether the product has substantial+commercial, industrial or non-consumer uses, unless such uses represent+the only significant mode of use of the product.++ "Installation Information" for a User Product means any methods,+procedures, authorization keys, or other information required to install+and execute modified versions of a covered work in that User Product from+a modified version of its Corresponding Source. The information must+suffice to ensure that the continued functioning of the modified object+code is in no case prevented or interfered with solely because+modification has been made.++ If you convey an object code work under this section in, or with, or+specifically for use in, a User Product, and the conveying occurs as+part of a transaction in which the right of possession and use of the+User Product is transferred to the recipient in perpetuity or for a+fixed term (regardless of how the transaction is characterized), the+Corresponding Source conveyed under this section must be accompanied+by the Installation Information. But this requirement does not apply+if neither you nor any third party retains the ability to install+modified object code on the User Product (for example, the work has+been installed in ROM).++ The requirement to provide Installation Information does not include a+requirement to continue to provide support service, warranty, or updates+for a work that has been modified or installed by the recipient, or for+the User Product in which it has been modified or installed. Access to a+network may be denied when the modification itself materially and+adversely affects the operation of the network or violates the rules and+protocols for communication across the network.++ Corresponding Source conveyed, and Installation Information provided,+in accord with this section must be in a format that is publicly+documented (and with an implementation available to the public in+source code form), and must require no special password or key for+unpacking, reading or copying.++ 7. Additional Terms.++ "Additional permissions" are terms that supplement the terms of this+License by making exceptions from one or more of its conditions.+Additional permissions that are applicable to the entire Program shall+be treated as though they were included in this License, to the extent+that they are valid under applicable law. If additional permissions+apply only to part of the Program, that part may be used separately+under those permissions, but the entire Program remains governed by+this License without regard to the additional permissions.++ When you convey a copy of a covered work, you may at your option+remove any additional permissions from that copy, or from any part of+it. (Additional permissions may be written to require their own+removal in certain cases when you modify the work.) You may place+additional permissions on material, added by you to a covered work,+for which you have or can give appropriate copyright permission.++ Notwithstanding any other provision of this License, for material you+add to a covered work, you may (if authorized by the copyright holders of+that material) supplement the terms of this License with terms:++ a) Disclaiming warranty or limiting liability differently from the+ terms of sections 15 and 16 of this License; or++ b) Requiring preservation of specified reasonable legal notices or+ author attributions in that material or in the Appropriate Legal+ Notices displayed by works containing it; or++ c) Prohibiting misrepresentation of the origin of that material, or+ requiring that modified versions of such material be marked in+ reasonable ways as different from the original version; or++ d) Limiting the use for publicity purposes of names of licensors or+ authors of the material; or++ e) Declining to grant rights under trademark law for use of some+ trade names, trademarks, or service marks; or++ f) Requiring indemnification of licensors and authors of that+ material by anyone who conveys the material (or modified versions of+ it) with contractual assumptions of liability to the recipient, for+ any liability that these contractual assumptions directly impose on+ those licensors and authors.++ All other non-permissive additional terms are considered "further+restrictions" within the meaning of section 10. If the Program as you+received it, or any part of it, contains a notice stating that it is+governed by this License along with a term that is a further+restriction, you may remove that term. If a license document contains+a further restriction but permits relicensing or conveying under this+License, you may add to a covered work material governed by the terms+of that license document, provided that the further restriction does+not survive such relicensing or conveying.++ If you add terms to a covered work in accord with this section, you+must place, in the relevant source files, a statement of the+additional terms that apply to those files, or a notice indicating+where to find the applicable terms.++ Additional terms, permissive or non-permissive, may be stated in the+form of a separately written license, or stated as exceptions;+the above requirements apply either way.++ 8. Termination.++ You may not propagate or modify a covered work except as expressly+provided under this License. Any attempt otherwise to propagate or+modify it is void, and will automatically terminate your rights under+this License (including any patent licenses granted under the third+paragraph of section 11).++ However, if you cease all violation of this License, then your+license from a particular copyright holder is reinstated (a)+provisionally, unless and until the copyright holder explicitly and+finally terminates your license, and (b) permanently, if the copyright+holder fails to notify you of the violation by some reasonable means+prior to 60 days after the cessation.++ Moreover, your license from a particular copyright holder is+reinstated permanently if the copyright holder notifies you of the+violation by some reasonable means, this is the first time you have+received notice of violation of this License (for any work) from that+copyright holder, and you cure the violation prior to 30 days after+your receipt of the notice.++ Termination of your rights under this section does not terminate the+licenses of parties who have received copies or rights from you under+this License. If your rights have been terminated and not permanently+reinstated, you do not qualify to receive new licenses for the same+material under section 10.++ 9. Acceptance Not Required for Having Copies.++ You are not required to accept this License in order to receive or+run a copy of the Program. Ancillary propagation of a covered work+occurring solely as a consequence of using peer-to-peer transmission+to receive a copy likewise does not require acceptance. However,+nothing other than this License grants you permission to propagate or+modify any covered work. These actions infringe copyright if you do+not accept this License. Therefore, by modifying or propagating a+covered work, you indicate your acceptance of this License to do so.++ 10. Automatic Licensing of Downstream Recipients.++ Each time you convey a covered work, the recipient automatically+receives a license from the original licensors, to run, modify and+propagate that work, subject to this License. You are not responsible+for enforcing compliance by third parties with this License.++ An "entity transaction" is a transaction transferring control of an+organization, or substantially all assets of one, or subdividing an+organization, or merging organizations. If propagation of a covered+work results from an entity transaction, each party to that+transaction who receives a copy of the work also receives whatever+licenses to the work the party's predecessor in interest had or could+give under the previous paragraph, plus a right to possession of the+Corresponding Source of the work from the predecessor in interest, if+the predecessor has it or can get it with reasonable efforts.++ You may not impose any further restrictions on the exercise of the+rights granted or affirmed under this License. For example, you may+not impose a license fee, royalty, or other charge for exercise of+rights granted under this License, and you may not initiate litigation+(including a cross-claim or counterclaim in a lawsuit) alleging that+any patent claim is infringed by making, using, selling, offering for+sale, or importing the Program or any portion of it.++ 11. Patents.++ A "contributor" is a copyright holder who authorizes use under this+License of the Program or a work on which the Program is based. The+work thus licensed is called the contributor's "contributor version".++ A contributor's "essential patent claims" are all patent claims+owned or controlled by the contributor, whether already acquired or+hereafter acquired, that would be infringed by some manner, permitted+by this License, of making, using, or selling its contributor version,+but do not include claims that would be infringed only as a+consequence of further modification of the contributor version. For+purposes of this definition, "control" includes the right to grant+patent sublicenses in a manner consistent with the requirements of+this License.++ Each contributor grants you a non-exclusive, worldwide, royalty-free+patent license under the contributor's essential patent claims, to+make, use, sell, offer for sale, import and otherwise run, modify and+propagate the contents of its contributor version.++ In the following three paragraphs, a "patent license" is any express+agreement or commitment, however denominated, not to enforce a patent+(such as an express permission to practice a patent or covenant not to+sue for patent infringement). To "grant" such a patent license to a+party means to make such an agreement or commitment not to enforce a+patent against the party.++ If you convey a covered work, knowingly relying on a patent license,+and the Corresponding Source of the work is not available for anyone+to copy, free of charge and under the terms of this License, through a+publicly available network server or other readily accessible means,+then you must either (1) cause the Corresponding Source to be so+available, or (2) arrange to deprive yourself of the benefit of the+patent license for this particular work, or (3) arrange, in a manner+consistent with the requirements of this License, to extend the patent+license to downstream recipients. "Knowingly relying" means you have+actual knowledge that, but for the patent license, your conveying the+covered work in a country, or your recipient's use of the covered work+in a country, would infringe one or more identifiable patents in that+country that you have reason to believe are valid.++ If, pursuant to or in connection with a single transaction or+arrangement, you convey, or propagate by procuring conveyance of, a+covered work, and grant a patent license to some of the parties+receiving the covered work authorizing them to use, propagate, modify+or convey a specific copy of the covered work, then the patent license+you grant is automatically extended to all recipients of the covered+work and works based on it.++ A patent license is "discriminatory" if it does not include within+the scope of its coverage, prohibits the exercise of, or is+conditioned on the non-exercise of one or more of the rights that are+specifically granted under this License. You may not convey a covered+work if you are a party to an arrangement with a third party that is+in the business of distributing software, under which you make payment+to the third party based on the extent of your activity of conveying+the work, and under which the third party grants, to any of the+parties who would receive the covered work from you, a discriminatory+patent license (a) in connection with copies of the covered work+conveyed by you (or copies made from those copies), or (b) primarily+for and in connection with specific products or compilations that+contain the covered work, unless you entered into that arrangement,+or that patent license was granted, prior to 28 March 2007.++ Nothing in this License shall be construed as excluding or limiting+any implied license or other defenses to infringement that may+otherwise be available to you under applicable patent law.++ 12. No Surrender of Others' Freedom.++ If conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot convey a+covered work so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you may+not convey it at all. For example, if you agree to terms that obligate you+to collect a royalty for further conveying from those to whom you convey+the Program, the only way you could satisfy both those terms and this+License would be to refrain entirely from conveying the Program.++ 13. Use with the GNU Affero General Public License.++ Notwithstanding any other provision of this License, you have+permission to link or combine any covered work with a work licensed+under version 3 of the GNU Affero General Public License into a single+combined work, and to convey the resulting work. The terms of this+License will continue to apply to the part which is the covered work,+but the special requirements of the GNU Affero General Public License,+section 13, concerning interaction through a network will apply to the+combination as such.++ 14. Revised Versions of this License.++ The Free Software Foundation may publish revised and/or new versions of+the GNU General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++ Each version is given a distinguishing version number. If the+Program specifies that a certain numbered version of the GNU General+Public License "or any later version" applies to it, you have the+option of following the terms and conditions either of that numbered+version or of any later version published by the Free Software+Foundation. If the Program does not specify a version number of the+GNU General Public License, you may choose any version ever published+by the Free Software Foundation.++ If the Program specifies that a proxy can decide which future+versions of the GNU General Public License can be used, that proxy's+public statement of acceptance of a version permanently authorizes you+to choose that version for the Program.++ Later license versions may give you additional or different+permissions. However, no additional obligations are imposed on any+author or copyright holder as a result of your choosing to follow a+later version.++ 15. Disclaimer of Warranty.++ THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY+APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM+IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++ 16. Limitation of Liability.++ IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF+SUCH DAMAGES.++ 17. Interpretation of Sections 15 and 16.++ If the disclaimer of warranty and limitation of liability provided+above cannot be given local legal effect according to their terms,+reviewing courts shall apply local law that most closely approximates+an absolute waiver of all civil liability in connection with the+Program, unless a warranty or assumption of liability accompanies a+copy of the Program in return for a fee.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+state the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This program is free software: you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation, either version 3 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program. If not, see <http://www.gnu.org/licenses/>.++Also add information on how to contact you by electronic and paper mail.++ If the program does terminal interaction, make it output a short+notice like this when it starts in an interactive mode:++ <program> Copyright (C) <year> <name of author>+ This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, your program's commands+might be different; for a GUI interface, you would use an "about box".++ You should also get your employer (if you work as a programmer) or school,+if any, to sign a "copyright disclaimer" for the program, if necessary.+For more information on this, and how to apply and follow the GNU GPL, see+<http://www.gnu.org/licenses/>.++ The GNU General Public License does not permit incorporating your program+into proprietary programs. If your program is a subroutine library, you+may consider it more useful to permit linking proprietary applications with+the library. If this is what you want to do, use the GNU Lesser General+Public License instead of this License. But first, please read+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ examples/ShapeMatch.hs view
@@ -0,0 +1,27 @@+{-#LANGUAGE ParallelListComp#-}+module ShapeMatch where+import CV.Image+import CV.TemplateMatching+import qualified CV.ImageMath as IM+import System.Directory+import Control.Applicative+import Data.Maybe+import Control.Monad+import Data.List+import CV.Drawing+import CV.Transforms+import CV.ImageOp+++main = do+ files <- filter (".png" `isSuffixOf`) <$> getDirectoryContents "shapes/"+ images <- mapM (loadImage.("shapes/"++) >=> (return.fromJust)) files+ Just target <- loadImage "shapePhoto.jpg"+ let ops :: Image GrayScale D32+ ops = target <## + [let ((x,y),v) = simpleTemplateMatch CCORR_NORMED + (target) (scaleToSize Cubic False (sx,sy) img)+ in putTextOp 1 1 fnx (x,y) #> rectOpS 1 1 (x,y) (sx,sy)+ | img <- images | fnx <- files ]+ (sx,sy) = (87, 65)+ saveImage "shapes.png" ops
+ examples/channels.hs view
@@ -0,0 +1,20 @@+{-#LANGUAGE ParallelListComp,ScopedTypeVariables#-}+module Main where+import CV.Image+import CV.ImageOp+import CV.Drawing+import CV.ColourUtils++main = do+ Just x <- loadColorImage "smallLena.jpg"+ let y :: Image LAB D32+ y = rgbToLab x+ saveImage "channels.png" $ montage (3,2) 5 $+ [getChannel Red x <# putTextOp 1 1 "Red" (150,190)+ ,getChannel Green x <# putTextOp 1 1 "Green" (150,190)+ ,getChannel Blue x <# putTextOp 1 1 "Blue" (150,190)+ ,(stretchHistogram $ getChannel LAB_L y) <# putTextOp 0 1.2 "LAB:L" (150,190)+ ,(stretchHistogram $ getChannel LAB_A y) <# putTextOp 0 1.2 "LAB:A" (150,190)+ ,(stretchHistogram $ getChannel LAB_B y) <# putTextOp 0 1.2 "LAB:B" (150,190)+ ]+
+ examples/colourUtils.hs view
@@ -0,0 +1,16 @@+module Main where+import CV.Image+import CV.ColourUtils+import CV.Edges+import Data.Maybe++main = do+ x <- loadImage "smallLena.jpg" >>= return . sobel (2,0) s5 . fromJust+ saveImage "colourUtils.png" $ montage (3,2) 5 $+ [x+ ,balance (0.5,0.2) x+ ,logarithmicCompression x+ ,stretchHistogram x+ ,unsafeImageTo32F $ equalizeHistogram (unsafeImageTo8Bit x)+ ]+
+ examples/distance.hs view
@@ -0,0 +1,21 @@+{-#LANGUAGE ScopedTypeVariables#-}+module Main where+import CV.Image+import CV.Transforms+import CV.ColourUtils+import qualified CV.ImageMath as IM+import CV.Drawing+import CV.ImageOp++import Data.Maybe (fromJust)++main = do+ x <- loadImage "smallLena.jpg" >>= return . IM.moreThan 0.6 . fromJust+ let dtf = distanceTransform L2 M3 x+ (_,((mx,my),v)) = IM.findMinMaxLoc dtf+ saveImage "distance.png" $ montage (3,1) 2 + [unsafeImageTo32F x+ ,(stretchHistogram $ dtf)+ ,(stretchHistogram $ dtf) <# circleOp 1 (mx,my) (round v) Filled+ ]+
+ examples/draw.hs view
@@ -0,0 +1,15 @@+{-#LANGUAGE ParallelListComp,ScopedTypeVariables#-}+module Main where+import CV.Image+import CV.Drawing+import CV.ImageOp++main = do+ Just x <- loadColorImage "smallLena.jpg"+ saveImage "lines.png" $ x <## [(lineOp c t (102,102) (x,204)) + | c <- cycle [(1,0,0),(0,1,0),(0,0,1)] + | t <- cycle [1,3,5::Int]+ | x <- [1,15..204::Int]+ ]+ <# circleOp (0.5,0.6,0.1) (104,104) 30 Filled+
+ examples/edges.hs view
@@ -0,0 +1,14 @@+module Main where+import CV.Image+import CV.Edges++main = do+ Just x <- loadImage "smallLena.jpg"+ saveImage "edges.png" $ montage (3,2) 5 $+ [x+ ,sobel (1,0) s5 x+ ,sobel (0,1) s5 x+ ,laplace l5 x+ ,unsafeImageTo32F $ susan (5,5) 0.5 x+ ,unsafeImageTo32F $ canny 20 40 5 (unsafeImageTo8Bit x)+ ]
+ examples/elaine.jpg view
binary file changed (absent → 8757 bytes)
+ examples/filters.hs view
@@ -0,0 +1,15 @@+module Main where+import CV.Image+import CV.Filters++main = do+ Just x <- loadImage "smallLena.jpg"+ saveImage "filters.png" $ montage (3,2) 5 $+ [x+ ,gaussian (9,9) x+ ,blur (9,9) x+ ,haar (integralImage x) (0,0,10,5)+ ,unsafeImageTo32F $ bilateral 3 9 (unsafeImageTo8Bit x)+ ,unsafeImageTo32F $ median (9,9) (unsafeImageTo8Bit x)+ ]+
+ examples/maximalCC.hs view
@@ -0,0 +1,20 @@+{-#LANGUAGE ParallelListComp,ScopedTypeVariables#-}+module Main where+import CV.Image+import CV.Drawing+import CV.ImageOp+import CV.Transforms+import qualified CV.ImageMath as IM++main = do+ let s :: Image GrayScale D32+ s = empty (300,300) <# circleOp 1 (150,150) 40 Filled + dtf = distanceTransform L2 M3 (unsafeImageTo8Bit s)+ testCircle = (170,160,10)+ (mx,my,r) = IM.maximalCoveringCircle dtf testCircle++ saveImage "cover.png" $ montage (3,1) 2 + [s+ ,(unsafeImageTo32F s) <# circleOp 0 (170,160) 10 (Stroked 2)+ ,empty (300,300) <# circleOp 1 (mx,my) (round r) (Stroked 2) ]+
+ examples/montageDebug.hs view
@@ -0,0 +1,16 @@+module Main where+import CV.Image+import CV.Sampling++-- | Output:+-- splitLena.jpg - Lena image split to tiles with few pixels of black between tiles+-- splitLena2.jpg - Lena image split to tiles and joined safely back to original+main = do+ Just x <- loadImage "smallLena.jpg"+ let pieces = getTiles (60,30) x+ piecesWithCoordinates = getTilesC (30,60) x+ joined = montage (6,3) 5 pieces+ blitted = blitM (205,205) piecesWithCoordinates+ saveImage "splitLena.jpg" joined + saveImage "splitLena2.jpg" blitted+
+ examples/morphology.hs view
@@ -0,0 +1,18 @@+module Main where+import CV.Image+import CV.Morphology++main = do+ Just x <- loadImage "smallLena.jpg"+ saveImage "morphology.png" $ montage (3,3) 5 $+ [x+ ,erode basicSE 2 x+ ,dilate basicSE 2 x+ ,blackTopHat 5 x+ ,whiteTopHat 5 x+ ,open basicSE x+ ,close basicSE x+ ,close (structuringElement (2,8) (1,4) CrossShape) x+ ,open (structuringElement (2,8) (1,4) CrossShape) x+ ]+
+ examples/shapePhoto.jpg view
binary file changed (absent → 55340 bytes)
+ examples/shapes/close.png view
binary file changed (absent → 10521 bytes)
+ examples/shapes/down.png view
binary file changed (absent → 10144 bytes)
+ examples/shapes/left.png view
binary file changed (absent → 10392 bytes)
+ examples/shapes/open.png view
binary file changed (absent → 10187 bytes)
+ examples/shapes/right.png view
binary file changed (absent → 9985 bytes)
+ examples/shapes/up.png view
binary file changed (absent → 10350 bytes)
+ examples/smallLena.jpg view
binary file changed (absent → 37868 bytes)
+ examples/spline.hs view
@@ -0,0 +1,22 @@+{-#LANGUAGE ScopedTypeVariables #-}+module Main where+import CV.Image+import CV.MultiresolutionSpline +import CV.ImageOp+import CV.Drawing+import CV.Filters+import qualified CV.Transforms as T++main = do+ Just x <- loadImage "smallLena.jpg"+ Just y <- loadImage "elaine.jpg"+ m :: Image GrayScale D32 <- create (192,192)+ let gr = getRegion (0,0) (192,192)+ mask = (unsafeImageTo8Bit $ gaussian (3,3) $ m <# rectOp 1 (-1) (0,0) (90,192))+ saveImage "spline.png" $ montage (4,1) 5 $+ [gr x+ ,gr y+ ,unsafeImageTo32F mask+ ,burtAdelsonMerge 4 mask (gr x) (T.flip T.Horizontal $ gr y)+ ]+
+ examples/splitMerge.hs view
@@ -0,0 +1,16 @@+module Main where+import CV.Image+import CV.Sampling++-- | Output:+-- splitLena.jpg - Lena image split to tiles with few pixels of black between tiles+-- splitLena2.jpg - Lena image split to tiles and joined safely back to original+main = do+ Just x <- loadImage "smallLena.jpg"+ let pieces = getTiles (30,30) x+ piecesWithCoordinates = getTilesC (30,30) x+ joined = montage (6,6) 5 pieces+ blitted = blitM (205,205) piecesWithCoordinates+ saveImage "splitLena.jpg" joined + saveImage "splitLena2.jpg" blitted+
+ examples/templateMatching.hs view
@@ -0,0 +1,24 @@+module Main where+import CV.Image+import CV.ColourUtils+import CV.TemplateMatching+import qualified CV.Transforms as T+import CV.ImageOp+import CV.Drawing+import qualified CV.ImageMath as IM++main = do+ Just t <- loadImage "smallLena.jpg"+ Just x <- loadImage "smallLena.jpg"+ let r = (78,80)+ y = getRegion r (16,16) x+ mt = CCOEFF_NORMED++ ((mx,my),d) = simpleTemplateMatch mt t y+ saveImage "templateMatching.png" $ montage (3,1) 5 $+ [x<# rectOpS 0 2 r (26,26) <# putTextOp 0 0.9 "Find this" (95,132)+ ,stretchHistogram $ matchTemplate mt t y + ,t <# rectOpS 0 2 (mx,my) (26,26)<# putTextOp 0 0.9 "Found" (mx,my + 37)+ ]++
+ examples/thresholding.hs view
@@ -0,0 +1,14 @@+module Main where+import CV.Image+import CV.Thresholding++main = do+ Just x <- loadImage "smallLena.jpg"+ saveImage "thresholding.png" $ montage (3,2) 5 $+ [x+ ,unsafeImageTo32F $ nibbly 1.2 0.01 x+ ,unsafeImageTo32F $ otsu 64 x+ ,unsafeImageTo32F $ kittler 0.1 x+ ,unsafeImageTo32F $ bernsen (9,9) 0.2 x+ ]+
+ examples/transforms.hs view
@@ -0,0 +1,22 @@+module Main where+import CV.Image+import CV.ColourUtils+import CV.Transforms+import qualified CV.ImageMath as IM++remHigh x img = IM.mul img (unsafeImageTo32F $ IM.moreThan x img)++main = do+ Just x <- loadImage "smallLena.jpg"+ saveImage "transforms.png" $ montage (3,2) 5 $+ [rotate (pi/3.1) x+ ,montage (2,2) 1 $ [scaleSingleRatio NearestNeighbour 0.48 x+ ,scaleSingleRatio Linear 0.48 x+ ,scaleSingleRatio Area 0.48 x+ ,scaleSingleRatio Cubic 0.48 x]+ ,radialDistort x 0.7+ ,stretchHistogram $ IM.log $ dct $ evenize x+ ,stretchHistogram $ idct $ remHigh 0.2 $ dct $ evenize x+ ,perspectiveTransform x [0.8,0,0.2, 0.2,1,0.1, 0, 0, 1]+ ]+
+ examples/video.hs view
@@ -0,0 +1,19 @@+{-#LANGUAGE ScopedTypeVariables#-}+module Main where+import CV.Image+import CV.Video+import Utils.Stream++main = do+ Just x <- loadImage "smallLena.jpg"+ print "finding capture"+ Just cap <- captureFromCam (-1)+ print "capture acquired"+ -- Just f <- getFrame cap+ --saveImage "video.png" $ f+ imgs :: [Image RGB D32] <- runStream . sideEffect (\_ -> print "frame taken") + . takeS (6*6) + $ streamFromVideo cap+ print (map getSize imgs)+ saveImage "video.png" $ montage (6,6) 2 (imgs)+