diff --git a/CV.cabal b/CV.cabal --- a/CV.cabal +++ b/CV.cabal @@ -1,5 +1,5 @@ Name: CV -Version: 0.3.5 +Version: 0.3.5.1 Description: OpenCV Bindings License: GPL License-file: LICENSE @@ -154,6 +154,7 @@ CV.Bindings.ImgProc, CV.Bindings.Tracking, CV.Bindings.Drawing, + CV.Bindings.Error, CV.Bindings.Features, CV.Bindings.Iterators Extensions: CPP diff --git a/CV/Bindings/Core.hsc b/CV/Bindings/Core.hsc --- a/CV/Bindings/Core.hsc +++ b/CV/Bindings/Core.hsc @@ -228,3 +228,4 @@ -- Discrete Cosine Transform #ccall cvDCT , Ptr -> Ptr -> CInt -> IO () + diff --git a/CV/Bindings/Error.hsc b/CV/Bindings/Error.hsc new file mode 100644 --- /dev/null +++ b/CV/Bindings/Error.hsc @@ -0,0 +1,19 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +module CV.Bindings.Error where + +import Foreign.C.Types +import CV.Bindings.Types + +#strict_import + +#include +#include "cvWrapCore.h" +#include + +#callback CvErrorCallback, CInt -> Ptr CChar -> Ptr CChar -> Ptr CChar -> CInt -> IO CInt +#ccall cvRedirectError, -> Ptr () -> Ptr (Ptr ()) -> IO () +#ccall cvSetErrMode, CInt -> IO CInt + +#num CV_ErrModeLeaf +#num CV_ErrModeParent +#num CV_ErrModeSilent diff --git a/CV/DFT.hs b/CV/DFT.hs --- a/CV/DFT.hs +++ b/CV/DFT.hs @@ -9,11 +9,11 @@ import Foreign.Ptr (castPtr,nullPtr) import System.IO.Unsafe +import Data.Complex type I32 = Image GrayScale D32 type Idft32 = Image DFT D32 -data Icomplex32 = Icomplex32{ re :: I32, im :: I32 } -data Ipolar32 = Ipolar32{ magnitude :: I32, phase :: I32 } +data Ipolar32 = Ipolar32 (Complex D32) dft :: Image GrayScale d -> Image DFT D32 dft i = unsafePerformIO $ do diff --git a/CV/Drawing.chs b/CV/Drawing.chs --- a/CV/Drawing.chs +++ b/CV/Drawing.chs @@ -1,5 +1,5 @@ {-#LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, TypeSynonymInstances, - ViewPatterns, FlexibleContexts #-} + ViewPatterns, FlexibleContexts, ConstraintKinds#-} #include "cvWrapLEO.h" -- | Module for exposing opencv drawing functions. These are meant for quick and dirty marking -- and not for anything presentable. For any real drawing @@ -42,6 +42,7 @@ import CV.ImageOp import Utils.GeometryClass import Utils.Rectangle +import Data.Complex -- | Is the shape filled or just a boundary? data ShapeStyle = Filled | Stroked Int @@ -62,7 +63,7 @@ -- | Draw a Circle circleOp :: (Color a b) -> (Int,Int) -> Int -> ShapeStyle -> ImageOperation a b -- | Draw a Rectangle by supplying two corners - rectOp :: (BoundingBox bb, Integral (ELBB bb)) => (Color a b) -> Int -> bb -> ImageOperation a b + rectOp :: (IntBounded bb) => (Color a b) -> Int -> bb -> ImageOperation a b -- | Draw a filled polygon fillPolyOp :: (Color a b) -> [(Int,Int)] -> ImageOperation a b ellipseBoxOp :: (Color a b) -> C'CvBox2D -> Int -> Int -> ImageOperation a b @@ -88,81 +89,63 @@ instance Drawable RGB D32 where type Color RGB D32 = (D32,D32,D32) - putTextOp (r,g,b) size text (x,y) = ImgOp $ \img -> do + putTextOp (r,g,b) = primTextOp (r,g,b) + lineOp (r,g,b) = primLineOp (r,g,b) + circleOp (r,g,b) = primCircleOp (r,g,b) + ellipseBoxOp (r,g,b) = primEllipseBox (r,g,b,0) + rectOp (r,g,b) = primRectOp (r,g,b) + fillPolyOp (r,g,b) = primFillPolyOp (r,g,b) + +primTextOp (c1,c2,c3) 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) + (fromIntegral x) (fromIntegral y) + (realToFrac c1) (realToFrac c2) (realToFrac c3) - lineOp (r,g,b) t (x,y) (x1,y1) = ImgOp $ \i -> do +primLineOp (c1,c2,c3) 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) - - ellipseBoxOp (r,g,b) = primEllipseBox (r,g,b,0) - + (realToFrac c1) (realToFrac c2) + (realToFrac c3) (fromIntegral t) - circleOp (red,g,b) (x,y) r s = ImgOp $ \i -> do +primCircleOp (c1,c2,c3) (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) + (fromIntegral r) + (realToFrac c1) (realToFrac c2) + (realToFrac c3) $ styleToCV s) - rectOp c = primRectOp c - - fillPolyOp (r,g,b) pts = ImgOp $ \i -> do +primFillPolyOp (c1,c2,c3) 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) + (realToFrac c1) (realToFrac c2) (realToFrac c3) free xs' free ys' +instance Drawable DFT D32 where + type Color DFT D32 = Complex D32 + putTextOp (r:+i) = primTextOp (r,i,0) -- Boy does this feel silly :) + lineOp (r:+i) = primLineOp (r,i,0) + circleOp (r:+i) = primCircleOp (r,i,0) + rectOp (r:+i) = primRectOp (r,i,0) + ellipseBoxOp (r:+i) = primEllipseBox (r,i,0,0) + fillPolyOp (r:+i) = primFillPolyOp (r,i,0) 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) + putTextOp color = primTextOp (color,color,color) + lineOp c = primLineOp (c,c,c) + circleOp c = primCircleOp (c,c,c) ellipseBoxOp c = primEllipseBox (c,c,c,0) - rectOp c = primRectOp (c,c,c) - fillPolyOp c pts = ImgOp $ \i -> do - withImage i $ \img -> do - let (xs,ys) = unzip pts - 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' - + fillPolyOp c = primFillPolyOp (c,c,c) -- | Flood fill a region of the image fillOp :: (Int,Int) -> D32 -> D32 -> D32 -> Bool -> ImageOperation GrayScale D32 diff --git a/CV/Edges.chs b/CV/Edges.chs --- a/CV/Edges.chs +++ b/CV/Edges.chs @@ -10,7 +10,9 @@ -- | For added safety we define the possible -- apertures as constants, since the filters accept only -- specific mask sizes. + ,SobelAperture ,sScharr,s1,s3,s5,s7 + ,LaplacianAperture ,l1,l3,l5,l7 ) where import Foreign.C.Types @@ -43,7 +45,7 @@ sobel dd ap im = unsafeOperate (sobelOp dd ap) im -- | Aperture sizes for sobel operator -newtype SobelAperture = Sb Int +newtype SobelAperture = Sb Int deriving(Eq,Ord,Show,Read) -- | Use Scharr mask instead sScharr = Sb (-1) s1 = Sb 1 @@ -53,7 +55,7 @@ -- | Aperture sizes for laplacian operator -newtype LaplacianAperture = L Int +newtype LaplacianAperture = L Int deriving(Eq,Ord,Show,Read) l1 = L 1 l3 = L 3 l5 = L 5 diff --git a/CV/Histogram.chs b/CV/Histogram.chs --- a/CV/Histogram.chs +++ b/CV/Histogram.chs @@ -1,4 +1,4 @@ -{-#LANGUAGE ForeignFunctionInterface,DatatypeContexts#-} +{-#LANGUAGE ForeignFunctionInterface#-} #include "cvWrapLEO.h" module CV.Histogram where @@ -20,7 +20,7 @@ -- import Utils.List -newtype (Num a) => HistogramData a = HGD [(a,a)] +newtype HistogramData a = HGD [(a,a)] -- | Given a set of images, such as the color channels of color image, and -- a histogram with corresponding number of channels, replace the pixels of diff --git a/CV/Image.chs b/CV/Image.chs --- a/CV/Image.chs +++ b/CV/Image.chs @@ -1,4 +1,4 @@ -{-#LANGUAGE ForeignFunctionInterface, ViewPatterns,ParallelListComp, FlexibleInstances, FlexibleContexts, TypeFamilies, EmptyDataDecls, ScopedTypeVariables, StandaloneDeriving #-} +{-#LANGUAGE ForeignFunctionInterface, ViewPatterns,ParallelListComp, FlexibleInstances, FlexibleContexts, TypeFamilies, EmptyDataDecls, ScopedTypeVariables, StandaloneDeriving, DeriveDataTypeable #-} #include "cvWrapLEO.h" module CV.Image ( -- * Basic types @@ -37,10 +37,9 @@ -- * Pixel level access , GetPixel(..) +, SetPixel(..) , getAllPixels , getAllPixelsRowMajor -, setPixel -, setPixel8U , mapImageInplace -- * Image information @@ -91,6 +90,9 @@ , imageFPTR , ensure32F +-- * Extended error handling +, setCatch +, CvException ) where import System.Posix.Files @@ -104,20 +106,27 @@ import Foreign.Ptr import Control.Parallel.Strategies import Control.DeepSeq +import CV.Bindings.Error import Data.Maybe(catMaybes) import Data.List(genericLength) import Foreign.Marshal.Array import Foreign.Marshal.Alloc import Foreign.Ptr -import Foreign.ForeignPtr (unsafeForeignPtrToPtr) +import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) import Foreign.Storable import System.IO.Unsafe import Data.Word +import Data.Complex +import Data.Complex import Control.Monad +import Control.Exception +import Data.Data +import Data.Typeable + -- Colorspaces -- | Single channel grayscale image @@ -472,12 +481,8 @@ s <- {#get IplImage->widthStep#} c_i peek (castPtr (d`plusPtr` (y*(fromIntegral s) +x*sizeOf (0::Float))):: Ptr Float) -{-#INLINE getPixelOld#-} -getPixelOld (fromIntegral -> x, fromIntegral -> y) image = realToFrac $ unsafePerformIO $ - withGenImage image $ \img -> {#call wrapGet32F2D#} img y x - instance GetPixel (Image DFT D32) where - type P (Image DFT D32) = (D32,D32) + type P (Image DFT D32) = Complex D32 {-#INLINE getPixel#-} getPixel (x,y) i = unsafePerformIO $ withGenImage i $ \c_i -> do @@ -487,7 +492,7 @@ fs = sizeOf (undefined :: Float) re <- peek (castPtr (d`plusPtr` (y*cs + x*2*fs))) im <- peek (castPtr (d`plusPtr` (y*cs +(x*2+1)*fs))) - return (re,im) + return (re:+im) -- #define UGETC(img,color,x,y) (((uint8_t *)((img)->imageData + (y)*(img)->widthStep))[(x)*3+(color)]) instance GetPixel (Image RGB D32) where @@ -797,33 +802,43 @@ resetROI image return x +class SetPixel a where + type SP a :: * + setPixel :: (Int,Int) -> SP a -> a -> IO () --- | Manipulate image pixels. This is slow, ugly and should be avoided ---setPixel :: (CInt,CInt) -> CDouble -> Image c d -> IO () -{-#INLINE setPixelOld#-} -setPixelOld :: (Int,Int) -> D32 -> Image GrayScale D32 -> IO () -setPixelOld (x,y) v image = withGenImage image $ \img -> - {#call wrapSet32F2D#} img (fromIntegral y) (fromIntegral x) (realToFrac v) +instance SetPixel (Image GrayScale D32) where + type SP (Image GrayScale D32) = D32 + {-#INLINE setPixel#-} + setPixel (x,y) v image = withGenImage image $ \c_i -> do + d <- {#get IplImage->imageData#} c_i + s <- {#get IplImage->widthStep#} c_i + poke (castPtr (d`plusPtr` (y*(fromIntegral s) + + x*sizeOf (0::Float))):: Ptr Float) + v -{-#INLINE setPixel#-} -setPixel :: (Int,Int) -> D32 -> Image GrayScale D32 -> IO () -setPixel (x,y) v image = withGenImage image $ \c_i -> do - d <- {#get IplImage->imageData#} c_i - s <- {#get IplImage->widthStep#} c_i - poke (castPtr (d`plusPtr` (y*(fromIntegral s) - + x*sizeOf (0::Float))):: Ptr Float) - v +instance SetPixel (Image GrayScale D8) where + type SP (Image GrayScale D8) = D8 + {-#INLINE setPixel#-} + setPixel (x,y) v image = withGenImage image $ \c_i -> do + d <- {#get IplImage->imageData#} c_i + s <- {#get IplImage->widthStep#} c_i + poke (castPtr (d`plusPtr` (y*(fromIntegral s) + + x*sizeOf (0::Word8))):: Ptr Word8) + v -{-#INLINE setPixel8U#-} -setPixel8U :: (Int,Int) -> Word8 -> Image GrayScale D8 -> IO () -setPixel8U (x,y) v image = withGenImage image $ \c_i -> do - d <- {#get IplImage->imageData#} c_i - s <- {#get IplImage->widthStep#} c_i - poke (castPtr (d`plusPtr` (y*(fromIntegral s) - + x*sizeOf (0::Word8))):: Ptr Word8) - v +instance SetPixel (Image DFT D32) where + type SP (Image DFT D32) = Complex D32 + {-#INLINE setPixel#-} + setPixel (x,y) (re:+im) image = withGenImage image $ \c_i -> do + d <- {#get IplImage->imageData#} c_i + s <- {#get IplImage->widthStep#} c_i + let cs = fromIntegral s + fs = sizeOf (undefined :: Float) + poke (castPtr (d`plusPtr` (y*cs + x*2*fs))) re + poke (castPtr (d`plusPtr` (y*cs + (x*2+1)*fs))) im + getAllPixels image = [getPixel (i,j) image | i <- [0..width-1 ] , j <- [0..height-1]] @@ -856,4 +871,20 @@ | y <- [0..v-1] , x <- [0..u-1] | i <- imgs ] return r + +data CvException = CvException Int String String String Int + deriving (Show, Typeable) + +instance Exception CvException + +setCatch = do + let catch i cstr1 cstr2 cstr3 j = do + func <- peekCString cstr1 + msg <- peekCString cstr2 + file <- peekCString cstr3 + throw (CvException (fromIntegral i) func msg file (fromIntegral j)) + return 0 + cb <- mk'CvErrorCallback catch + c'cvRedirectError cb nullPtr nullPtr + c'cvSetErrMode c'CV_ErrModeSilent diff --git a/CV/Matrix.hs b/CV/Matrix.hs --- a/CV/Matrix.hs +++ b/CV/Matrix.hs @@ -4,7 +4,7 @@ module CV.Matrix ( Exists(..), - Matrix, emptyMatrix ,fromList,toList,toRows,toCols,get,put,withMatPtr + Matrix, emptyMatrix, fromFunction, fromList,toList,toRows,toCols,get,put,withMatPtr , transpose, mxm, rodrigues2 )where @@ -148,6 +148,12 @@ withMatPtr :: Matrix x -> (Ptr C'CvMat -> IO a) -> IO a withMatPtr (Matrix m) op = withForeignPtr m op + +-- | Generate a matrix from a index function +fromFunction :: (Storable t, Exists (Matrix t), Args (Matrix t) ~ (Int,Int)) + => (Int,Int) -> ((Int,Int) -> t) -> Matrix t + +fromFunction s@(w,h) f = fromList s [f (x,y) | x <- [0..w-1], y<-[0..h-1]] -- | Convert a list of floats into Matrix fromList :: forall t . (Storable t, Exists (Matrix t), Args (Matrix t) ~ (Int,Int)) diff --git a/CV/Pixelwise.hs b/CV/Pixelwise.hs --- a/CV/Pixelwise.hs +++ b/CV/Pixelwise.hs @@ -1,16 +1,26 @@ -- | This module is an applicative wrapper for images. It introduces Pixelwise type that -- can be converted from and to grayscale images and which has an applicative and functor -- instances. -{-#LANGUAGE TypeFamilies#-} -module CV.Pixelwise (Pixelwise(..), fromImage, toImage, remap, (<$$>),(<+>)) where -import Control.Applicative +{-#LANGUAGE TypeFamilies, FlexibleContexts, RankNTypes#-} +module CV.Pixelwise (Pixelwise(..) + ,fromImage + ,fromFunction + ,toImage + ,remap + ,remapImage + ,mapImage + ,mapPixels + ,imageFromFunction + ,(<$$>) + ,(<+>)) where +import Control.Applicative import CV.Image import System.IO.Unsafe import Control.Parallel.Strategies -- | A wrapper for allowing functor and applicative instances for non-polymorphic image types. data Pixelwise x = MkP {sizeOf :: (Int,Int) - ,eltOf :: (Int,Int) -> x} + ,eltOf :: (Int,Int) -> x} instance GetPixel (Pixelwise x) where type P (Pixelwise x) = x @@ -18,7 +28,7 @@ instance Sized (Pixelwise a) where type Size (Pixelwise a) = (Int,Int) - getSize (MkP s _) = s + getSize (MkP s _) = s instance Functor Pixelwise where fmap f (MkP s e) = MkP s (fmap f e) @@ -28,19 +38,19 @@ MkP i f <*> MkP j g = MkP (min i j) (f <*> g) instance (Eq a) => Eq (Pixelwise a) where - (MkP (s1@(w1,h1)) e1) == (MkP s2 e2) - = s1==s2 && and [e1 (i,j) == e2 (i,j) | i <- [0..w1-1] , j <- [0..h1-1]] + (MkP (s1@(w1,h1)) e1) == (MkP s2 e2) + = s1==s2 && and [e1 (i,j) == e2 (i,j) | i <- [0..w1-1] , j <- [0..h1-1]] instance Show (Pixelwise a) where - show (MkP s1 e1) - = "MkP "++show (s1)++" " + show (MkP s1 e1) + = "MkP "++show (s1)++" " instance (Num a) => Num (Pixelwise a) where - a + b = (+) <$> a <*> b - a * b = (*) <$> a <*> b - a - b = (-) <$> a <*> b + a + b = (+) <$> a <*> b + a * b = (*) <$> a <*> b + a - b = (-) <$> a <*> b negate = fmap negate - abs = fmap abs + abs = fmap abs signum = error "Signum is undefined for images" fromInteger i = MkP{sizeOf = (1,1),eltOf=const (fromIntegral i)} @@ -53,9 +63,10 @@ -- | Convert a pixelwise construct into an image. fromImage :: (GetPixel b, Sized b, Size b ~ Size (Pixelwise (P b))) => b -> Pixelwise (P b) fromImage i = MkP (getSize i) (flip getPixel $ i) - +-- -- | Convert an image to pixelwise construct. -toImage :: Pixelwise D32 -> Image GrayScale D32 +toImage :: (SetPixel (Image a b), CreateImage (Image a b)) + => Pixelwise (SP (Image a b)) -> Image a b toImage (MkP (w,h) e) = unsafePerformIO $ do img <- create (w,h) sequence_ [setPixel (i,j) (e (i,j)) img @@ -64,14 +75,44 @@ ] return img -toImageP :: Pixelwise D32 -> Image GrayScale D32 -toImageP (MkP (w,h) e) = unsafePerformIO $ do - img <- create (w,h) - let rs = parMap rdeepseq (\j -> unsafePerformIO ( - sequence_ [setPixel (i,j) (e (i,j)) img | i <- [0..w-1]] - >> return True)) - [0..h-1] - all (==True) rs `seq` return img +remapImage :: + (CreateImage (Image a b), + SetPixel (Image a b), + GetPixel (Image a b)) => + (((Int, Int) -> P (Image a b)) -> (Int, Int) -> SP (Image a b)) -> Image a b -> Image a b + +remapImage f i = toImage . remap f $ fromImage i +-- toImage . remap f . fromImage . toImage . remap f . fromImage + +mapPixels :: (t -> x) -> Pixelwise t -> Pixelwise x +mapPixels f (MkP s e) = MkP s (\(i,j) -> f $ e (i,j)) + +mapImage :: + (CreateImage (Image a b), + SetPixel (Image a b), + GetPixel (Image a b)) => + (P (Image a b) -> SP (Image a b)) -> Image a b -> Image a b +mapImage f = toImage . mapPixels f . fromImage + + + +-- | Convert a function into construct into a Pixelwise construct +fromFunction :: (Int, Int) -> ((Int, Int) -> x) -> Pixelwise x +fromFunction size f = MkP size f + +imageFromFunction :: (SetPixel (Image a b), CreateImage (Image a b)) => + (Int,Int) -> ((Int,Int) -> (SP (Image a b))) -> Image a b +imageFromFunction size = toImage . fromFunction size + + +-- toImageP :: Pixelwise D32 -> Image GrayScale D32 +-- toImageP (MkP (w,h) e) = unsafePerformIO $ do +-- img <- create (w,h) +-- let rs = parMap rdeepseq (\j -> unsafePerformIO ( +-- sequence_ [setPixel (i,j) (e (i,j)) img | i <- [0..w-1]] +-- >> return True)) +-- [0..h-1] +-- all (==True) rs `seq` return img -- | Shorthand for `a <$> fromImage b` (<$$>) :: (Size b1 ~ (Int, Int), Sized b1, GetPixel b1) => (P b1 -> b) -> b1 -> Pixelwise b diff --git a/CV/Tracking.hs b/CV/Tracking.hs --- a/CV/Tracking.hs +++ b/CV/Tracking.hs @@ -1,4 +1,4 @@ -{-#LANGUAGE FlexibleContexts, TypeFamilies#-} +{-#LANGUAGE ConstraintKinds, FlexibleContexts, TypeFamilies#-} module CV.Tracking where import CV.Bindings.Tracking import CV.Bindings.Types @@ -12,7 +12,7 @@ import Foreign.Marshal.Utils import System.IO.Unsafe -meanShift :: (BoundingBox a, Integral (ELBB a), ELBB a~Int) => Image GrayScale D32 -> a -> TermCriteria +meanShift :: (IntBounded a, ELBB a~Int) => Image GrayScale D32 -> a -> TermCriteria -> (Double,Rectangle Int) meanShift image window crit = unsafePerformIO $ withGenImage image $ \c_img -> diff --git a/Utils/GeometryClass.hs b/Utils/GeometryClass.hs --- a/Utils/GeometryClass.hs +++ b/Utils/GeometryClass.hs @@ -1,4 +1,4 @@ -{-#LANGUAGE TypeFamilies,FlexibleInstances#-} +{-#LANGUAGE TypeFamilies,FlexibleInstances, ConstraintKinds #-} module Utils.GeometryClass where import Utils.Rectangle @@ -41,7 +41,7 @@ convertBounds :: (BoundingBox a, FromBounds b, ELBB a ~ ELFB b) => a -> b convertBounds = fromBounds . bounds --- type IntBounded a = (BoundingBox a,Integral (ELBB a)) +type IntBounded a = (BoundingBox a,Integral (ELBB a)) class Line2D a where type ELL a :: * diff --git a/cbits/cvIterators.h b/cbits/cvIterators.h --- a/cbits/cvIterators.h +++ b/cbits/cvIterators.h @@ -1,7 +1,7 @@ #ifndef __CVITERATORS__ #define __CVITERATORS__ -#include +#include /* Image Iterators. diff --git a/cbits/cvWrapLEO.c b/cbits/cvWrapLEO.c --- a/cbits/cvWrapLEO.c +++ b/cbits/cvWrapLEO.c @@ -1247,7 +1247,7 @@ spatial smoothing. `w` and `h` determine window size. */ -inline double calcSusanSmooth(IplImage* src, int x, int y +double calcSusanSmooth(IplImage* src, int x, int y ,double t,double sigma,int w, int h) { @@ -1780,7 +1780,7 @@ //@-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 +double calcSelectiveAvg(IplImage *img,double t ,int x, int y ,int wwidth, int wheight) { diff --git a/cbits/cvWrapLEO.h b/cbits/cvWrapLEO.h --- a/cbits/cvWrapLEO.h +++ b/cbits/cvWrapLEO.h @@ -9,9 +9,13 @@ #endif #include -#include -#include -#include +#include +#include +#include +#include +#include +#include +#include #include IplImage* wrapCreateImage32F(const int width, const int height, const int channels); diff --git a/examples/ConnectedComponents.hs b/examples/ConnectedComponents.hs deleted file mode 100644 --- a/examples/ConnectedComponents.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Main where -import CV.Fitting -import CV.Image -import CV.Drawing -import CV.Matrix -import CV.ImageOp - -main = do - let res :: Image GrayScale D32 - res = empty (400,400) - testPts = [(200+100*sin x-80*cos x,200+60*cos x) | x <- [0,0.1..pi]] - mat = fromList (1,length testPts) testPts - ell = fitEllipse mat - bb = minAreaRect mat - br = boundingRect mat - pts = res <## [circleOp 1 (round x, round y) 3 Filled | (x,y) <- testPts] - <# drawBox2Dop 1 bb - saveImage "bb_result.png" pts - print ell - print bb - print br diff --git a/examples/Error.hs b/examples/Error.hs new file mode 100644 --- /dev/null +++ b/examples/Error.hs @@ -0,0 +1,17 @@ +module Main where +import CV.Image +import Prelude hiding (catch) +import CV.Transforms +import CV.ImageMathOp +import Control.Exception + +main = do + setCatch + Just x <- loadImage "smallLena.jpg" + let y = scale Linear (2,2) x + saveImage "poks.ok" (x #+ y) + `catch` (\e -> do let err = show (e :: CvException) + putStr (show e) + return ()) + print "done" + diff --git a/examples/dftPattern.hs b/examples/dftPattern.hs new file mode 100644 --- /dev/null +++ b/examples/dftPattern.hs @@ -0,0 +1,47 @@ +{-#LANGUAGE ScopedTypeVariables#-} +module Main where + +import CV.ColourUtils +import CV.DFT +import CV.Drawing +import CV.Edges +import CV.Filters +import CV.Image +import CV.ImageOp +import CV.Pixelwise +import Control.Applicative hiding ((<**>),empty) +import qualified CV.ImageMath as IM +import qualified CV.Transforms as T +import Data.Complex +import CV.ImageMathOp +import CV.Thresholding + +fi = fromIntegral + +main = do + Just x <- loadImage "d2.png" + let d = dft x + c (x,y) = circleOp (0:+0) (x,y) 23 Filled + d2 = d <# c (155,215) + <# c (400,205) + <# c (180,365) + <# c (425,370) + <# c (40,370) + <# c (540,215) + <# c (200,150) + <# c (375,432) + <# c (260,130) + <# c (315,450) + <# c (262,520) + <# c (315,66) + <# c (375,44) + <# c (202,540) + mag = fst $ dftSplit $ d + pat = gaussian (3,3) $ unsafeImageTo32F $ nibbly 0.01 0.001 $ gaussian (31,31) mag #- gaussian (9,9) mag + saveImage "target.png" $ logarithmicCompression $ fst $ dftSplit $ d2 + saveImage "dftmanip.png" $ montage (3,1) 0 + [ + x + ,logarithmicCompression $ fst $ dftSplit $ (d #* dftMerge (pat,empty (getSize pat))) + ,idft (d #* dftMerge (pat,empty (getSize pat))) + ] diff --git a/examples/dftmanip.hs b/examples/dftmanip.hs new file mode 100644 --- /dev/null +++ b/examples/dftmanip.hs @@ -0,0 +1,38 @@ +{-#LANGUAGE ScopedTypeVariables#-} +module Main where + +import CV.ColourUtils +import CV.DFT +import CV.Drawing +import CV.Edges +import CV.Filters +import CV.Image +import CV.ImageOp +import CV.Pixelwise +import Control.Applicative hiding ((<**>)) +import qualified CV.ImageMath as IM +import qualified CV.Transforms as T +import Data.Complex + +fi = fromIntegral + +main = do + Just x <- loadImage "smallLena.jpg" + let d :: Pixelwise (Complex D32) + d = fromImage $ dft x + mpper f = \(x,y) -> f (x,y) + (sin (7*fi x)) + d2' = remapImage mpper x + d2 = dft d2' + d2c = d2 <# circleOp (0:+0) (130,102) 13 Filled + <# circleOp (0:+0) (71,102) 13 Filled + + dftd1 = (toImage d) <# circleOp (0:+0) (101,101) 30 Filled + saveImage "dftmanip.png" $ montage (2,3) 10 + [ + logarithmicCompression $ fst $ dftSplit $ dftd1 + ,stretchHistogram $ idft dftd1 + ,stretchHistogram $ d2' + ,logarithmicCompression $ fst $ dftSplit $ d2 + ,stretchHistogram $ fst $ dftSplit $ d2c + ,stretchHistogram $ idft $ d2c + ] diff --git a/examples/pixelwise.hs b/examples/pixelwise.hs --- a/examples/pixelwise.hs +++ b/examples/pixelwise.hs @@ -1,28 +1,37 @@ module Main where -import CV.Image -import CV.Edges -import qualified CV.ImageMath as IM + import CV.ColourUtils -import CV.Pixelwise +import CV.DFT +import CV.Drawing +import CV.Edges import CV.Filters -import qualified CV.Transforms as T +import CV.Image +import CV.ImageOp +import CV.Pixelwise import Control.Applicative hiding ((<**>)) +import qualified CV.ImageMath as IM +import qualified CV.Transforms as T +import Data.Complex main = do Just x <- loadImage "smallLena.jpg" - let y = fromImage $ T.flip T.Horizontal x - u = fromImage $ T.flip T.Vertical y - z = fromImage $ T.flip T.Vertical x - saveImage "PixelWise.png" $ montage (3,3) 5 + let y, u, z :: Image GrayScale D32 + y = T.flip T.Horizontal x + u = T.flip T.Vertical y + z = T.flip T.Vertical x + d :: Pixelwise (Complex D32) + d = fromImage $ dft x + saveImage "PixelWise.png" $ montage (2,5) 5 [x,y - ,stretchHistogram . toImage $ (z + y) - ,stretchHistogram . toImage $ y + u + z - ,stretchHistogram . toImage $ fmap (sin . (*9)) $ y - ,stretchHistogram . toImage $ fmap log $ x - - ,stretchHistogram . gaussian (3,3) - . toImage $ atan2 <$$> (sobel (1,0) s5 x) - <+> (sobel (0,1) s5 x) - ,toImage $ fmap (\x -> if x > 0.5 then 0 else 1) $ x - ,toImage $ fmap (\x -> if x > 0.5 && x < 0.6 then 0 else 1) $ x + ,stretchHistogram . toImage $ (fromImage z + fromImage y) + ,stretchHistogram . toImage $ fromImage y + fromImage u + fromImage z + ,stretchHistogram . toImage $ fmap (sin . (*9)) $ fromImage y + ,stretchHistogram . toImage $ fmap log $ fromImage x + + ,stretchHistogram . gaussian (3,3) + . toImage $ atan2 <$$> (sobel (1,0) s5 x) + <+> (sobel (0,1) s5 x) + ,toImage $ fmap (\x -> if x > 0.5 then 0 else 1) $ fromImage x + ,toImage $ fmap (\x -> if x > 0.5 && x < 0.6 then 0 else 1) $ fromImage x + ,logarithmicCompression $ fst $ dftSplit $ (toImage d) <# circleOp (0:+0) (60,60) 30 Filled -- * (fromFunction (getSize d) (\(x,y) -> (exp(-(fromIntegral (91-x)^2+fromIntegral (91-y)^2)/(1600)):+0))) ]