diff --git a/C2HS.hs b/C2HS.hs new file mode 100644 --- /dev/null +++ b/C2HS.hs @@ -0,0 +1,220 @@ +-- C->Haskell Compiler: Marshalling library +-- +-- Copyright (c) [1999...2005] Manuel M T Chakravarty +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are met: +-- +-- 1. Redistributions of source code must retain the above copyright notice, +-- this list of conditions and the following disclaimer. +-- 2. Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in the +-- documentation and/or other materials provided with the distribution. +-- 3. The name of the author may not be used to endorse or promote products +-- derived from this software without specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR +-- IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +-- OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN +-- NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED +-- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +-- +--- Description --------------------------------------------------------------- +-- +-- Language: Haskell 98 +-- +-- This module provides the marshaling routines for Haskell files produced by +-- C->Haskell for binding to C library interfaces. It exports all of the +-- low-level FFI (language-independent plus the C-specific parts) together +-- with the C->HS-specific higher-level marshalling routines. +-- + +module C2HS ( + + -- * Re-export the language-independent component of the FFI + module Foreign, + + -- * Re-export the C language component of the FFI + module CForeign, + + -- * Composite marshalling functions + withCStringLenIntConv, peekCStringLenIntConv, withIntConv, withFloatConv, + peekIntConv, peekFloatConv, withBool, peekBool, withEnum, peekEnum, + + -- * Conditional results using 'Maybe' + nothingIf, nothingIfNull, + + -- * Bit masks + combineBitMasks, containsBitMask, extractBitMasks, + + -- * Conversion between C and Haskell types + cIntConv, cFloatConv, cToBool, cFromBool, cToEnum, cFromEnum +) where + + +import Foreign + hiding (Word) + -- Should also hide the Foreign.Marshal.Pool exports in + -- compilers that export them +import CForeign + +import Monad (when, liftM) + + +-- Composite marshalling functions +-- ------------------------------- + +-- Strings with explicit length +-- +withCStringLenIntConv s f = withCStringLen s $ \(p, n) -> f (p, cIntConv n) +peekCStringLenIntConv (s, n) = peekCStringLen (s, cIntConv n) + +-- Marshalling of numerals +-- + +withIntConv :: (Storable b, Integral a, Integral b) + => a -> (Ptr b -> IO c) -> IO c +withIntConv = with. cIntConv + +withFloatConv :: (Storable b, RealFloat a, RealFloat b) + => a -> (Ptr b -> IO c) -> IO c +withFloatConv = with . cFloatConv + +peekIntConv :: (Storable a, Integral a, Integral b) + => Ptr a -> IO b +peekIntConv = liftM cIntConv . peek + +peekFloatConv :: (Storable a, RealFloat a, RealFloat b) + => Ptr a -> IO b +peekFloatConv = liftM cFloatConv . peek + +-- Passing Booleans by reference +-- + +withBool :: (Integral a, Storable a) => Bool -> (Ptr a -> IO b) -> IO b +withBool = with . fromBool + +peekBool :: (Integral a, Storable a) => Ptr a -> IO Bool +peekBool = liftM toBool . peek + + +-- Passing enums by reference +-- + +withEnum :: (Enum a, Integral b, Storable b) => a -> (Ptr b -> IO c) -> IO c +withEnum = with. cFromEnum + +peekEnum :: (Enum a, Integral b, Storable b) => Ptr b -> IO a +peekEnum = liftM cToEnum . peek + + +-- Storing of 'Maybe' values +-- ------------------------- + +instance Storable a => Storable (Maybe a) where + sizeOf _ = sizeOf (undefined :: Ptr ()) + alignment _ = alignment (undefined :: Ptr ()) + + peek p = do + ptr <- peek (castPtr p) + if ptr == nullPtr + then return Nothing + else liftM Just $ peek ptr + + poke p v = do + ptr <- case v of + Nothing -> return nullPtr + Just v' -> new v' + poke (castPtr p) ptr + + +-- Conditional results using 'Maybe' +-- --------------------------------- + +-- Wrap the result into a 'Maybe' type. +-- +-- * the predicate determines when the result is considered to be non-existing, +-- ie, it is represented by `Nothing' +-- +-- * the second argument allows to map a result wrapped into `Just' to some +-- other domain +-- +nothingIf :: (a -> Bool) -> (a -> b) -> a -> Maybe b +nothingIf p f x = if p x then Nothing else Just $ f x + +-- |Instance for special casing null pointers. +-- +nothingIfNull :: (Ptr a -> b) -> Ptr a -> Maybe b +nothingIfNull = nothingIf (== nullPtr) + + +-- Support for bit masks +-- --------------------- + +-- Given a list of enumeration values that represent bit masks, combine these +-- masks using bitwise disjunction. +-- +combineBitMasks :: (Enum a, Bits b) => [a] -> b +combineBitMasks = foldl (.|.) 0 . map (fromIntegral . fromEnum) + +-- Tests whether the given bit mask is contained in the given bit pattern +-- (i.e., all bits set in the mask are also set in the pattern). +-- +containsBitMask :: (Bits a, Enum b) => a -> b -> Bool +bits `containsBitMask` bm = let bm' = fromIntegral . fromEnum $ bm + in + bm' .&. bits == bm' + +-- |Given a bit pattern, yield all bit masks that it contains. +-- +-- * This does *not* attempt to compute a minimal set of bit masks that when +-- combined yield the bit pattern, instead all contained bit masks are +-- produced. +-- +extractBitMasks :: (Bits a, Enum b, Bounded b) => a -> [b] +extractBitMasks bits = + [bm | bm <- [minBound..maxBound], bits `containsBitMask` bm] + + +-- Conversion routines +-- ------------------- + +-- |Integral conversion +-- +cIntConv :: (Integral a, Integral b) => a -> b +cIntConv = fromIntegral + +-- |Floating conversion +-- +cFloatConv :: (RealFloat a, RealFloat b) => a -> b +cFloatConv = realToFrac +-- As this conversion by default goes via `Rational', it can be very slow... +{-# RULES + "cFloatConv/Float->Float" forall (x::Float). cFloatConv x = x; + "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x + #-} + +-- |Obtain C value from Haskell 'Bool'. +-- +cFromBool :: Num a => Bool -> a +cFromBool = fromBool + +-- |Obtain Haskell 'Bool' from C value. +-- +cToBool :: Num a => a -> Bool +cToBool = toBool + +-- |Convert a C enumeration to Haskell. +-- +cToEnum :: (Integral i, Enum e) => i -> e +cToEnum = toEnum . cIntConv + +-- |Convert a Haskell enumeration to C. +-- +cFromEnum :: (Enum e, Integral i) => e -> i +cFromEnum = cIntConv . fromEnum diff --git a/C2HSTools.hs b/C2HSTools.hs new file mode 100644 --- /dev/null +++ b/C2HSTools.hs @@ -0,0 +1,220 @@ +-- C->Haskell Compiler: Marshalling library +-- +-- Copyright (c) [1999...2005] Manuel M T Chakravarty +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are met: +-- +-- 1. Redistributions of source code must retain the above copyright notice, +-- this list of conditions and the following disclaimer. +-- 2. Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in the +-- documentation and/or other materials provided with the distribution. +-- 3. The name of the author may not be used to endorse or promote products +-- derived from this software without specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR +-- IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +-- OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN +-- NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED +-- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +-- +--- Description --------------------------------------------------------------- +-- +-- Language: Haskell 98 +-- +-- This module provides the marshaling routines for Haskell files produced by +-- C->Haskell for binding to C library interfaces. It exports all of the +-- low-level FFI (language-independent plus the C-specific parts) together +-- with the C->HS-specific higher-level marshalling routines. +-- + +module C2HSTools ( + + -- * Re-export the language-independent component of the FFI + module Foreign, + + -- * Re-export the C language component of the FFI + module CForeign, + + -- * Composite marshalling functions + withCStringLenIntConv, peekCStringLenIntConv, withIntConv, withFloatConv, + peekIntConv, peekFloatConv, withBool, peekBool, withEnum, peekEnum, + + -- * Conditional results using 'Maybe' + nothingIf, nothingIfNull, + + -- * Bit masks + combineBitMasks, containsBitMask, extractBitMasks, + + -- * Conversion between C and Haskell types + cIntConv, cFloatConv, cToBool, cFromBool, cToEnum, cFromEnum +) where + + +import Foreign + hiding (Word) + -- Should also hide the Foreign.Marshal.Pool exports in + -- compilers that export them +import CForeign + +import Monad (when, liftM) + + +-- Composite marshalling functions +-- ------------------------------- + +-- Strings with explicit length +-- +withCStringLenIntConv s f = withCStringLen s $ \(p, n) -> f (p, cIntConv n) +peekCStringLenIntConv (s, n) = peekCStringLen (s, cIntConv n) + +-- Marshalling of numerals +-- + +withIntConv :: (Storable b, Integral a, Integral b) + => a -> (Ptr b -> IO c) -> IO c +withIntConv = with. cIntConv + +withFloatConv :: (Storable b, RealFloat a, RealFloat b) + => a -> (Ptr b -> IO c) -> IO c +withFloatConv = with . cFloatConv + +peekIntConv :: (Storable a, Integral a, Integral b) + => Ptr a -> IO b +peekIntConv = liftM cIntConv . peek + +peekFloatConv :: (Storable a, RealFloat a, RealFloat b) + => Ptr a -> IO b +peekFloatConv = liftM cFloatConv . peek + +-- Passing Booleans by reference +-- + +withBool :: (Integral a, Storable a) => Bool -> (Ptr a -> IO b) -> IO b +withBool = with . fromBool + +peekBool :: (Integral a, Storable a) => Ptr a -> IO Bool +peekBool = liftM toBool . peek + + +-- Passing enums by reference +-- + +withEnum :: (Enum a, Integral b, Storable b) => a -> (Ptr b -> IO c) -> IO c +withEnum = with. cFromEnum + +peekEnum :: (Enum a, Integral b, Storable b) => Ptr b -> IO a +peekEnum = liftM cToEnum . peek + + +-- Storing of 'Maybe' values +-- ------------------------- + +instance Storable a => Storable (Maybe a) where + sizeOf _ = sizeOf (undefined :: Ptr ()) + alignment _ = alignment (undefined :: Ptr ()) + + peek p = do + ptr <- peek (castPtr p) + if ptr == nullPtr + then return Nothing + else liftM Just $ peek ptr + + poke p v = do + ptr <- case v of + Nothing -> return nullPtr + Just v' -> new v' + poke (castPtr p) ptr + + +-- Conditional results using 'Maybe' +-- --------------------------------- + +-- Wrap the result into a 'Maybe' type. +-- +-- * the predicate determines when the result is considered to be non-existing, +-- ie, it is represented by `Nothing' +-- +-- * the second argument allows to map a result wrapped into `Just' to some +-- other domain +-- +nothingIf :: (a -> Bool) -> (a -> b) -> a -> Maybe b +nothingIf p f x = if p x then Nothing else Just $ f x + +-- |Instance for special casing null pointers. +-- +nothingIfNull :: (Ptr a -> b) -> Ptr a -> Maybe b +nothingIfNull = nothingIf (== nullPtr) + + +-- Support for bit masks +-- --------------------- + +-- Given a list of enumeration values that represent bit masks, combine these +-- masks using bitwise disjunction. +-- +combineBitMasks :: (Enum a, Bits b) => [a] -> b +combineBitMasks = foldl (.|.) 0 . map (fromIntegral . fromEnum) + +-- Tests whether the given bit mask is contained in the given bit pattern +-- (i.e., all bits set in the mask are also set in the pattern). +-- +containsBitMask :: (Bits a, Enum b) => a -> b -> Bool +bits `containsBitMask` bm = let bm' = fromIntegral . fromEnum $ bm + in + bm' .&. bits == bm' + +-- |Given a bit pattern, yield all bit masks that it contains. +-- +-- * This does *not* attempt to compute a minimal set of bit masks that when +-- combined yield the bit pattern, instead all contained bit masks are +-- produced. +-- +extractBitMasks :: (Bits a, Enum b, Bounded b) => a -> [b] +extractBitMasks bits = + [bm | bm <- [minBound..maxBound], bits `containsBitMask` bm] + + +-- Conversion routines +-- ------------------- + +-- |Integral conversion +-- +cIntConv :: (Integral a, Integral b) => a -> b +cIntConv = fromIntegral + +-- |Floating conversion +-- +cFloatConv :: (RealFloat a, RealFloat b) => a -> b +cFloatConv = realToFrac +-- As this conversion by default goes via `Rational', it can be very slow... +{-# RULES + "cFloatConv/Float->Float" forall (x::Float). cFloatConv x = x; + "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x + #-} + +-- |Obtain C value from Haskell 'Bool'. +-- +cFromBool :: Num a => Bool -> a +cFromBool = fromBool + +-- |Obtain Haskell 'Bool' from C value. +-- +cToBool :: Num a => a -> Bool +cToBool = toBool + +-- |Convert a C enumeration to Haskell. +-- +cToEnum :: (Integral i, Enum e) => i -> e +cToEnum = toEnum . cIntConv + +-- |Convert a Haskell enumeration to C. +-- +cFromEnum :: (Enum e, Integral i) => e -> i +cFromEnum = cIntConv . fromEnum diff --git a/CV.cabal b/CV.cabal new file mode 100644 --- /dev/null +++ b/CV.cabal @@ -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 + diff --git a/CV/Binary.hs b/CV/Binary.hs new file mode 100644 --- /dev/null +++ b/CV/Binary.hs @@ -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 + diff --git a/CV/ColourUtils.chs b/CV/ColourUtils.chs new file mode 100644 --- /dev/null +++ b/CV/ColourUtils.chs @@ -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 + diff --git a/CV/ConnectedComponents.chs b/CV/ConnectedComponents.chs new file mode 100644 --- /dev/null +++ b/CV/ConnectedComponents.chs @@ -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 diff --git a/CV/Conversions.hs b/CV/Conversions.hs new file mode 100644 --- /dev/null +++ b/CV/Conversions.hs @@ -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)))))) + diff --git a/CV/Drawing.chs b/CV/Drawing.chs new file mode 100644 --- /dev/null +++ b/CV/Drawing.chs @@ -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) + + + diff --git a/CV/Edges.chs b/CV/Edges.chs new file mode 100644 --- /dev/null +++ b/CV/Edges.chs @@ -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)) diff --git a/CV/Filters.chs b/CV/Filters.chs new file mode 100644 --- /dev/null +++ b/CV/Filters.chs @@ -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 diff --git a/CV/FunnyStatistics.hs b/CV/FunnyStatistics.hs new file mode 100644 --- /dev/null +++ b/CV/FunnyStatistics.hs @@ -0,0 +1,31 @@ +module CV.FunnyStatistics where + +import CV.Image +import CV.Filters +import qualified CV.ImageMath as IM +import CV.ImageMathOp + +--nthCM s n i = blur s $ (i #- blur s i) |^ n + +r_variance s i = msq #- (m #* m) + where + msq = gaussian s (i #* i) + m = gaussian s i + +variance s i = msq #- (m #* m) + where + msq = blur s (i #* i) + m = blur s i + +stdDev s i = IM.sqrt $ variance s i +r_stdDev s i = IM.sqrt $ r_variance s i + +{- +skewness s i = IM.div (nthCM s 3 i) (stdDev s i |^3) + +kurtosis s i = IM.div (nthCM s 4 i) (stdDev s i |^4) +xx s i = IM.div (nthCM s 6 i) (stdDev s i |^6) + -} + +pearsonSkewness1 s image = IM.div (blur s image #- unsafeImageTo32F (median s (unsafeImageTo32F image))) + (stdDev s image) diff --git a/CV/Gabor.chs b/CV/Gabor.chs new file mode 100644 --- /dev/null +++ b/CV/Gabor.chs @@ -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 + diff --git a/CV/Histogram.chs b/CV/Histogram.chs new file mode 100644 --- /dev/null +++ b/CV/Histogram.chs @@ -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 diff --git a/CV/Image.chs b/CV/Image.chs new file mode 100644 --- /dev/null +++ b/CV/Image.chs @@ -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 + diff --git a/CV/ImageMath.chs b/CV/ImageMath.chs new file mode 100644 --- /dev/null +++ b/CV/ImageMath.chs @@ -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) + + + + diff --git a/CV/ImageMathOp.hs b/CV/ImageMathOp.hs new file mode 100644 --- /dev/null +++ b/CV/ImageMathOp.hs @@ -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 diff --git a/CV/ImageOp.hs b/CV/ImageOp.hs new file mode 100644 --- /dev/null +++ b/CV/ImageOp.hs @@ -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) diff --git a/CV/LightBalance.chs b/CV/LightBalance.chs new file mode 100644 --- /dev/null +++ b/CV/LightBalance.chs @@ -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) + diff --git a/CV/Marking.hs b/CV/Marking.hs new file mode 100644 --- /dev/null +++ b/CV/Marking.hs @@ -0,0 +1,62 @@ +module CV.Marking where + +import CV.Image as Image +import CV.Morphology +import CV.Edges as Edges +import CV.ImageOp as ImageOp +import CV.Sampling +import qualified CV.ImageMath as IM +import CV.Drawing +import CV.ColourUtils +import Foreign.C.Types +import CV.ImageMathOp + + + +-- For easy marking of detected flaws +boxFlaws i = Edges.laplace 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 + + diff --git a/CV/Morphology.chs b/CV/Morphology.chs new file mode 100644 --- /dev/null +++ b/CV/Morphology.chs @@ -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 + {#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 diff --git a/CV/MultiresolutionSpline.hs b/CV/MultiresolutionSpline.hs new file mode 100644 --- /dev/null +++ b/CV/MultiresolutionSpline.hs @@ -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 + diff --git a/CV/Sampling.hs b/CV/Sampling.hs new file mode 100644 --- /dev/null +++ b/CV/Sampling.hs @@ -0,0 +1,116 @@ +module CV.Sampling where + +import CV.Image +import System.Random +import Control.Monad + +import Foreign.C.Types +import qualified CV.ImageMath as IM +import Data.List(partition) + +-- 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) = vb0.9, arbitarily) of +-- image `marks` +getCoordsFromMarks marks = [(x,y) | x <- [0..w-1] + , y <- [0..h-1] + , getPixel (x,y) marks >0.9] + where (w,h) = getSize marks + +getMarkedPatches size source marks + | getSize source == getSize marks = getPatches size coords source + | otherwise = error "Image sizes mismatch" + where coords = getCoordsFromMarks marks + + +---- Get some random image patches +--randomPatches size count image = do +-- coords <- replicateM count $ randomCoord (w,h) +-- return $ getPatches size coords image +-- where +-- (pwidth,pheight) = size +-- (iwidth,iheight) = getSize image +-- (w,h) = (iwidth - pwidth , iheight-pheight) + +---- Get some random pixels from image +--randomPixels count image = do +-- coords <- replicateM count $ randomCoord size +-- return $ map (flip getPixel $ image) $ coords +-- where +-- size = getSize image + +---- Get some random coords from image +--randomCoords :: MonadRandom m => Int -> (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) diff --git a/CV/TemplateMatching.chs b/CV/TemplateMatching.chs new file mode 100644 --- /dev/null +++ b/CV/TemplateMatching.chs @@ -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 diff --git a/CV/Textures.chs b/CV/Textures.chs new file mode 100644 --- /dev/null +++ b/CV/Textures.chs @@ -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 diff --git a/CV/Thresholding.hs b/CV/Thresholding.hs new file mode 100644 --- /dev/null +++ b/CV/Thresholding.hs @@ -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 + diff --git a/CV/Transforms.chs b/CV/Transforms.chs new file mode 100644 --- /dev/null +++ b/CV/Transforms.chs @@ -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 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 diff --git a/CV/Video.chs b/CV/Video.chs new file mode 100644 --- /dev/null +++ b/CV/Video.chs @@ -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 diff --git a/CV/cvWrapLEO.c b/CV/cvWrapLEO.c new file mode 100644 --- /dev/null +++ b/CV/cvWrapLEO.c @@ -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 +#include + +//@-node:aleator.20050908100314.1:Includes +//@+node:aleator.20050908100314.2:Wrappers + +size_t images; + +void incrImageC(void) +{ + images++; +} + +void wrapReleaseImage(IplImage *t) +{ + // printf("%d ",images); + cvReleaseImage(&t); + images--; +} + +void 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; i0.5 ) && (pixel < min) ? pixel : min; + max = (maskP >0.5 ) && (pixel > max) ? pixel : max; + } + (*minVal) = min; (*maxVal) = max; +} + +void wrapSetImageROI(IplImage *i,int x, int y, int w, int h) +{ + CvRect r = cvRect(x,y,w,h); + cvSetImageROI(i,r); +} + + +// Return image that is IPL_DEPTH_8U version of +// given src +IplImage* ensure8U(const IplImage *src) +{ + CvSize size; + IplImage *result; + int channels = src->nChannels; + int dstDepth = IPL_DEPTH_8U; + size = cvGetSize(src); + result = cvCreateImage(size,dstDepth,channels); + + switch(src->depth) { + case IPL_DEPTH_32F: + case IPL_DEPTH_64F: + cvConvertScale(src,result,255.0,0); // Scale the values to [0,255] + return result; + case IPL_DEPTH_8U: + cvConvertScale(src,result,1,0); + return result; + default: + printf("Cannot convert to floating image"); + abort(); + + } +} + +// Return image that is IPL_DEPTH_32F version of +// given src +IplImage* ensure32F(const IplImage *src) +{ + CvSize size; + IplImage *result; + int channels = src->nChannels; + int dstDepth = IPL_DEPTH_32F; + size = cvGetSize(src); + result = cvCreateImage(size,dstDepth,channels); + + switch(src->depth) { + case IPL_DEPTH_32F: + case IPL_DEPTH_64F: + cvConvertScale(src,result,1,0); // Scale the values to [0,255] + return result; + case IPL_DEPTH_8U: + case IPL_DEPTH_8S: + cvConvertScale(src,result,1.0/255.0,0); + return result; + case IPL_DEPTH_16S: + cvConvertScale(src,result,1.0/65535.0,0); + return result; + case IPL_DEPTH_32S: + cvConvertScale(src,result,1.0/4294967295.0,0); + return result; + default: + printf("Cannot convert to floating image"); + abort(); + + } +} + +void wrapSet32F2D(CvArr *arr, int x, int y, double value) +{ + cvSet2D(arr,x,y,cvRealScalar(value)); +} + +double wrapGet32F2D(CvArr *arr, int x, int y) +{ + CvScalar r; + r = cvGet2D(arr,x,y); + return r.val[0]; +} + +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; idepth,img->nChannels); + cvCopy(img, newImage,0); + cvResetImageROI(img); + return newImage; +} + +IplImage* simpleMergeImages(IplImage *a, IplImage *b,int offset_x, int offset_y) +{ + CvSize aSize = cvGetSize(a); + CvSize bSize = cvGetSize(b); + int startx = 0 < offset_x ? 0 : offset_x; + int endx = aSize.width > bSize.width+offset_x ? aSize.width : bSize.width+offset_x ; + + int starty = 0 < offset_y ? 0 : offset_y; + int endy = aSize.height > bSize.height+offset_y ? aSize.height : bSize.height+offset_y ; + + CvSize size; + size.width = endx-startx; + size.height = endy-starty; + + CvRect aPos = cvRect(offset_x<0?-offset_x:0 + ,offset_y<0?-offset_y:0 + ,aSize.width + ,aSize.height); + + CvRect bPos = cvRect(offset_x<0?0:offset_x + ,offset_y<0?0:offset_y + ,bSize.width + ,bSize.height); + + IplImage *resultImage = cvCreateImage(size,a->depth,a->nChannels); + + // Blit the images into bigger result image using cvCopy + cvSetImageROI(resultImage,aPos); + cvCopy(a,resultImage,NULL); + cvSetImageROI(resultImage,bPos); + cvCopy(b,resultImage,NULL); + cvResetImageROI(resultImage); + return resultImage; +} + +void blitImg(IplImage *a, IplImage *b,int offset_x, int offset_y) +{ + CvSize bSize = cvGetSize(b); + CvRect pos = cvRect(offset_x + ,offset_y + ,bSize.width + ,bSize.height); + + // Blit the images b into a using cvCopy + printf("Doing a blit\n"); fflush(stdout); + cvSetImageROI(a,pos); + cvCopy(b,a,NULL); + cvResetImageROI(a); + printf("Done!\n"); fflush(stdout); +} +#define FGET(img,x,y) (((float *)((img)->imageData + (y)*(img)->widthStep))[(x)]) + +IplImage* makeEvenDown(IplImage *src) +{ + CvSize size = cvGetSize(src); + int w = size.width-(size.width % 2); + int h = size.height-(size.height % 2); + IplImage *result = wrapCreateImage32F(w,h,1); + CvRect pos = cvRect(0 + ,0 + ,size.width + ,size.height); + // Blit the images b into a using cvCopy + cvSetImageROI(src,pos); + cvCopy(src,result,NULL); + cvResetImageROI(result); + return result; +} + +IplImage* makeEvenUp(IplImage *src) +{ + CvSize size = cvGetSize(src); + int w = size.width+(size.width % 2); + int h = size.height+(size.height % 2); + int j; + IplImage *result = wrapCreateImage32F(w,h,1); + CvRect pos = cvRect(0 + ,0 + ,size.width + ,size.height); + // Blit the images b into a using cvCopy + cvSetImageROI(result,pos); + cvCopy(src,result,NULL); + cvResetImageROI(result); + if (size.width % 2 == 1) + {for (j=0; j<=size.height; j++) { + FGET(result,size.width,j) = FGET(result,size.width-1,j); } } + if (size.width % 2 == 1) + {for (j=0; j<=size.width; j++) { + FGET(result,j,(size.height)) = FGET(result,j,(size.height-1)); } } + return result; +} + +IplImage* padUp(IplImage *src,int right, int bottom) +{ + CvSize size = cvGetSize(src); + int w = size.width + (right ? 1 : 0); + int h = size.height+ (bottom ? 1 : 0); + int j; + IplImage *result = wrapCreateImage32F(w,h,1); + CvRect pos = cvRect(0 + ,0 + ,size.width + ,size.height); + // Blit the images b into a using cvCopy + cvSetImageROI(result,pos); + cvCopy(src,result,NULL); + cvResetImageROI(result); + if (right) + {for (j=0; j<=size.height; j++) { + FGET(result,size.width,j) = 2*FGET(result,size.width-1,j) + -FGET(result,size.width-2,j); } } + if (bottom) + {for (j=0; j<=size.width; j++) { + + FGET(result,j,(size.height)) = 2*FGET(result,j,(size.height-1)) + -FGET(result,j,(size.height-2)); + } } + return result; +} + +void masked_merge(IplImage *src1, IplImage *mask, IplImage *src2, IplImage *dst) +{ + int i,j; + CvSize size = cvGetSize(dst); + for (i=0; i edgeW ? 1 : dx/edgeW; + float y = dy > edgeW ? 1 : dy/edgeW; + FGET(result,j,i) = x*y; + } + return result; +} + +IplImage* rectangularDistance(int w, int h) { + IplImage *result; + int i,j; + result = wrapCreateImage32F(w,h,1); + for (i=0; i=aSize.width || i+offset_y>=aSize.height || i+offset_y < 0 || j+offset_x<0) continue; + + aA = FGET(aAlpha,j+offset_x,i+offset_y); + bA = FGET(bAlpha,j,i); + fV = aA+bA > 0 ? (FGET(b,j,i)*bA+FGET(a,j+offset_x,i+offset_y)*aA)/(aA+bA) : FGET(b,j,i) ; + FGET(a,j+offset_x,i+offset_y) =fV; + FGET(aAlpha,j+offset_x,i+offset_y) =aA+bA; + } +} + + +void plainBlit(IplImage *a, IplImage *b, int offset_y, int offset_x) +{ + // TODO: Add checks for image type and size + int i,j; + CvSize aSize = cvGetSize(a); + CvSize bSize = cvGetSize(b); + for (i=0; i=aSize.width || i+offset_y<0 || i+offset_y>=aSize.height ) continue; + 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= bSize.width + || y_at_b <0 || y_at_b >= bSize.height) continue; + FGET(a,j,i) =bilinearInterp(b,x_at_b,y_at_b); + // TODO: Check boundaries! #SAFETY + + } +} + + +// Histograms. +void wrapReleaseHist(CvHistogram *hist) +{ + cvReleaseHist(&hist); +} + +CvHistogram* calculateHistogram(IplImage *img,int bins) +{ + float st_range[] = {-1,1}; + float *ranges[] = {st_range}; + int hist_size[] = {bins}; + CvHistogram *result = cvCreateHist(1,hist_size,CV_HIST_ARRAY,ranges,1); + cvCalcHist(&img,result,0,0); + return result; +} + +void get_histogram(IplImage *img,IplImage *mask + ,float a, float b,int isCumulative + ,int binCount + ,double *values) +{ + int i=0; + float st_range[] = {a,b}; + float *ranges[] = {st_range}; + int hist_size[] = {binCount}; + CvHistogram *result = cvCreateHist(1,hist_size,CV_HIST_ARRAY + ,ranges,1); + cvCalcHist(&img,result,isCumulative,mask); + for (i=0;itotal,*maxLines); i++ ) + { + CvPoint* line = (CvPoint*)cvGetSeqElem(lines,i); + xs[i] = line[0].x; xs1[i] = line[1].x; + ys[i] = line[0].y; ys1[i] = line[1].y; + } + *maxLines = MIN(lines->total,*maxLines); + + cvReleaseImage(&tmp); + cvReleaseMemStorage(&storage); + +} + + + +//@-node:aleator.20050908100314.2:Wrappers +//@+node:aleator.20050908100314.3:Utilities +/* These are utilities that operate on opencv primitives but + are not really wrappers.. Due to the fact that I seem to + be incapable to link multiple objects including openCV + headers this seems to be the next best solution. + + Watch out for name collisions! + +*/ +//@+node:aleator.20070906153003:Trigonometric operations + +void calculateAtan(IplImage *src, IplImage *dst) +{ + CvSize imageSize = cvGetSize(dst); + double r=0; int i; int j; + for(i=0; iy) ? x:y;} +inline int imin(int x, int y) {return (x 0) ratio = fabs(desArea/area); + // else ratio=1; + //printf("Ratio(%d,%d) is %lf\n",rx1,ry1,ratio); + s = blurGet2D(intImg,rx1,ry1) + -blurGet2D(intImg,rx1,ry2) + -blurGet2D(intImg,rx2,ry1) + +blurGet2D(intImg,rx2,ry2); + cvSet2D(target,j,i,cvScalarAll(s/area)); + } +} + +double haar_at(IplImage *intImg, + int x1, int y1, int w, int h) +{ + int i,j; + double s = 0; + s = blurGet2D(intImg,x1,y1) + -blurGet2D(intImg,x1,y1+h) + -blurGet2D(intImg,x1+w,y1) + +blurGet2D(intImg,x1+w,y1+h); + return s; +} + +//@nonl +//@-node:aleator.20070827150608:Haar Filters +//@+node:aleator.20070130144337:Statistics along a line +#define SWAP(a,b) { \ + int c = (a); \ + (a) = (b); \ + (b) = c; \ + } + + +double average_of_line(int x0, int y0 + ,int x1, int y1 + ,IplImage *src) { + int steep = abs(y1 - y0) > abs(x1 - x0); + int deltax=0; int deltay=0; + int error=0; + int ystep=0; + int x=0; int y=0; + float sum=0; int len=0; + + if (steep) { SWAP(x0, y0); SWAP(x1, y1); } + if (x0 > x1) { SWAP(x0, x1); SWAP(y0, y1); } + deltax = x1 - x0; + deltay = abs(y1 - y0); + error = 0; + y = y0; + if (y0 < y1) {ystep = 1;} else {ystep = -1;} + for (x=x0; x= deltax) { + y = y + ystep; + error = error - deltax; } + } + return (sum/len); +} + +//@-node:aleator.20070130144337:Statistics along a line +//@+node:aleator.20051130130836:Taking square roots of images + +void sqrtImage(IplImage *src,IplImage *dst) +{ +int i;int j; +double result; +CvSize size = cvGetSize(src); + +for(i=0;iy) return y; else return x;} +int SMABx(double x, CvHistogram *h,int binCount,double t) +{ + int binnedX; double leftSM=0; + double rightSM=0; + int i=0; + binnedX = round(min(1,max(x,0))*(binCount-1)); + + // Calculate left second moment: + for(i=0; i 0.8) && (testij > 0.8))) + {rij=0;} + result += rij; + } + +return result; +} +//@-node:aleator.20070511142414.1:Fitness +//@+node:aleator.20070511145251:Updating distributions + +// This function is used to update distribution. +// Notice that alpha_t must be calculated separately +// and normalization is not applied. +IplImage* adaUpdateDistrImage(IplImage *target + ,IplImage *weigths + ,IplImage *test + ,double at) +{ +CvSize size = cvGetSize(target); +int i,j; +int width = size.width; +int height = size.height; +double tij=0,wij=0,testij=0,rij=0; +IplImage *result = wrapCreateImage32F(width,height,1); +for (i=0; i0.2) && (tij<0.8) ) continue; + if (((tij < 0.2) && (testij < 0.2)) + || ((tij > 0.8) && (testij > 0.8))) + {rij = wij*exp(-at); + cvSetReal2D(result,j,i,rij); } + else + {rij = wij*exp(at); + cvSetReal2D(result,j,i,rij); } + } + +return result; +} + +//@-node:aleator.20070511145251:Updating distributions +//@-node:aleator.20070511142414:Adaboost Learning +//@+node:aleator.20051207074905:LBP + +void get_weighted_histogram(IplImage *src, IplImage *weights, + double start, double end, + int bins, double *histo) +{ + int i,j,index; + double value,weight; + CvSize imageSize = cvGetSize(src); + for(i=0;i=bins) continue; + histo[index] += weight; + } + +} + +// Calculate local binary pattern for image. +// LBP is outgoing array +// of (preallocated) 256 bytes that are assumed to be 0. +void localBinaryPattern(IplImage *src, int *LBP) +{ + int i,j; + int pattern = 0; + double center = 0; + CvSize imageSize = cvGetSize(src); + for(i=1; i center) *1; + pattern += (blurGet2D(src,i,j-1) > center) *2; + pattern += (blurGet2D(src,i+1,j-1) > center) *4; + + pattern += (blurGet2D(src,i-1,j) > center) *8; + pattern += (blurGet2D(src,i+1,j) > center) *16; + + pattern += (blurGet2D(src,i-1,j+1) > center) *32; + pattern += (blurGet2D(src,i,j+1) > center) *64; + pattern += (blurGet2D(src,i+1,j+1) > center) *128; + LBP[pattern]++; + pattern = 0; + } +} + +void localBinaryPattern3(IplImage *src, int *LBP) +{ + int i,j; + int pattern = 0; + double center = 0; + CvSize imageSize = cvGetSize(src); + for(i=1; i center) *1; + pattern += (blurGet2D(src,i,j-3) > center) *2; + pattern += (blurGet2D(src,i+2,j-2) > center) *4; + + pattern += (blurGet2D(src,i-3,j) > center) *8; + pattern += (blurGet2D(src,i+3,j) > center) *16; + + pattern += (blurGet2D(src,i-2,j+2) > center) *32; + pattern += (blurGet2D(src,i,j+3) > center) *64; + pattern += (blurGet2D(src,i+2,j+2) > center) *128; + LBP[pattern]++; + pattern = 0; + } +} +void localBinaryPattern5(IplImage *src, int *LBP) +{ + int i,j; + int pattern = 0; + double center = 0; + CvSize imageSize = cvGetSize(src); + for(i=1; i center) *1; + pattern += (blurGet2D(src,i,j-5) > center) *2; + pattern += (blurGet2D(src,i+4,j-4) > center) *4; + + pattern += (blurGet2D(src,i-5,j) > center) *8; + pattern += (blurGet2D(src,i+5,j) > center) *16; + + pattern += (blurGet2D(src,i-4,j+4) > center) *32; + pattern += (blurGet2D(src,i,j+5) > center) *64; + pattern += (blurGet2D(src,i+4,j+4) > center) *128; + LBP[pattern]++; + pattern = 0; + } +} + +void weighted_localBinaryPattern(IplImage *src,int offsetX,int offsetXY + , IplImage* weights, double *LBP) +{ + int i,j; + int pattern = 0; + double center = 0; + double weight = 0; + CvSize imageSize = cvGetSize(src); + for(i=1; i center) *1; + pattern += (blurGet2D(src,i,j-offsetX) > center) *2; + pattern += (blurGet2D(src,i+offsetXY,j-offsetXY) > center) *4; + + pattern += (blurGet2D(src,i-offsetX,j) > center) *8; + pattern += (blurGet2D(src,i+offsetX,j) > center) *16; + + pattern += (blurGet2D(src,i-offsetXY,j+offsetXY) > center) *32; + pattern += (blurGet2D(src,i,j+offsetX) > center) *64; + pattern += (blurGet2D(src,i+offsetXY,j+offsetXY) > center) *128; + LBP[pattern] += weight; + pattern = 0; + } +} + +void localHorizontalBinaryPattern(IplImage *src, int *LBP) +{ + int i,j; + int pattern = 0; + double center = 0; + CvSize imageSize = cvGetSize(src); + for(i=0; i center) *1; + pattern += (blurGet2D(src,i-3,j) > center) *2; + pattern += (blurGet2D(src,i-2,j) > center) *4; + pattern += (blurGet2D(src,i-1,j) > center) *8; + pattern += (blurGet2D(src,i+1,j) > center) *16; + pattern += (blurGet2D(src,i+2,j) > center) *32; + pattern += (blurGet2D(src,i+3,j) > center) *64; + pattern += (blurGet2D(src,i+4,j) > center) *128; + LBP[pattern]++; + pattern = 0; + } +} + +void localVerticalBinaryPattern(IplImage *src, int *LBP) +{ + int i,j; + int pattern = 0; + double center = 0; + CvSize imageSize = cvGetSize(src); + for(i=0; i center) *1; + pattern += (blurGet2D(src,i,j-3) > center) *2; + pattern += (blurGet2D(src,i,j-2) > center) *4; + pattern += (blurGet2D(src,i,j-1) > center) *8; + pattern += (blurGet2D(src,i,j+1) > center) *16; + pattern += (blurGet2D(src,i,j+2) > center) *32; + pattern += (blurGet2D(src,i,j+3) > center) *64; + pattern += (blurGet2D(src,i,j+4) > center) *128; + LBP[pattern]++; + pattern = 0; + } +} + + +//@-node:aleator.20051207074905:LBP +//@+node:aleator.20051109102750:Selective Average +// Assuming grayscale image calculate local selective average of point x y +inline double calcSelectiveAvg(IplImage *img,double t + ,int x, int y + ,int wwidth, int wheight) +{ +int i,j; +double accum=0; +double count=0; +double centerValue; double processed=0; +CvSize size = cvGetSize(img); +centerValue = blurGet2D(img,x,y); + +for (i=-wwidth; i=size.width + || y+j<0 || y+j>=size.height) + continue; + + processed = blurGet2D(img,x+i,y+j); + if (fabs(processed-centerValue) %d is %f\n",j,i,(i+j*h),d[i+j*h]); + FGET(img,j,i) = d[j*h+i]; + } + } + return img; +} + +IplImage *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 %d is %f\n",j,i,(i+j*h),d[i+j*h]); + FGET(img,j,i) = d[j*h+i]; + } + } + return img; +} + +IplImage *acquireImageSlowComplex(int w, int h, complex double *d) +{ + IplImage *img; + int i,j; + img = cvCreateImage(cvSize(w,h), IPL_DEPTH_32F,1); + for (i=0; istorage)); + free(f); + +} + +int reset_contour(FoundContours *f) +{ + f->contour = f->start; +} + +int cur_contour_size(FoundContours *f) +{ + return f->contour->total; +} + +double contour_area(FoundContours *f) +{ + return cvContourArea(f->contour,CV_WHOLE_SEQ,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; icontour,i); + if (pt==0) {printf("point out of contour\n"); exit(1);} + xs[i] = pt->x; + ys[i] = pt->y; + } + +} + +void print_contour(FoundContours *fc) +{ + int i=0; + CvPoint *pt=0; + for (i=0; icontour->total;++i) + { + pt = (CvPoint*)cvGetSeqElem(fc->contour,i); + printf("PT=%d,%d\n",pt->x,pt->y); + } +} + +/* void draw_contour(FoundContours *fc,double color + , IplImage *img, IplImage *dst) +{ + cvDrawContours( dst, fc->start, color, color, -1, 0, 8 + , cvPoint(0,0)); +} */ + + +FoundContours* get_contours(IplImage *src1) +{ + CvSize size; + IplImage *src = ensure8U(src1); + //int dstDepth = IPL_DEPTH_8U; + //size = cvGetSize(src1); + //src = cvCreateImage(size,dstDepth,1); + //cvCopy(src1,src,NULL); + + + CvPoint* pt=0; + int i=0; + + CvMemStorage *storage=0; + CvSeq *contour=0; + FoundContours* result = (FoundContours*)malloc(sizeof(FoundContours)); + storage = cvCreateMemStorage(0); + + cvFindContours( src,storage + , &contour + , sizeof(CvContour) + ,CV_RETR_EXTERNAL + //,CV_RETR_CCOMP + ,CV_CHAIN_APPROX_NONE + ,cvPoint(0,0) ); + +// result->contour = cvApproxPoly( result->contour, sizeof(CvContour) +// , result->storage, CV_POLY_APPROX_DP +// , 3, 1 ); + result->start = contour; + result->contour = contour; + result->storage = storage; + + cvReleaseImage(&src); + return result; + + } +//@-node:aleator.20071016114634:Contours +//@+node:aleator.20070814123008:moments +CvMoments* getMoments(IplImage *src, int isBinary) +{ + CvMoments* moments = (CvMoments*) malloc(sizeof(CvMoments)); + cvMoments( src, moments, isBinary); + return moments; +} + +void freeCvMoments(CvMoments *x) +{ + free(x); +} + + +void getHuMoments(CvMoments *src,double *hu) +{ + CvHuMoments* hu_moments = (CvHuMoments*) malloc(sizeof(CvHuMoments)); + cvGetHuMoments( src, hu_moments); + *hu = hu_moments->hu1; ++hu; + *hu = hu_moments->hu2; ++hu; + *hu = hu_moments->hu3; ++hu; + *hu = hu_moments->hu4; ++hu; + *hu = hu_moments->hu5; ++hu; + *hu = hu_moments->hu6; ++hu; + *hu = hu_moments->hu7; + return; +} + +void freeCvHuMoments(CvHuMoments *x) +{ + free(x); +} +//@-node:aleator.20070814123008:moments +//@+node:aleator.20060727102514:blobCount +int blobCount(IplImage *src) +{ + int contourCount=0; + CvMemStorage* storage = cvCreateMemStorage(0); + CvSeq* contour = 0; + + contourCount = cvFindContours( src, storage, &contour, sizeof(CvContour), CV_RETR_EXTERNAL, CV_CHAIN_APPROX_SIMPLE, cvPoint(0,0) ); + + cvReleaseMemStorage(&storage); + return contourCount; +} + +//@-node:aleator.20060727102514:blobCount +//@+node:aleator.20060413093124.1:sizeFilter +IplImage* sizeFilter(IplImage *src, double minSize, double maxSize) +{ + IplImage* dst = cvCreateImage( cvGetSize(src), IPL_DEPTH_32F, 1 ); + CvMemStorage* storage = cvCreateMemStorage(0); + CvSeq* contour = 0; + + cvFindContours( src, storage, &contour, sizeof(CvContour), CV_RETR_EXTERNAL, CV_CHAIN_APPROX_SIMPLE, cvPoint(0,0) ); + cvZero( dst ); + + for( ; contour != 0; contour = contour->h_next ) + { + double area=fabs(cvContourArea(contour,CV_WHOLE_SEQ,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.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 *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;i4) 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 diff --git a/CV/cvWrapLEO.h b/CV/cvWrapLEO.h new file mode 100644 --- /dev/null +++ b/CV/cvWrapLEO.h @@ -0,0 +1,271 @@ +//@+leo-ver=4-thin +//@+node:aleator.20050908101148.2:@thin cvWrapLEO.h +//@@language c +#ifndef __CVWRAP__ +#define __CVWRAP__ + +#include +#include +#include +#include + +IplImage* wrapCreateImage32F(const int width, const int height, const int channels); +IplImage* wrapCreateImage64F(const int width, const int height, const int channels); + +IplImage* wrapCreateImage8U(const int width, const int height, const int channels); + +void wrapSubRS(const CvArr *src, double s,CvArr *dst); +void wrapSubS(const CvArr *src, double s,CvArr *dst); +void wrapAddS(const CvArr *src, double s, CvArr *dst); + +double wrapAvg(const CvArr *src); +double wrapStdDev(const CvArr *src); +double wrapStdDevMask(const CvArr *src,const CvArr *mask); +double wrapSum(const CvArr *src); +void wrapMinMax(const CvArr *src,const CvArr *mask + ,double *minVal, double *maxVal); +void wrapAbsDiffS(const CvArr *src, double s, CvArr *dst); + +void wrapSetImageROI(IplImage *i,int x, int y, int w, int h); + +IplImage* wrapSobel(IplImage *src,int dx + ,int dy,int size); + +IplImage* wrapLaplace(IplImage *src,int size); + +IplImage* ensure8U(const IplImage *src); +IplImage* ensure32F(const IplImage *src); + +void wrapSet32F2D(CvArr *arr, int x, int y, double value); +double wrapGet32F2D(CvArr *arr, int x, int y); + +void wrapDrawCircle(CvArr *img, int x, int y, int radius, 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 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + 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. + + + Copyright (C) + + 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 . + +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: + + Copyright (C) + 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 +. + + 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 +. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,4 @@ +#! /usr/bin/env runhaskell + +> import Distribution.Simple +> main = defaultMain diff --git a/examples/ShapeMatch.hs b/examples/ShapeMatch.hs new file mode 100644 --- /dev/null +++ b/examples/ShapeMatch.hs @@ -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 diff --git a/examples/channels.hs b/examples/channels.hs new file mode 100644 --- /dev/null +++ b/examples/channels.hs @@ -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) + ] + diff --git a/examples/colourUtils.hs b/examples/colourUtils.hs new file mode 100644 --- /dev/null +++ b/examples/colourUtils.hs @@ -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) + ] + diff --git a/examples/distance.hs b/examples/distance.hs new file mode 100644 --- /dev/null +++ b/examples/distance.hs @@ -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 + ] + diff --git a/examples/draw.hs b/examples/draw.hs new file mode 100644 --- /dev/null +++ b/examples/draw.hs @@ -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 + diff --git a/examples/edges.hs b/examples/edges.hs new file mode 100644 --- /dev/null +++ b/examples/edges.hs @@ -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) + ] diff --git a/examples/elaine.jpg b/examples/elaine.jpg new file mode 100644 Binary files /dev/null and b/examples/elaine.jpg differ diff --git a/examples/filters.hs b/examples/filters.hs new file mode 100644 --- /dev/null +++ b/examples/filters.hs @@ -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) + ] + diff --git a/examples/maximalCC.hs b/examples/maximalCC.hs new file mode 100644 --- /dev/null +++ b/examples/maximalCC.hs @@ -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) ] + diff --git a/examples/montageDebug.hs b/examples/montageDebug.hs new file mode 100644 --- /dev/null +++ b/examples/montageDebug.hs @@ -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 + diff --git a/examples/morphology.hs b/examples/morphology.hs new file mode 100644 --- /dev/null +++ b/examples/morphology.hs @@ -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 + ] + diff --git a/examples/shapePhoto.jpg b/examples/shapePhoto.jpg new file mode 100644 Binary files /dev/null and b/examples/shapePhoto.jpg differ diff --git a/examples/shapes/close.png b/examples/shapes/close.png new file mode 100644 Binary files /dev/null and b/examples/shapes/close.png differ diff --git a/examples/shapes/down.png b/examples/shapes/down.png new file mode 100644 Binary files /dev/null and b/examples/shapes/down.png differ diff --git a/examples/shapes/left.png b/examples/shapes/left.png new file mode 100644 Binary files /dev/null and b/examples/shapes/left.png differ diff --git a/examples/shapes/open.png b/examples/shapes/open.png new file mode 100644 Binary files /dev/null and b/examples/shapes/open.png differ diff --git a/examples/shapes/right.png b/examples/shapes/right.png new file mode 100644 Binary files /dev/null and b/examples/shapes/right.png differ diff --git a/examples/shapes/up.png b/examples/shapes/up.png new file mode 100644 Binary files /dev/null and b/examples/shapes/up.png differ diff --git a/examples/smallLena.jpg b/examples/smallLena.jpg new file mode 100644 Binary files /dev/null and b/examples/smallLena.jpg differ diff --git a/examples/spline.hs b/examples/spline.hs new file mode 100644 --- /dev/null +++ b/examples/spline.hs @@ -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) + ] + diff --git a/examples/splitMerge.hs b/examples/splitMerge.hs new file mode 100644 --- /dev/null +++ b/examples/splitMerge.hs @@ -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 + diff --git a/examples/templateMatching.hs b/examples/templateMatching.hs new file mode 100644 --- /dev/null +++ b/examples/templateMatching.hs @@ -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) + ] + + diff --git a/examples/thresholding.hs b/examples/thresholding.hs new file mode 100644 --- /dev/null +++ b/examples/thresholding.hs @@ -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 + ] + diff --git a/examples/transforms.hs b/examples/transforms.hs new file mode 100644 --- /dev/null +++ b/examples/transforms.hs @@ -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] + ] + diff --git a/examples/video.hs b/examples/video.hs new file mode 100644 --- /dev/null +++ b/examples/video.hs @@ -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) +