packages feed

CV 0.3.5.3 → 0.3.5.4

raw patch · 29 files changed

+1090/−209 lines, 29 filesdep +filepathdep +parallel-io

Dependencies added: filepath, parallel-io

Files

CV.cabal view
@@ -1,5 +1,5 @@ Name:				 CV-Version:             0.3.5.3+Version:             0.3.5.4 Description:         OpenCV Bindings License:             GPL License-file:        LICENSE@@ -18,6 +18,8 @@                       <http://aleator.github.com/CV/>                      .                      Changelog.+                     0.3.5.4 - Bug fixes and preliminary compatability with opencv 2.4+                     .                      0.3.5 - Many new wrappers, clean ups and other fixes.                      .                      0.3.4 - Pixelwise operations, bug fixes and additional documentation@@ -47,8 +49,11 @@                      examples/elaine.jpg Flag opencv23   Description: Compatability for opencv 2.3.1-  Default:     False+  Default:     True +Flag opencv24+  Description: Compatability for opencv 2.4+  Default:     False  Library     Build-Tools:       c2hs >= 0.16.3@@ -71,6 +76,9 @@     if flag(opencv23)         cpp-options: -DOpenCV23         cc-options: -DOpenCV23+    if flag(opencv24)+        cpp-options: -DOpenCV24+        cc-options: -DOpenCV24     cc-options:        --std=c99 -U__BLOCKS__     extra-libraries:   opencv_calib3d,                        opencv_contrib,@@ -100,7 +108,10 @@                        bindings-DSL >= 1.0.14 && < 1.1,                        vector >= 0.7.0.1 && < 1.1,                        lazysmallcheck >= 0.5 && < 1,-                       storable-tuple >= 0.0.2 && <= 1+                       parallel-io    >= 0.3.2 && < 0.3.3,+                       storable-tuple >= 0.0.2 && <= 1,+                       filepath >= 1.3.0.0 && < 1.4+     Exposed-modules:   CV.Image                                                       ,CV.Arbitrary                                                  ,CV.Binary
CV/Bindings/Features.hsc view
@@ -30,7 +30,9 @@ #field edgeBlurSize, Int #stoptype +#ifndef OpenCV24 #ccall wrapExtractMSER, Ptr <CvArr> -> Ptr <CvArr> -> Ptr (Ptr <CvSeq>) -> Ptr <CvMemStorage> -> Ptr <CvMSERParams> -> IO ()+#endif  #ccall cvMoments ,  Ptr <CvArr> -> Ptr <CvMoments> -> Int -> IO () #ccall cvGetSpatialMoment, Ptr <CvMoments> -> CInt -> CInt -> IO CDouble
CV/Bindings/ImgProc.hsc view
@@ -53,6 +53,52 @@             (cBorderType border)             (realToFrac value) +-- moments++-- | Calculates all spatial and central moments up to the 3rd order+--   @+--   CVAPI(void) cvMoments(+--     const CvArr* arr,+--     CvMoments* moments,+--     int binary CV_DEFAULT(0));@++#ccall cvMoments , Ptr <CvArr> -> Ptr <CvMoments> -> CInt -> IO ()++-- | Retrieve particular spatial moment (m_xy)+--   @+--   CVAPI(double) cvGetSpatialMoment(+--     CvMoments* moments,+--     int x_order,+--     int y_order );@++#ccall cvGetSpatialMoment , Ptr <CvMoments> -> CInt -> CInt -> IO (CDouble)++-- | Retrieve particular central moment (mu_xy)+--   @+--   CVAPI(double) cvGetCentralMoment(+--     CvMoments* moments,+--     int x_order,+--     int y_order );@++#ccall cvGetCentralMoment , Ptr <CvMoments> -> CInt -> CInt -> IO (CDouble)++-- | Retrieve particular normalized central moment (eta_xy)+--   @+--   CVAPI(double) cvGetNormalizedCentralMoment(+--     CvMoments* moments,+--     int x_order,+--     int y_order );@++#ccall cvGetNormalizedCentralMoment , Ptr <CvMoments> -> CInt -> CInt -> IO (CDouble)++-- | Calculates 7 Hu's invariants from precalculated spatial and central moments+--   @+--   CVAPI(void) cvGetHuMoments(+--     CvMoments* moments,+--     CvHuMoments* hu_moments );@++#ccall cvGetHuMoments , Ptr <CvMoments> -> Ptr <CvHuMoments> -> IO ()+ -- CVAPI(void) cvCornerHarris( --   const CvArr* image, --   CvArr* harris_responce,@@ -73,6 +119,18 @@ --   double param1 CV_DEFAULT(0), --   double param2 CV_DEFAULT(0) -- );+--+-- CvSeq* cvHoughCircles(+--   CvArr* image,+--   void* circle_storage,+--   int method,+--   double dp,+--   double min_dist,+--   double param1=100,+--   double param2=100,+--   int min_radius=0,+--   int max_radius=0+-- );  #num CV_HOUGH_STANDARD #num CV_HOUGH_PROBABILISTIC@@ -80,6 +138,7 @@ #num CV_HOUGH_GRADIENT  #ccall cvHoughLines2, Ptr <CvArr> -> Ptr () -> Int -> Double -> Double -> Int -> Double -> Double -> IO ()+#ccall cvHoughCircles, Ptr <CvArr> -> Ptr () -> Int -> Double -> Double -> Double -> Double -> Int -> Int -> IO ()  #ccall wrapFilter2, Ptr  <CvArr> -> Ptr <CvArr> -> Ptr <CvMat> -> Ptr <CvPoint> -> IO () @@ -101,3 +160,94 @@ emptyUniformHistogramND dims =     withArray dims $ \c_sizes ->     c'cvCreateHist 1 c_sizes c'CV_HIST_ARRAY nullPtr 1++-- #ccall cvFindContours, Ptr <CvArr> -> Ptr <CvMemStorage> -> Ptr (Ptr <CvSeq>) -> Cint -> CInt -> CInt-> Ptr <CvPoint>+-- thresholding types++-- | value = value > threshold ? max_value : 0 +#num CV_THRESH_BINARY+-- | value = value > threshold ? 0 : max_value+#num CV_THRESH_BINARY_INV+-- | value = value > threshold ? threshold : value+#num CV_THRESH_TRUNC+-- | value = value > threshold ? value : 0+#num CV_THRESH_TOZERO+-- | value = value > threshold ? 0 : value+#num CV_THRESH_TOZERO_INV+#num CV_THRESH_MASK+-- | Use Otsu algorithm to choose the optimal threshold value;+--   combine the flag with one of the above CV_THRESH_* values.+--   Note: when using this, the threshold value is ignored.+#num CV_THRESH_OTSU++-- | CV_THRESH_OTSU | CV_THRESH_BINARY+#num CV_THRESH_OTSU_BINARY+-- | CV_THRESH_OTSU | CV_THRESH_BINARY_INV+#num CV_THRESH_OTSU_BINARY_INV+-- | CV_THRESH_OTSU | CV_THRESH_TRUNC+#num CV_THRESH_OTSU_TRUNC+-- | CV_THRESH_OTSU | CV_THRESH_TOZERO+#num CV_THRESH_OTSU_TOZERO+-- | CV_THRESH_OTSU | CV_THRESH_TOZERO+#num CV_THRESH_OTSU_TOZERO_INV++-- | Applies fixed-level threshold to grayscale image.+--   This is a basic operation applied before retrieving contours.+--   @+--   CVAPI(double) cvThreshold(+--   const CvArr* src, +--   CvArr* dst,+--   double threshold,+--   double  max_value,+--   int threshold_type);@++#ccall cvThreshold , Ptr <CvArr> -> Ptr <CvArr> -> CDouble -> CDouble -> CInt -> IO (CDouble)++-- | Threshold for each pixel is the mean calculated from /block_size/+--   neighborhood, minus /param1/.+#num CV_ADAPTIVE_THRESH_MEAN_C+-- | Threshold for each pixel is the gaussian mean calculated from /block_size/+--   neighborhood, minus /param1/+#num CV_ADAPTIVE_THRESH_GAUSSIAN_C++-- | Applies adaptive threshold to grayscale image.+--   The two parameters for methods CV_ADAPTIVE_THRESH_MEAN_C and+--   CV_ADAPTIVE_THRESH_GAUSSIAN_C are:+--   neighborhood size (3, 5, 7 etc.),+--   and a constant subtracted from mean (...,-3,-2,-1,0,1,2,3,...)+--   @+--   CVAPI(void) cvAdaptiveThreshold(+--   const CvArr* src,+--   CvArr* dst,+--   double max_value,+--   int adaptive_method CV_DEFAULT(CV_ADAPTIVE_THRESH_MEAN_C),+--   int threshold_type CV_DEFAULT(CV_THRESH_BINARY),+--   int block_size CV_DEFAULT(3),+--   double param1 CV_DEFAULT(5));@++#ccall cvAdaptiveThreshold , Ptr <CvArr> -> Ptr <CvArr> -> CDouble -> CInt -> CInt -> CInt -> CDouble -> IO ()++-- | Fills the connected component until the color difference gets large enough+--   @+--   CVAPI(void) cvFloodFill(+--   CvArr* image,+--   CvPoint seed_point,+--   CvScalar new_val,+--   CvScalar lo_diff CV_DEFAULT(cvScalarAll(0)),+--   CvScalar up_diff CV_DEFAULT(cvScalarAll(0)),+--   CvConnectedComp* comp CV_DEFAULT(NULL),+--   int flags CV_DEFAULT(4),+--   CvArr* mask CV_DEFAULT(NULL));@++-- | Labels connected components by flood filling each with a different value.+--   @+--   void fillConnectedComponents(const IplImage* img, int *count)@++#ccall fillConnectedComponents , Ptr <IplImage> -> Ptr CInt -> IO ()++-- | Masks a connected component by filling it with white, and filling all+--   other pixels with black.+--   @+--   void maskConnectedComponent(const IplImage *src, IplImage *mask, int id)@++#ccall maskConnectedComponent , Ptr <IplImage> -> Ptr <IplImage> -> CInt -> IO ()
CV/Bindings/Types.hsc view
@@ -36,6 +36,27 @@  #opaque_t CvHistogram +#starttype CvContour+#field flags, CInt+#field header_size, CInt+#field h_prev, Ptr <CvSeq>+#field h_next, Ptr <CvSeq>+#field v_prev, Ptr <CvSeq>+#field v_next, Ptr <CvSeq>+#field total,  CInt+#field elem_size, CInt+#field block_max, Ptr Char+#field ptr, Ptr Char+#field delta_elems, CInt+#field free_blocks, Ptr <CvSeqBlock>+#field first, Ptr <CvSeqBlock>+#field rect, <CvRect>+#field color, CInt+#field reserved[0], CInt+#field reserved[1], CInt+#field reserved[2], CInt+#stoptype+ #starttype CvSeq #field flags, CInt #field header_size, CInt@@ -174,8 +195,9 @@ -- #endtype  -+-- | /Spatial and central moments #starttype CvMoments+-- | spatial moments #field m00, CDouble #field m10, CDouble #field m01, CDouble@@ -186,7 +208,7 @@ #field m21, CDouble #field m12, CDouble #field m03, CDouble-+-- | central moments #field mu20, CDouble #field mu11, CDouble #field mu02, CDouble@@ -194,8 +216,19 @@ #field mu21, CDouble #field mu12, CDouble #field mu03, CDouble-+-- | @m00 != 0 ? 1/sqrt(m00) : 0@ #field inv_sqrt_m00, CDouble+#stoptype++-- | Hu invariants+#starttype CvHuMoments+#field hu1 , CDouble+#field hu2 , CDouble+#field hu3 , CDouble+#field hu4 , CDouble+#field hu5 , CDouble+#field hu6 , CDouble+#field hu7 , CDouble #stoptype  #starttype CvTermCriteria
CV/ConnectedComponents.chs view
@@ -4,12 +4,16 @@ module CV.ConnectedComponents        (        -- * Working with connected components-        selectSizedComponents+        fillConnectedComponents+       ,maskConnectedComponent+       ,selectSizedComponents        ,countBlobs        -- * Working with Image moments        -- |Note that these functions should probably go to a different module, since        --  they deal with entire moments of entire images.+       ,spatialMoments        ,centralMoments+       ,normalizedCentralMoments        ,huMoments        -- * Working with component contours aka. object boundaries.        -- |This part is really old code and probably could be improved a lot.@@ -23,19 +27,40 @@ where #include "cvWrapLEO.h" +import CV.Bindings.ImgProc+import CV.Bindings.Types import Control.Monad ((>=>)) import Foreign.C.Types import Foreign.ForeignPtr import Foreign.Marshal.Alloc import Foreign.Marshal.Array+import Foreign.Marshal.Utils (with) import Foreign.Ptr+import Foreign.Storable import System.IO.Unsafe- {#import CV.Image#}  import CV.ImageOp +fillConnectedComponents :: Image GrayScale D8 -> (Image GrayScale D8, Int)+fillConnectedComponents image = unsafePerformIO $ do+  let+    count :: CInt+    count = 0+  withCloneValue image $ \clone ->+    withImage clone $ \pclone ->+      with count $ \pcount -> do+        c'fillConnectedComponents (castPtr pclone) pcount+        c <- peek pcount+        return (clone, fromIntegral c) +maskConnectedComponent :: Image GrayScale D8 -> Int -> Image GrayScale D8+maskConnectedComponent image index = unsafePerformIO $+  withCloneValue image $ \clone ->+    withImage image $ \pimage ->+      withImage clone $ \pclone -> do+        c'maskConnectedComponent (castPtr pimage) (castPtr pclone) (fromIntegral index)+        return clone  -- |Count the number of connected components in the image countBlobs :: Image GrayScale D8 -> Int @@ -51,24 +76,59 @@  -- * Working with Image moments.  +-- Utility function for getting the moments+getMoments :: (Ptr C'CvMoments -> CInt -> CInt -> IO (CDouble)) -> Image GrayScale D32 -> Bool -> [Double]+getMoments f image binary = unsafePerformIO $ do+  withImage image $ \pimage -> do+    let+      moments :: C'CvMoments+      moments = C'CvMoments 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0+    with moments $ \pmoments -> do+      c'cvMoments (castPtr pimage) pmoments (if binary then 1 else 0)+      ms <- sequence [ f pmoments i j+                       | i <- [0..3], j <- [0..3], i+j <= 3 ]+      return (map realToFrac ms) --- |Extract central moments of the image. These are useful for describing the object shape---  for a classifier system.-centralMoments :: Image GrayScale D32 -> Bool -> [Double]+-- | Extract raw spatial moments of the image.+spatialMoments = getMoments c'cvGetSpatialMoment++-- | Extract central moments of the image. These are useful for describing the+--   object shape for a classifier system.+centralMoments = getMoments c'cvGetCentralMoment++-- | Extract normalized central moments of the image.+normalizedCentralMoments = getMoments c'cvGetNormalizedCentralMoment++{- 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 (map realToFrac ms)+-}  -- |Extract Hu-moments of the image. These features are rotation invariant. huMoments :: Image GrayScale D32 -> Bool -> [Double] huMoments image binary = unsafePerformIO $ do+  withImage image $ \pimage -> do+    let+      moments = C'CvMoments 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0+      hu = C'CvHuMoments 0 0 0 0 0 0 0+    with moments $ \pmoments -> do+      with hu $ \phu -> do+        c'cvMoments (castPtr pimage) pmoments (if binary then 1 else 0)+        c'cvGetHuMoments pmoments phu+        (C'CvHuMoments hu1 hu2 hu3 hu4 hu5 hu6 hu7) <- peek phu+        return (map realToFrac [hu1,hu2,hu3,hu4,hu5,hu6,hu7])++{-+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 (map realToFrac hu)+-}  -- read stuff out of hu-moments structure.. This could be done way better. readHu m = do
CV/DFT.hs view
@@ -15,8 +15,11 @@ type Idft32 = Image DFT D32 data Ipolar32 = Ipolar32 (Complex D32) -dft :: Image GrayScale d -> Image DFT D32-dft i = unsafePerformIO $ do+data Swap = SwapQuadrants | DontSwapQuadrants deriving (Eq,Show)++dft = dft' SwapQuadrants+dft' :: Swap -> Image GrayScale d -> Image DFT D32+dft' swap i = unsafePerformIO $ do   --n::(Image GrayScale D32) <- create (w', h')   --n <- copyMakeBorder i 0 (h'-h) 0 (w'-w) BorderReplicate 0   z::(Image GrayScale D32) <- create (w, h)@@ -26,26 +29,37 @@       withImage d $ \d_ptr -> do         c'cvMerge (castPtr i_ptr) (castPtr z_ptr) nullPtr nullPtr (castPtr d_ptr)         c'cvDFT (castPtr d_ptr) (castPtr d_ptr) c'CV_DXT_FORWARD (fromIntegral 0)-        c'swapQuadrants (castPtr d_ptr)+        case swap of+         SwapQuadrants -> c'swapQuadrants (castPtr d_ptr)+         DontSwapQuadrants -> return ()         return d   where     (w,h) = getSize i     --w' = fromIntegral $ c'cvGetOptimalDFTSize (fromIntegral w)     --h' = fromIntegral $ c'cvGetOptimalDFTSize (fromIntegral h) -idft :: Image DFT D32 -> Image GrayScale D32-idft d = unsafePerformIO $ do+idft = idft' SwapQuadrants+idft' :: Swap -> Image DFT D32 -> Image GrayScale D32+idft' swap d = unsafePerformIO $ do   n::(Image GrayScale D32) <- create s   --z::(Image GrayScale D32) <- create s   withImage d $ \d_ptr ->     withImage n $ \n_ptr -> do       --withImage z $ \z_ptr -> do-        c'swapQuadrants (castPtr d_ptr)+        case swap of+         SwapQuadrants -> c'swapQuadrants (castPtr d_ptr)+         DontSwapQuadrants -> return ()+        --c'swapQuadrants (castPtr d_ptr)         c'cvDFT (castPtr d_ptr) (castPtr n_ptr) c'CV_DXT_INV_SCALE (fromIntegral 0)         --c'cvSplit (castPtr d_ptr) (castPtr n_ptr) (castPtr z_ptr) nullPtr nullPtr         return n   where     s = getSize d++swapQuadrants img = unsafePerformIO $ do+            e <- cloneImage img+            withImage e (c'swapQuadrants . castPtr)+            return e  dftSplit :: Image DFT D32 -> (Image GrayScale D32, Image GrayScale D32) dftSplit d = unsafePerformIO $ do
CV/Drawing.chs view
@@ -1,5 +1,5 @@ {-#LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, TypeSynonymInstances, -            ViewPatterns, FlexibleContexts, ConstraintKinds#-}+            ViewPatterns, FlexibleContexts #-} #include "cvWrapLEO.h" -- | Module for exposing opencv drawing functions. These are meant for quick and dirty marking --   and not for anything presentable. For any real drawing@@ -63,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   :: (IntBounded bb) => (Color a b) -> Int -> bb -> ImageOperation a b+    rectOp   :: (BoundingBox bb, Integral (ELBB bb)) => (Color a b) -> Int -> bb -> ImageOperation a b     -- | Draw a filled polygon     fillPolyOp :: (Color a b) -> [(Int,Int)] -> ImageOperation a b     ellipseBoxOp :: (Color a b) -> C'CvBox2D -> Int -> Int -> ImageOperation a b
CV/Features.hs view
@@ -1,6 +1,8 @@ {-#LANGUAGE RecordWildCards, ScopedTypeVariables, TypeFamilies#-} module CV.Features (SURFParams, defaultSURFParams, getSURF+#ifndef OpenCV24                    ,getMSER, MSERParams, mkMSERParams, defaultMSERParams+#endif                    ,moments,Moments,getSpatialMoment,getCentralMoment,getNormalizedCentralMoment) where import CV.Image import CV.Bindings.Types@@ -13,6 +15,7 @@ import Utils.GeometryClass import System.IO.Unsafe +#ifndef OpenCV24 newtype MSERParams = MP C'CvMSERParams deriving (Show)  -- | Create parameters for getMSER.@@ -49,6 +52,7 @@       pts :: [C'CvPoint] <- cvSeqToList ctr       return (map convertPt pts) +#endif  -- TODO: Move this to some utility module withMask :: Maybe (Image GrayScale D8) -> (Ptr C'CvArr -> IO α) -> IO α@@ -106,7 +110,7 @@     ptr_keypoints <- peek ptr_ptr_keypoints     ptr_descriptors <- peek ptr_ptr_descriptors     a <- cvSeqToList ptr_keypoints-    b <- if c'CvSURFParams'extended params /= 1+    b <- if c'CvSURFParams'extended params == 1            then do             es :: [FloatBlock128] <- cvSeqToList ptr_descriptors             return (map (\(FP128 e) -> e) es)
CV/Filters.chs view
@@ -3,8 +3,10 @@ {-#OPTIONS_GHC -fwarn-unused-imports#-}  -- | This module is a collection of various image filters-module CV.Filters(gaussian,gaussianOp+module CV.Filters(+               gaussian,gaussianOp               ,blurOp,blur,blurNS+              ,bilateral               ,HasMedianFiltering,median               ,susan,getCentralMoment,getAbsCentralMoment               ,getMoment,secondMomentBinarize,secondMomentBinarizeOp@@ -77,10 +79,16 @@                                 (\i-> {#call smab#} i w h t) secondMomentAdaptiveBinarize w h t i = unsafeOperate (secondMomentAdaptiveBinarizeOp w h t) i -data SmoothType = BlurNoScale | Blur -                | Gaussian | Median -                | Bilateral-                deriving(Enum)+#c+enum SmoothType {+    BlurNoScale =  CV_BLUR_NO_SCALE,+    Blur        =  CV_BLUR,+    Gaussian    =  CV_GAUSSIAN,+    Median      =  CV_MEDIAN ,+    Bilateral   =  CV_BILATERAL      +};+#endc+{#enum SmoothType {}#}  {#fun cvSmooth as smooth'      {withGenImage* `Image GrayScale D32'@@ -88,39 +96,35 @@     ,`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+-- | Image operation which applies gaussian or unifarm smoothing with a given window size to the image.+gaussianOp,blurOp,blurNSOp :: (Int, Int) -> ImageOperation GrayScale D32+gaussianOp m =  withMask m $ \(w,h) img -> smooth' img img (fromEnum Gaussian) w h 0 0+blurOp m = withMask m $ \(w,h) img -> smooth' img img (fromEnum Blur) w h 0 0+blurNSOp m = withMask m $ \(w,h) img -> smooth' img img (fromEnum BlurNoScale) w h 0 0 -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))"+-- | Create a new image by applying gaussian, or uniform smoothing.+gaussian,blur,blurNS :: (Int, Int) -> Image GrayScale D32 -> Image GrayScale D32+gaussian = unsafeOperate . gaussianOp+blur     = unsafeOperate . blurOp+blurNS   = unsafeOperate . blurNSOp -blurNSOp (w,h) -    | maskIsOk (w,h) = ImgOp $ \img -> -                               smooth' img img (fromEnum BlurNoScale) w h 0 0+withMask (w,h) op +    | maskIsOk (w,h) = ImgOp $ op (w,h)     | 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 $ ++-- | Apply bilateral filtering +bilateral :: (Int,Int) -> (Int,Int) -> Image a D8 -> Image a D8+bilateral (w,h) (s1,s2) 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-+                        (fromIntegral w) (fromIntegral h) +                        (realToFrac s1) (realToFrac s2)  --- TODO: The type is not exactly correct  class HasMedianFiltering a where     median :: (Int,Int) -> a -> a
CV/HoughTransform.hs view
@@ -89,3 +89,11 @@         withImage img $ \c_img ->             c'cvHoughLines2 (castPtr c_img) (castPtr c_m) c'CV_HOUGH_MULTI_SCALE ρ θ t distDiv angleDiv     return $ toList m++houghCirclesGradient :: Image GrayScale D8 -> Int -> Double -> Double -> Double -> Double -> Int -> Int -> [(CFloat, CFloat, CFloat)]+houghCirclesGradient img n dp minDist cannyThresh accumThresh minRad maxRad = unsafePerformIO $ do+    let m :: Matrix (CFloat,CFloat,CFloat) = create (1,n)+    withMatPtr m $ \c_m ->+        withImage img $ \c_img ->+            c'cvHoughCircles (castPtr c_img) (castPtr c_m) c'CV_HOUGH_GRADIENT dp minDist cannyThresh accumThresh minRad maxRad+    return $ toList m
CV/Image.chs view
@@ -1,4 +1,4 @@-{-#LANGUAGE ForeignFunctionInterface, ViewPatterns,ParallelListComp, FlexibleInstances, FlexibleContexts, TypeFamilies, EmptyDataDecls, ScopedTypeVariables, StandaloneDeriving, DeriveDataTypeable #-}+{-#LANGUAGE ForeignFunctionInterface, ViewPatterns,ParallelListComp, FlexibleInstances, FlexibleContexts, TypeFamilies, EmptyDataDecls, ScopedTypeVariables, StandaloneDeriving, DeriveDataTypeable, UndecidableInstances #-} #include "cvWrapLEO.h" module CV.Image ( -- * Basic types@@ -27,6 +27,7 @@ , lab , rgba , rgb+, compose , composeMultichannelImage  -- * IO operations@@ -97,6 +98,7 @@  import System.Mem import System.Directory+import System.FilePath  import Foreign.C.Types import Foreign.C.String@@ -201,10 +203,32 @@ rgba = undefined :: Tag RGBA lab = undefined :: Tag LAB +-- | Typeclass for elements that are build from component elements. For example,+--   RGB images can be constructed from three grayscale images.+class Composes a where+   type Source a :: *+   compose :: Source a -> a +instance (CreateImage (Image RGBA a)) => Composes (Image RGBA a) where+   type Source (Image RGBA a) = (Image GrayScale a, Image GrayScale a+                               ,Image GrayScale a, Image GrayScale a)+   compose (r,g,b,a) = composeMultichannelImage (Just b) (Just g) (Just r) (Just a) rgba++instance (CreateImage (Image RGB a)) => Composes (Image RGB a) where+   type Source (Image RGB a) = (Image GrayScale a, Image GrayScale a, Image GrayScale a)+   compose (r,g,b) = composeMultichannelImage (Just b) (Just g) (Just r) Nothing rgb++instance (CreateImage (Image LAB a)) => Composes (Image LAB a) where+   type Source (Image LAB a) = (Image GrayScale a, Image GrayScale a, Image GrayScale a)+   compose (l,a,b) = composeMultichannelImage (Just l) (Just a) (Just b) Nothing lab++{-# DEPRECATED composeMultichannelImage "This is unsafe. Use compose instead" #-} 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)+composeMultichannelImage = composeMultichannel++composeMultichannel :: (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+composeMultichannel (c2)+                         (c1)                          (c3)                          (c4)                          totag@@ -222,6 +246,7 @@         size = getSize . head . catMaybes $ [c1,c2,c3,c4]  +-- | Typeclass for CV items that can be read from file. Mainly images at this point. class Loadable a where     readFromFile :: FilePath -> IO a @@ -231,28 +256,28 @@         e <- loadImage fp         case e of          Just i -> return i-         Nothing -> fail $ "Could not load "++fp+         Nothing -> throw $ CvIOError $ "Could not load "++fp  instance Loadable ((Image RGB D32)) where     readFromFile fp = do         e <- loadColorImage8 fp         case e of          Just i -> return $ unsafeImageTo32F $ bgrToRgb i-         Nothing -> fail $ "Could not load "++fp+         Nothing -> throw $ CvIOError $ "Could not load "++fp  instance Loadable ((Image RGB D8)) where     readFromFile fp = do         e <- loadColorImage8 fp         case e of          Just i -> return $ bgrToRgb i-         Nothing -> fail $ "Could not load "++fp+         Nothing -> throw $ CvIOError $ "Could not load "++fp  instance Loadable ((Image GrayScale D8)) where     readFromFile fp = do         e <- loadImage8 fp         case e of          Just i -> return i-         Nothing -> fail $ "Could not load "++fp+         Nothing -> throw $ CvIOError $ "Could not load "++fp   -- | This function loads and converts image to an arbitrary format. Notice that it is@@ -276,6 +301,7 @@ loadColorImage8 :: FilePath -> IO (Maybe (Image BGR D8)) loadColorImage8 = unsafeloadUsing imageTo8Bit 1 +-- | Typeclass for elements with a size, such as images and matrices. class Sized a where     type Size a :: *     getSize :: a -> Size a@@ -452,10 +478,10 @@ grayToRGB = S . convertTo (fromIntegral . fromEnum $ CV_GRAY2BGR) 3 . unS  -bgrToRgb :: Image BGR depth -> Image RGB depth+bgrToRgb :: Image BGR D8 -> Image RGB D8 bgrToRgb = S . swapRB . unS -rgbToBgr :: Image BGR depth -> Image RGB depth+rgbToBgr :: Image RGB D8 -> Image BGR D8 rgbToBgr = S . swapRB . unS  swapRB :: BareImage -> BareImage@@ -481,6 +507,15 @@                                          s <- {#get IplImage->widthStep#} c_i                                          peek (castPtr (d`plusPtr` (y*(fromIntegral s) +x*sizeOf (0::Float))):: Ptr Float) +instance GetPixel (Image GrayScale D8) where+    type P (Image GrayScale D8) = D8+    {-#INLINE getPixel#-}+    getPixel (x,y) i = unsafePerformIO $+                        withGenImage i $ \c_i -> do+                                         d <- {#get IplImage->imageData#} c_i+                                         s <- {#get IplImage->widthStep#} c_i+                                         peek (castPtr (d`plusPtr` (y*(fromIntegral s) +x*sizeOf (0::Word8))):: Ptr Word8)+ instance GetPixel (Image DFT D32) where     type P (Image DFT D32) = Complex D32     {-#INLINE getPixel#-}@@ -504,19 +539,65 @@                                          s <- {#get IplImage->widthStep#} c_i                                          let cs = fromIntegral s                                              fs = sizeOf (undefined :: Float)-                                         r <- peek (castPtr (d`plusPtr` (y*cs +x*3*fs)))+                                         b <- peek (castPtr (d`plusPtr` (y*cs +x*3*fs)))                                          g <- peek (castPtr (d`plusPtr` (y*cs +(x*3+1)*fs)))-                                         b <- peek (castPtr (d`plusPtr` (y*cs +(x*3+2)*fs)))+                                         r <- peek (castPtr (d`plusPtr` (y*cs +(x*3+2)*fs)))                                          return (r,g,b)+instance GetPixel (Image BGR D32) where+    type P (Image BGR D32) = (D32,D32,D32)+    {-#INLINE getPixel#-}+    getPixel (x,y) i = unsafePerformIO $+                        withGenImage i $ \c_i -> do+                                         d <- {#get IplImage->imageData#} c_i+                                         s <- {#get IplImage->widthStep#} c_i+                                         let cs = fromIntegral s+                                             fs = sizeOf (undefined :: Float)+                                         b <- peek (castPtr (d`plusPtr` (y*cs +x*3*fs)))+                                         g <- peek (castPtr (d`plusPtr` (y*cs +(x*3+1)*fs)))+                                         r <- peek (castPtr (d`plusPtr` (y*cs +(x*3+2)*fs)))+                                         return (r,g,b)+instance  GetPixel (Image BGR D8) where+    type P (Image BGR D8) = (D8,D8,D8)+    {-#INLINE getPixel#-}+    getPixel (x,y) i = unsafePerformIO $+                        withGenImage i $ \c_i -> do+                                         d <- {#get IplImage->imageData#} c_i+                                         s <- {#get IplImage->widthStep#} c_i+                                         let cs = fromIntegral s+                                             fs = sizeOf (undefined :: D8)+                                         b <- peek (castPtr (d`plusPtr` (y*cs +x*3*fs)))+                                         g <- peek (castPtr (d`plusPtr` (y*cs +(x*3+1)*fs)))+                                         r <- peek (castPtr (d`plusPtr` (y*cs +(x*3+2)*fs)))+                                         return (r,g,b) -getPixelOldRGB (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)+instance  GetPixel (Image RGB D8) where+    type P (Image RGB D8) = (D8,D8,D8)+    {-#INLINE getPixel#-}+    getPixel (x,y) i = unsafePerformIO $+                        withGenImage i $ \c_i -> do+                                         d <- {#get IplImage->imageData#} c_i+                                         s <- {#get IplImage->widthStep#} c_i+                                         let cs = fromIntegral s+                                             fs = sizeOf (undefined :: D8)+                                         b <- peek (castPtr (d`plusPtr` (y*cs +x*3*fs)))+                                         g <- peek (castPtr (d`plusPtr` (y*cs +(x*3+1)*fs)))+                                         r <- peek (castPtr (d`plusPtr` (y*cs +(x*3+2)*fs)))+                                         return (r,g,b) +instance GetPixel (Image LAB D32) where+    type P (Image LAB D32) = (D32,D32,D32)+    {-#INLINE getPixel#-}+    getPixel (x,y) i = unsafePerformIO $+                        withGenImage i $ \c_i -> do+                                         d <- {#get IplImage->imageData#} c_i+                                         s <- {#get IplImage->widthStep#} c_i+                                         let cs = fromIntegral s+                                             fs = sizeOf (undefined :: Float)+                                         l <- peek (castPtr (d`plusPtr` (y*cs +x*3*fs)))+                                         a <- peek (castPtr (d`plusPtr` (y*cs +(x*3+1)*fs)))+                                         b <- peek (castPtr (d`plusPtr` (y*cs +(x*3+2)*fs)))+                                         return (l,a,b)+ -- | Perform (a destructive) inplace map of the image. This should be wrapped inside -- withClone or an image operation mapImageInplace :: (P (Image GrayScale D32) -> P (Image GrayScale D32))@@ -533,19 +614,6 @@                    poke (castPtr (d `plusPtr` (y*cs+x*fs))) (f v)  -instance  GetPixel (Image RGB D8) where-    type P (Image RGB D8) = (D8,D8,D8)-    {-#INLINE getPixel#-}-    getPixel (x,y) i = unsafePerformIO $-                        withGenImage i $ \c_i -> do-                                         d <- {#get IplImage->imageData#} c_i-                                         s <- {#get IplImage->widthStep#} c_i-                                         let cs = fromIntegral s-                                             fs = sizeOf (undefined :: D8)-                                         r <- peek (castPtr (d`plusPtr` (y*cs +x*3*fs)))-                                         g <- peek (castPtr (d`plusPtr` (y*cs +(x*3+1)*fs)))-                                         b <- peek (castPtr (d`plusPtr` (y*cs +(x*3+2)*fs)))-                                         return (r,g,b)   convertTo :: CInt -> CInt -> BareImage -> BareImage@@ -603,14 +671,35 @@ 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 ())+class Save a where+    save :: FilePath -> a -> IO ()  +instance Save (Image BGR D32) where+    save filename image = primitiveSave filename (unS . unsafeImageTo8Bit $ image)  +instance Save (Image RGB D32) where+    save filename image = primitiveSave filename (swapRB . unS . unsafeImageTo8Bit $ image)++instance Save (Image RGB D8) where+    save filename image = primitiveSave filename  (swapRB . unS $ image)++instance Save (Image GrayScale D8) where+    save filename image = primitiveSave filename (unS $ image)++instance Save (Image GrayScale D32) where+    save filename image = primitiveSave filename (unS . unsafeImageTo8Bit $ image) +     +primitiveSave :: FilePath -> BareImage -> IO ()+primitiveSave filename fpi = do +       exists <- doesDirectoryExist (takeDirectory filename)+       when (not exists) $ throw (CvIOError $ "Directory does not exist: " ++ (takeDirectory filename))+       withCString  filename $ \name  ->+        withGenBareImage fpi    $ \cvArr ->+         alloca (\defs -> poke defs 0 >> {#call cvSaveImage #} name cvArr defs >> return ())++saveImage :: (Save (Image c d)) => FilePath -> Image c d ->  IO ()+saveImage = save+ getArea :: (Sized a,Num b, Size a ~ (b,b)) => a -> b getArea = uncurry (*).getSize @@ -637,6 +726,7 @@                                                 i1 i2 x y) -- | Blit image2 onto image1. blitFix = blit+blit :: Image GrayScale D32 -> Image GrayScale D32 -> (Int,Int) -> IO () blit image1 image2 (x,y)     | badSizes  = error $ "Bad blit sizes: " ++ show [(w1,h1),(w2,h2)]++"<-"++show (x,y)     | otherwise = withImage image1 $ \i1 ->@@ -646,7 +736,7 @@      ((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 :: (CreateImage (Image c d)) => (Int,Int) -> [((Int,Int),Image c d)] -> Image c d blitM (rw,rh) imgs = resultPic     where      resultPic = unsafePerformIO $ do@@ -681,7 +771,7 @@                                 withImage image1Alpha $ \i1a ->                                  withImage image2Alpha $ \i2a ->                                   withImage image2 $ \i2 ->-                                   ({#call alphaBlit#} i1 i1a i2 i2a x y)+                                   ({#call alphaBlit#} i1 i1a i2 i2a y x)   -- | Create a copy of an image@@ -826,6 +916,18 @@                                   + x*sizeOf (0::Word8))):: Ptr Word8)                                   v +instance SetPixel (Image RGB D32) where+    type SP (Image RGB D32) = (D32,D32,D32)+    {-#INLINE setPixel#-}+    setPixel (x,y) (r,g,b) 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*3*fs)))     b+                                         poke (castPtr (d`plusPtr` (y*cs +(x*3+1)*fs))) g +                                         poke (castPtr (d`plusPtr` (y*cs +(x*3+2)*fs))) r+ instance SetPixel (Image DFT D32) where     type SP (Image DFT D32) = Complex D32     {-#INLINE setPixel#-}@@ -854,7 +956,7 @@  -- |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 :: (CreateImage (Image GrayScale D32)) => (Int,Int) -> Int -> [Image GrayScale D32] -> Image GrayScale D32 montage (u',v') space' imgs     | u'*v' /= (length imgs) = error ("Montage mismatch: "++show (u,v, length imgs))     | otherwise              = resultPic@@ -875,7 +977,10 @@ data CvException = CvException Int String String String Int      deriving (Show, Typeable) +data CvIOError = CvIOError String deriving (Show,Typeable)+ instance Exception CvException+instance Exception CvIOError  setCatch = do    let catch i cstr1 cstr2 cstr3 j = do
CV/ImageMath.chs view
@@ -1,6 +1,64 @@ {-#LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, FlexibleContexts#-} #include "cvWrapLEO.h"-module CV.ImageMath where++-- | Mathematical and statistical operations for images. See also module+--   "CV.ImageMathOp" which contains handy operators for some of these.+module CV.ImageMath(+  -- * Operations  for two images+  add+, sub+, absDiff+, mul+, CV.ImageMath.div+, CV.ImageMath.min+, CV.ImageMath.max+, maskedMerge+, averageImages+, CV.ImageMath.atan2+  -- * Operations for one image+, subMean+, subMeanAbs+, CV.ImageMath.sqrt+, CV.ImageMath.log+, CV.ImageMath.abs+, CV.ImageMath.atan+, invert+  -- * Operations for a scalar and an image+, addS+, subS+, subRS+, mulS+-- TODO: divS is missing, is it needed?+-- , divS+, minS+, maxS+  -- * Comparison operations+, lessThan+, moreThan+, less2Than+, more2Than+  -- * Image statistics+, CV.ImageMath.sum+, average+, averageMask+, stdDeviation+, stdDeviationMask+, findMinMax+, findMinMaxLoc+, findMinMaxMask+, imageMinMax -- TODO: merge with findMinMax / replace binding?+, minValue+, maxValue+, imageAvgSdv -- TODO: merge with average and stdDeviation / replace binding?+  -- * Misc (to be moved?)+, gaussianImage -- TODO: move to other module?+, fadedEdgeImage -- TODO: move to other module?+, fadeToCenter -- TODO: move to other module?+, maximalCoveringCircle -- TODO: move to other module?+, limitToOp -- TODO: remove? needed in Morphology; export operations at end?+-- TODO: add section "Image operations" and add the bare operations there for combining with others?+) where+ import Foreign.C.Types import Foreign.C.String import Foreign.ForeignPtr@@ -45,13 +103,18 @@ -- 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 +-- | Calculates the per-pixel sum of two images. add = mkBinaryImageOp $ abcNullPtr {#call cvAdd#}++-- | Calculates the per-pixel difference of two images. sub = mkBinaryImageOp $ abcNullPtr {#call cvSub#}+ subFrom what = ImgOp $ \from ->           withGenImage from $ \ifrom ->           withGenImage what $ \iwhat ->@@ -59,30 +122,43 @@  logOp :: ImageOperation GrayScale D32 logOp  = ImgOp $ \i -> withGenImage i (\img -> {#call cvLog#}  img img)++-- | Calculates the natural logarithm of every pixel. log = unsafeOperate logOp +sqrtOp :: ImageOperation GrayScale D32 sqrtOp  = ImgOp $ \i -> withGenImage i (\img -> {#call sqrtImage#}  img img)++-- | Calculates the square root of every pixel. sqrt = unsafeOperate sqrtOp +-- | Operation to limit image with another image; same as 'ImageMath.min'. limitToOp what = ImgOp $ \from ->           withGenImage from $ \ifrom ->           withGenImage what $ \iwhat ->            {#call cvMin#} ifrom iwhat ifrom +-- | Limit image with another image; same as 'ImageMath.min'. limitTo x y = unsafeOperate (limitToOp x) y +-- | Calculates the per-pixel product of two images. mul = mkBinaryImageOp     (\a b c -> {#call cvMul#} a b c 1) +-- | Calculates the per-pixel division of two images. div = mkBinaryImageOp     (\a b c -> {#call cvDiv#} a b c 1) +-- | Calculates the per-pixel minimum of two images. min = mkBinaryImageOp {#call cvMin#} +-- | Calculates the per-pixel maximum of two images. max = mkBinaryImageOp {#call cvMax#} +-- | Calculates the per-pixel absolute difference of two images. absDiff = mkBinaryImageOp {#call cvAbsDiff#} +-- | Calculates the atan of every pixel. atan :: Image GrayScale D32 -> Image GrayScale D32 atan i = unsafePerformIO $ do                     let (w,h) = getSize i@@ -92,6 +168,8 @@                       {#call calculateAtan#} s r                       return res +-- | Calculates the atan2 of pixel values in two images.+atan2 :: Image GrayScale D32 -> Image GrayScale D32 -> Image GrayScale D32 atan2 a b = unsafePerformIO $ do                     res <- create (getSize a)                     withImage a $ \c_a ->@@ -107,13 +185,19 @@                       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)+-- | Calculates the absolute difference of every pixel to image mean.+--   See also 'ImageMath.subMean'.+subMeanAbs = unsafeOperate subtractMeanAbsOp++-- | Logical inversion of image (ie. invert, but stay on [0..1] range;+--   multiply by @-1@ and add @1@). invert i = addS 1 $ mulS (-1) i  absOp = ImgOp $ \image -> do                       withGenImage image $ \i ->                         {#call wrapAbsDiffS#} i 0 i +-- | Calculates the absolute value of every pixel. abs = unsafeOperate absOp  subtractMeanOp :: ImageOperation GrayScale D32@@ -123,17 +207,23 @@                       let (ImgOp subop) = subRSOp (realToFrac mean)                       subop image +-- | Calculates the (non-absolute) difference of every pixel to image mean.+--   See also 'ImageMath.subMeanAbs'.+subMean = unsafeOperate subtractMeanOp+ subRSOp :: D32 -> ImageOperation GrayScale D32 subRSOp scalar =  ImgOp $ \a ->           withGenImage a $ \ia -> do             {#call wrapSubRS#} ia (realToFrac scalar) ia +-- | Subtracts a scalar from every pixel, scalar on right. subRS s a= unsafeOperate (subRSOp s) a  subSOp scalar =  ImgOp $ \a ->           withGenImage a $ \ia -> do             {#call wrapSubS#} ia (realToFrac scalar) ia +-- | Subtracts a scalar from every pixel, scalar on left. subS a s = unsafeOperate (subSOp s) a  -- Multiply the image with scalar@@ -144,6 +234,8 @@             return ()         where s = realToFrac scalar                 -- I've heard this will lose information++-- | Multiplies every pixel by a scalar. mulS s = unsafeOperate $ mulSOp s  mkImgScalarOp op scalar = ImgOp $ \a ->@@ -154,12 +246,20 @@ -- TODO: Relax the addition so it works on multiple image depths addSOp :: D32 -> ImageOperation GrayScale D32 addSOp = mkImgScalarOp $ {#call wrapAddS#}++-- | Adds a scalar to every pixel. addS s = unsafeOperate $ addSOp s  minSOp = mkImgScalarOp $ {#call cvMinS#}++-- | Calculates the per-pixel minimum between an image and a scalar.+minS :: Float -> Image c d -> Image c d minS s = unsafeOperate $ minSOp s  maxSOp = mkImgScalarOp $ {#call cvMaxS#}++-- | Calculates the per-pixel maximum between an image and a scalar.+maxS :: Float -> Image c d -> Image c d maxS s = unsafeOperate $ maxSOp s  @@ -193,54 +293,76 @@                             return new                             --imageTo32F new --- Compare Image to Scalar-lessThan, moreThan ::  D32 -> Image GrayScale D32 ->Image GrayScale D8-+-- | Compares each pixel to a scalar, and produces a binary image where the+--   pixel value is less than the scalar. For example, @(lessThan s I)@ has+--   white pixels where value of I is less than s. Notice that the order of+--   operands is opposite to the intuitive interpretation of @s ``lessThan`` I@.+lessThan ::  D32 -> Image GrayScale D32 -> Image GrayScale D8 lessThan = mkCmpOp cmpLT++-- | Compares each pixel to a scalar, and produces a binary image where the+--   pixel value is greater than the scalar. For example, @(moreThan s I)@ has+--   white pixels where value of I is greater than s. Notice that the order of+--   operands is opposite to the intuitive interpretation of @s ``moreThan`` I@.+moreThan ::  D32 -> Image GrayScale D32 -> Image GrayScale D8 moreThan = mkCmpOp cmpGT +-- | Compares two images and produces a binary image that has white pixels in+--   those positions where the comparison is true. For example,+--   @(less2Than A B)@ has white pixels where value of A is less than value of+--   B. Notice that these functions follow the intuitive order of operands,+--   unlike 'lessThan' and 'moreThan'. 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-averageMask :: Image GrayScale D32 -> Image GrayScale D8 -> D32-averageMask img mask = unsafePerformIO $-                       withGenImage img $ \c_image -> -                       withGenImage mask $ \c_mask -> -                        {#call wrapAvg#} c_image c_mask >>= return . realToFrac  average' :: Image GrayScale D32 -> IO D32 average' img = withGenImage img $ \image ->                  {#call wrapAvg#} image nullPtr >>= return . realToFrac +-- | Calculates the average pixel value in whole image. 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+-- | Calculates the average value for pixels that have non-zero mask value.+averageMask :: Image GrayScale D32 -> Image GrayScale D8 -> D32+averageMask img mask = unsafePerformIO $+                       withGenImage img $ \c_image -> +                       withGenImage mask $ \c_mask -> +                        {#call wrapAvg#} c_image c_mask >>= return . realToFrac++-- | Calculates the sum of pixel values in whole image+--   (notice that OpenCV automatically casts the result to double). sum :: Image GrayScale D32 -> D32 sum img = realToFrac $ unsafePerformIO $ withGenImage img $ \image ->                     {#call wrapSum#} image +-- | Calculates the average of multiple images by adding the pixel values and+--   dividing the resulting values by number of images. 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#}++-- | Calculates the standard deviation of pixel values in whole image. stdDeviation :: Image GrayScale D32 -> D32 stdDeviation = realToFrac . unsafePerformIO . stdDeviation' +-- | Calculates the standard deviation of values for pixels that have non-zero+--   mask value. stdDeviationMask img mask = unsafePerformIO $                                  withGenImage img $ \i ->                                   withGenImage mask $ \m ->                                    {#call wrapStdDevMask#} i m  - peekFloatConv :: (Storable a, RealFloat a, RealFloat b) => Ptr a -> IO b peekFloatConv a = fmap realToFrac (peek a) @@ -252,6 +374,8 @@     , alloca-  `D32' peekFloatConv*} -- TODO: Check datatype sizes used in C!     -> `()'#} +-- | Finds the minimum and maximum pixel value in the image and the locations+--   where these values were found. findMinMaxLoc img = unsafePerformIO $ 	     alloca $ \(ptrintmaxx :: Ptr CInt)-> 	      alloca $ \(ptrintmaxy :: Ptr CInt)->@@ -269,20 +393,60 @@ 		         minval <- realToFrac <$> peek ptrintmin;                  return (((minx,miny),minval),((maxx,maxy),maxval));} -imageMinMax i = unsafePerformIO $ do-  withImage i $ \i_ptr -> do+-- TODO: create one function findMinMaxLoc' which takes also mask and base+-- findMinMax, findMinMaxLoc and findMinMaxMask (findMinMaxLocMask?) on it++-- findMinMax and findMinMaxLoc using the new bindings of cvMinMaxLoc...+-- do these really work also with D8 images? depends on fractional instance?+-- maybe create a new class or add a function to some existing class that+-- allows to get a pixel value from float..++-- | Finds the minimum and maximum pixel value in the image.+imageMinMax :: (Fractional d) => Image GrayScale d -> (d,d)+imageMinMax image = unsafePerformIO $ do+  withImage image $ \pimage -> do     let       minval :: CDouble       minval = 0       maxval :: CDouble       maxval = 0-    with minval $ \cminval ->-      with maxval $ \cmaxval -> do-        c'cvMinMaxLoc (castPtr i_ptr) cminval cmaxval nullPtr nullPtr nullPtr-        imin <- peek cminval-        imax <- peek cmaxval-        return ((realToFrac imin), (realToFrac imax))+    with minval $ \pminval ->+      with maxval $ \pmaxval -> do+        c'cvMinMaxLoc (castPtr pimage) pminval pmaxval nullPtr nullPtr nullPtr+        minv <- peek pminval+        maxv <- peek pmaxval+        return ((realToFrac minv), (realToFrac maxv)) +-- | Finds the minimum and maximum pixel value in the image.+imageMinMaxLoc ::  (Fractional d) => Image GrayScale d -> (((Int,Int),d), ((Int,Int),d))+imageMinMaxLoc image = unsafePerformIO $ do+  withImage image $ \pimage -> do+    let+      minval :: CDouble+      minval = 0+      maxval :: CDouble+      maxval = 0+      minloc :: C'CvPoint+      minloc = C'CvPoint 0 0+      maxloc :: C'CvPoint+      maxloc = C'CvPoint 0 0+    with minval $ \pminval ->+      with maxval $ \pmaxval ->+        with minloc $ \pminloc ->+          with maxloc $ \pmaxloc -> do+            c'cvMinMaxLoc (castPtr pimage) pminval pmaxval pminloc pmaxloc nullPtr+            minv <- peek pminval+            (C'CvPoint minx miny) <- peek pminloc+            maxv <- peek pmaxval+            (C'CvPoint maxx maxy) <- peek pmaxloc+            return $+              (((fromIntegral minx, fromIntegral miny), realToFrac minv),+               ((fromIntegral maxx, fromIntegral maxy), realToFrac maxv))++-- TODO: enable using a mask+-- | Calculates the average and standard deviation of pixel values in the image+--   in one operation.+imageAvgSdv :: (Fractional d) => Image GrayScale d -> (d,d) imageAvgSdv i = unsafePerformIO $ do   withImage i $ \i_ptr -> do     let@@ -291,25 +455,28 @@     with avg $ \avg_ptr ->       with sdv $ \sdv_ptr -> do         c'cvAvgSdv (castPtr i_ptr) avg_ptr sdv_ptr nullPtr-        (C'CvScalar a1 a2 a3 a4) <- peek avg_ptr-        (C'CvScalar s1 s2 s3 s4) <- peek sdv_ptr-        return ((realToFrac a1, realToFrac a2, realToFrac a3, realToFrac a4),-                (realToFrac s1, realToFrac s2, realToFrac s3, realToFrac s4))+        (C'CvScalar a1 _ _ _) <- peek avg_ptr+        (C'CvScalar s1 _ _ _) <- peek sdv_ptr+        return (realToFrac a1, realToFrac s1) +-- | Finds the minimum and maximum pixel value in the image. 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.+-- | Finds the minimum and maximum value for pixels with non-zero mask value. findMinMaxMask i mask  = unsafePerformIO (findMinMax' i mask)+ -- let a = getAllPixels i in (minimum a,maximum a) +-- | Utility functions for getting the maximum or minimum pixel value of the +--   image; equal to @snd . findMinMax@ and @fst . findMinMax@. 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+-- | 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@@ -317,14 +484,14 @@                            {#call render_gaussian#} d (realToFrac stdX) (realToFrac stdY)                            return dst --- | Produce white image with 'edgeW' amount of edges fading to black+-- | 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+-- | 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+-- | Merge two images according to a mask. Result is @R = A*m + B*(m-1)@. maskedMerge :: Image GrayScale D8 -> Image GrayScale D32 -> Image GrayScale D32 -> Image GrayScale D32 maskedMerge mask img img2 = unsafePerformIO $ do                               res <- create (getSize img)  -- 32FC1@@ -335,11 +502,8 @@                                    {#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-+--   than given in the distance map that fully covers the previous one. maximalCoveringCircle distMap (x,y,r)   = unsafePerformIO $      withImage distMap $ \c_distmap ->@@ -352,7 +516,3 @@            max_y <- fromIntegral <$> peek ptr_int_max_y            max_r <- realToFrac   <$> peek ptr_double_max_r            return (max_x,max_y,max_r)----
CV/ImageMathOp.hs view
@@ -1,28 +1,62 @@ {-#LANGUAGE FlexibleContexts#-}-module CV.ImageMathOp where+-- | Mathematical operators for images; see also module "ImageMath" for the+--   functions these operators are based on.+module CV.ImageMathOp(+  -- * Operators for two images+  (#+)+, (#-)+, (#*)+, (#<)+, (#>)+  -- * Operators for an image and a scalar+, (|*)+, (|+)+, (-|)+, (|-)+, (|>)+, (|<)+) where+ import CV.Image import CV.ImageMath as IM import Data.List(iterate) +-- | Image addition, subtraction, and multiplication operator; same as +--   'ImageMath.add', 'ImageMath.sub', and 'ImageMath.mul'. (#+), (#-), (#*) :: (CreateImage (Image c d)) => Image c d -> Image c d -> Image c d+ (#+) = IM.add (#-) = IM.sub (#*) = IM.mul +-- | Image comparison operators; same as 'ImageMath.less2Than' and+--   'ImageMath.more2Than'. Example: @A #< B@ produces a binary image that has +--   white pixels in those positions where value of A is less than value of B. (#<), (#>) :: (CreateImage (Image GrayScale d)) => Image GrayScale d -> Image GrayScale d              -> Image GrayScale D8+             (#<) = IM.less2Than (#>) = IM.more2Than +-- | Scalar multiplication, addition, and subtraction (scalar on left) operators;+--   same as 'ImageMath.mulS', 'ImageMath.addS', and 'ImageMath.subRS'. (|*), (|+), (-|) ::  D32 -> Image GrayScale D32 -> Image GrayScale D32+ (|*) = IM.mulS (|+) = IM.addS (-|) = IM.subRS +-- | Scalar comparison operators; same as 'ImageMath.moreThan' and+--   'ImageMath.lessThan'. Example: @s |> I@ produces a binary image that has+--   white pixels in those positions where the value of I is larger than s.+--   Notice that this is opposite to the intuitive interpretation. (|>), (|<) ::  D32 -> Image GrayScale D32 -> Image GrayScale D8+ (|>) = IM.moreThan (|<) = IM.lessThan+ -- (|^) i n = (iterate (#* i) i) !! (n-1) +-- | Scalar subtraction operator (scalar on right); same as 'ImageMath.subS'. (|-)  :: Image GrayScale D32 -> D32 -> Image GrayScale D32 (|-) = IM.subS
CV/Matrix.hs view
@@ -5,10 +5,9 @@     (     Exists(..),     Matrix, emptyMatrix, fromFunction, fromList,toList,toRows,toCols,get,put,withMatPtr-    , transpose, mxm, rodrigues2+    , transpose, mxm, rodrigues2, identity     )where -{-#OPTIONS_GHC -fwarn-unused-imports#-}  import System.Mem @@ -79,6 +78,10 @@     type Args (Matrix (Float,Float,Float)) = (Int,Int)     create (r,c) = unsafePerformIO $ creatingMat (c'cvCreateMat r c c'CV_32FC3) +instance Exists (Matrix (CFloat,CFloat,CFloat)) where+    type Args (Matrix (CFloat,CFloat,CFloat)) = (Int,Int)+    create (r,c) = unsafePerformIO $ creatingMat (c'cvCreateMat r c c'CV_32FC3)+ instance Exists (Matrix (Int,Int,Int,Int)) where     type Args (Matrix (Int,Int,Int,Int)) = (Int,Int)     create (r,c) = unsafePerformIO $ creatingMat (c'cvCreateMat r c c'CV_32SC4)@@ -91,6 +94,10 @@     type Args (Matrix Double) = (Int,Int)     create (r,c) = unsafePerformIO $ creatingMat (c'cvCreateMat r c c'CV_64FC1) +instance Exists (Matrix (Double,Double)) where+    type Args (Matrix (Double,Double)) = (Int,Int)+    create (r,c) = unsafePerformIO $ creatingMat (c'cvCreateMat r c c'CV_64FC2)+ instance Sized (Matrix a) where     type Size (Matrix a) = (Int,Int)     getSize (Matrix e) = unsafePerformIO $ withForeignPtr e $ \mat -> do@@ -102,6 +109,7 @@ emptyMatrix :: Exists (Matrix a) => Args (Matrix a) -> Matrix a emptyMatrix a = create a +-- | Create an identity matrix identity :: (Num a, Sized (Matrix a), Args (Matrix a) ~ (Int,Int),  Size (Matrix a) ~ (Int,Int),  Storable a, Exists (Matrix a)) =>              (Matrix a) -> Matrix a identity a = unsafePerformIO $ do@@ -236,4 +244,3 @@ putRaw :: forall t. (Storable t) => Ptr t -> CInt -> Int -> Int -> Int -> t -> IO () putRaw d step eltSize col row v =          poke (castPtr (d `plusPtr` (col*(fromIntegral step)+row*eltSize))) v-
CV/Pixelwise.hs view
@@ -6,17 +6,19 @@                     ,fromImage                     ,fromFunction                     ,toImage+                    ,toImagePar                     ,remap                     ,remapImage                     ,mapImage                     ,mapPixels                     ,imageFromFunction+                    ,imageToFunction                     ,(<$$>)                     ,(<+>)) where import Control.Applicative import CV.Image import System.IO.Unsafe-import Control.Parallel.Strategies+import Control.Concurrent.ParallelIO.Local  -- | A wrapper for allowing functor and applicative instances for non-polymorphic image types. data Pixelwise x = MkP {sizeOf :: (Int,Int)@@ -60,11 +62,31 @@ remap :: (((Int,Int) -> b) -> ((Int,Int) -> x)) -> Pixelwise b -> Pixelwise x remap f (MkP s e) = MkP s (f e) --- | 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.+-- | Convert image to a function, which returns pixel values in the domain of+-- the image and zero elsewhere+imageToFunction :: (GetPixel (Image a b), Num (P (Image a b)))+                  => Image a b -> ((Int,Int) -> P (Image a b))+imageToFunction img (x,y) | x>= 0 && y>= 0 && x < w && y < h = getPixel (x,y) img+                          | otherwise = 0+   where (w,h) = getSize img++fromImage :: (Num (P b), GetPixel b, Sized b, Size b ~ Size (Pixelwise (P b))) => b -> Pixelwise (P b)+fromImage i = MkP size getP+    where+        size@(w,h) = getSize i+        getP (x,y) | x>=0 && x<w && y>=0 && y<h = getPixel (x,y) i+                   | otherwise = 0++-- | Convert a pixelwise construct to image.+toImagePar :: (SetPixel (Image a b), CreateImage (Image a b))+           => Int -> Pixelwise (SP (Image a b)) -> Image a b+toImagePar n (MkP (w,h) e) = unsafePerformIO $ withPool n $ \pool -> do+        img <- create (w,h)+        parallel_ pool [sequence_ [setPixel (i,j) (e (i,j)) img | i <- [0..w-1]]+                       |j <- [0..h-1]]+        return img++-- | Convert a pixelwise construct to image. toImage :: (SetPixel (Image a b), CreateImage (Image a b))            => Pixelwise (SP (Image a b)) -> Image a b toImage (MkP (w,h) e) = unsafePerformIO $ do@@ -78,6 +100,7 @@ remapImage ::      (CreateImage (Image a b),       SetPixel (Image a b),+      Num (P (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 @@ -88,14 +111,14 @@ mapPixels f (MkP s e) = MkP s (\(i,j) -> f $ e (i,j))  mapImage ::-     (CreateImage (Image a b),-      SetPixel (Image a b),+     (CreateImage (Image c d),+      SetPixel (Image c d),+      Num (P (Image a b)),       GetPixel (Image a b)) =>-     (P (Image a b) -> SP (Image a b)) -> Image a b -> Image a b+     (P (Image a b) -> SP (Image c d)) -> Image a b -> Image c d 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@@ -105,19 +128,10 @@ 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+(<$$>) :: (Num (P b1), Size b1 ~ (Int, Int), Sized b1, GetPixel b1) => (P b1 -> b) -> b1 -> Pixelwise b a <$$> b = a <$> fromImage b  -- | Shorthand for `a <*> fromImage b`-(<+>) :: (Size b1 ~ (Int, Int), Sized b1, GetPixel b1) => Pixelwise (P b1 -> b) -> b1 -> Pixelwise b+(<+>) :: (Num (P b1),Size b1 ~ (Int, Int), Sized b1, GetPixel b1) => Pixelwise (P b1 -> b) -> b1 -> Pixelwise b a <+> b = a <*> fromImage b
CV/Thresholding.hs view
@@ -1,5 +1,21 @@-module CV.Thresholding-where+ {-#LANGUAGE TypeSynonymInstances#-}+ -- | Image thresholding operations+module CV.Thresholding(+  -- * Interfaces to OpenCV functions+  ThresholdType(..)+, threshold+, thresholdOtsu+, AdaptiveType(..)+, adaptiveThreshold+  -- * Other methods+, bernsen+, nibbly+, nibblyr+, kittler+, kittlerMeasure+, betweenClassVariance+) where+ import CV.Image import CV.Filters import qualified CV.ImageMath as IM@@ -10,7 +26,103 @@ import Utils.List import Data.List import CV.Histogram+import CV.Bindings.ImgProc+import Foreign.Ptr (nullPtr,castPtr) +-- | A type class for selecting the maximum value for each image type, used in+--   creating the thresholded image+class MaxVal a where+  maxval :: (Image GrayScale a) -> Double++instance MaxVal D32 where+  maxval _ = 1++instance MaxVal D8 where+  maxval _ = 255++-- | Thresholding behavior for values larger and smaller than threshold+data ThresholdType+  -- | Values larger than threshold are set to max, smaller to zero+  = MaxAndZero+  -- | Values larger than threshold are set to zero, smaller to max+  | ZeroAndMax+  -- | Values larger than threshold are truncated to threshold, smaller are not touched+  | ThreshAndValue+  -- | Values larger than threshold are not touched, smaller are set to zero+  | ValueAndZero+  -- | Values larger than threshold are set to zero, smaller are not touched+  | ZeroAndValue++-- | Utility function for converting ThresholdType to c values+cThresholdType t =+  case t of+    MaxAndZero     -> c'CV_THRESH_BINARY+    ZeroAndMax     -> c'CV_THRESH_BINARY_INV+    ThreshAndValue -> c'CV_THRESH_TRUNC+    ValueAndZero   -> c'CV_THRESH_TOZERO+    ZeroAndValue   -> c'CV_THRESH_TOZERO_INV++-- | Utility function for converting otsu ThresholdType to c values+cOtsuThresholdType t =+  case t of+    MaxAndZero     -> c'CV_THRESH_OTSU_BINARY+    ZeroAndMax     -> c'CV_THRESH_OTSU_BINARY_INV+    ThreshAndValue -> c'CV_THRESH_OTSU_TRUNC+    ValueAndZero   -> c'CV_THRESH_OTSU_TOZERO+    ZeroAndValue   -> c'CV_THRESH_OTSU_TOZERO_INV++-- | Method used for selecting the adaptive threshold value+data AdaptiveType+  -- | Threshold using the arithmetic mean of pixel neighborhood+  = ByMean+  -- | Threshold using the gaussian weighted mean of pixel neighborhood+  | ByGaussian ++-- | Utility function for converting AdaptiveType to c value+cAdaptiveType t =+  case t of+    ByMean     -> c'CV_ADAPTIVE_THRESH_MEAN_C+    ByGaussian -> c'CV_ADAPTIVE_THRESH_GAUSSIAN_C++-- | Thresholds a grayscale image according to the selected type, using the+--   given threshold value.+threshold :: (MaxVal d) => ThresholdType -> Double -> Image GrayScale d -> Image GrayScale d+threshold ttype tval image =+  unsafePerformIO $+    withCloneValue image $ \result ->+      withImage image $ \pimage ->+        withImage result $ \presult -> do+          c'cvThreshold (castPtr pimage) (castPtr presult) (realToFrac tval)+            (realToFrac (maxval image)) (cThresholdType ttype)+          return result++-- | Thresholds a grayscale image using the otsu method according to the+--   selected type. Threshold value is selected automatically, and only 8-bit+--   images are supported.+thresholdOtsu :: ThresholdType -> Image GrayScale D8 -> Image GrayScale D8+thresholdOtsu ttype image =+  unsafePerformIO $+    withCloneValue image $ \result ->+      withImage image $ \pimage ->+        withImage result $ \presult -> do+          c'cvThreshold (castPtr pimage) (castPtr presult) 0+            (realToFrac 255) (cOtsuThresholdType ttype)+          return result++-- | Applies adaptive thresholding by selecting the optimal threshold value for+--   each pixel. The threshold is selected by calculating the arithmetic or+--   gaussian-weighted mean of a pixel neighborhood, and applying a bias term to+--   the obtained value.+adaptiveThreshold :: (MaxVal d) => AdaptiveType -> ThresholdType -> Int -> Double +  -> Image GrayScale d -> Image GrayScale d+adaptiveThreshold a t neighborhood bias image =+  unsafePerformIO $+    withCloneValue image $ \result ->+      withImage image $ \pimage ->+        withImage result $ \presult -> do+          c'cvAdaptiveThreshold (castPtr pimage) (castPtr presult) (realToFrac (maxval image))+            (cAdaptiveType a) (cThresholdType t) (fromIntegral neighborhood) (realToFrac bias)+          return result  bernsen (w,h) c i = goodContrast #* (i #< surface)             where
CV/Tracking.hs view
@@ -1,4 +1,4 @@-{-#LANGUAGE ConstraintKinds, FlexibleContexts, TypeFamilies#-}+{-#LANGUAGE 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 :: (IntBounded a, ELBB a~Int) => Image GrayScale D32 -> a -> TermCriteria+meanShift :: (BoundingBox a, Integral (ELBB a), ELBB a~Int) => Image GrayScale D32 -> a -> TermCriteria                -> (Double,Rectangle Int) meanShift image window crit = unsafePerformIO $    withGenImage image $ \c_img    ->
CV/Transforms.chs view
@@ -124,7 +124,7 @@                          {#call findHomography#} c_src c_dst (fromIntegral $ length srcPts) c_hmg                          peekArray (3*3) c_hmg     where-     flatten = concatMap (\(a,b) -> [a,b]) +     flatten = map realToFrac . concatMap (\(a,b) -> [a,b])       src = flatten srcPts      dst = flatten dstPts @@ -243,6 +243,16 @@ #endc {#enum DistanceType {}#} +#ifdef OpenCV24+#c+enum LabelType {+     DIST_LABEL_CCOMP = CV_DIST_LABEL_CCOMP+    ,DIST_LABEL_PIXEL = CV_DIST_LABEL_PIXEL+};+#endc+{#enum LabelType {}#}+#endif+ -- |Mask sizes accepted by distanceTransform data MaskSize = M3 | M5 deriving (Eq,Ord,Enum,Show) @@ -256,6 +266,9 @@                                   (fromIntegral . fromEnum $ dtype)                                    (fromIntegral . fromEnum $ maskSize)                                    nullPtr nullPtr+#ifdef OpenCV24+                                   (fromIntegral . fromEnum $ DIST_LABEL_CCOMP)+#endif     return result     -- TODO: Add handling for labels     -- TODO: Add handling for custom masks
CV/Video.chs view
@@ -77,7 +77,7 @@     , CAP_PROP_GAIN           =  CV_CAP_PROP_GAIN              , CAP_PROP_EXPOSURE       =  CV_CAP_PROP_EXPOSURE          , CAP_PROP_CONVERT_RGB    =  CV_CAP_PROP_CONVERT_RGB  -#ifdef OpenCV23+#if defined OpenCV23 || defined OpenCV24     , CAP_PROP_WHITE_BALANCE_BLUE_U = CV_CAP_PROP_WHITE_BALANCE_BLUE_U      , CAP_PROP_WHITE_BALANCE_RED_V  = CV_CAP_PROP_WHITE_BALANCE_RED_V #else
Utils/GeometryClass.hs view
@@ -1,4 +1,4 @@-{-#LANGUAGE TypeFamilies,FlexibleInstances, ConstraintKinds #-}+{-#LANGUAGE TypeFamilies,FlexibleInstances#-} 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 :: *
Utils/Rectangle.hs view
@@ -24,6 +24,9 @@ rSize (Rectangle x y w h) = (w,h) rArea r = let (w,h) = rSize r in (w*h) +center (Rectangle x y w h) = (x+w/2,y+h/2)+centerI (Rectangle x y w h) = (x+w`div`2,y+h`div`2)+ -- TODO: Add documentation #Cleanup  instance (Num a, Ord a , Serial a) => Serial (Rectangle a) where@@ -116,7 +119,11 @@                   (round (a*fromIntegral s1),round (b*fromIntegral s2))  -toInt (Rectangle a b c d)+fromInt (Rectangle a b c d)     = Rectangle (f a) (f b) (f c) (f d)  where f = fromIntegral++roundR (Rectangle a b c d)+    = Rectangle (f a) (f b) (f c) (f d)+ where f = round
cbits/cvWrapLEO.c view
@@ -447,11 +447,11 @@                     ,bSize.height);   // Blit the images b into a using cvCopy- printf("Doing a blit\n"); fflush(stdout);+// printf("Doing a blit\n"); fflush(stdout);  cvSetImageROI(a,pos);  cvCopy(b,a,NULL);  cvResetImageROI(a);- printf("Done!\n"); fflush(stdout);+// printf("Done!\n"); fflush(stdout); }  IplImage* makeEvenDown(IplImage *src)@@ -2348,7 +2348,11 @@  double wrapCalibrateCamera2(const CvMat* objectPoints, const CvMat* imagePoints, const CvMat* pointCounts, CvSize *imageSize, CvMat* cameraMatrix, CvMat* distCoeffs, CvMat* rvecs, CvMat* tvecs, int flags) {+#ifdef OpenCV24+return cvCalibrateCamera2(objectPoints, imagePoints, pointCounts, *imageSize, cameraMatrix, distCoeffs, rvecs, tvecs, flags, cvTermCriteria(CV_TERMCRIT_ITER+CV_TERMCRIT_EPS,30,DBL_EPSILON));+#else return cvCalibrateCamera2(objectPoints, imagePoints, pointCounts, *imageSize, cameraMatrix, distCoeffs, rvecs, tvecs, flags);+#endif };  void wrapFindCornerSubPix(const CvArr* image, CvPoint2D32f* corners, int count, int winW, int winH, int zeroW, int zeroH, int tType, int maxIter, double epsilon) {
cbits/cvWrapLEO.h view
@@ -292,9 +292,11 @@ return cvExtractSURF(image, mask, keypoints, descriptors, storage, *param, useProvidedKeyPts); }; +#ifndef OpenCV24 void wrapExtractMSER( CvArr* _img, CvArr* _mask, CvSeq** contours, CvMemStorage* storage, CvMSERParams *params ){ cvExtractMSER( _img, _mask, contours, storage, *params ); };+#endif  void wrapEllipseBox(CvArr* img, CvBox2D *box, CvScalar *color                    ,int thickness, int lineType, int shift)
cbits/wrapImgProc.c view
@@ -4,3 +4,67 @@ void wrapFilter2(const CvArr* src, CvArr* dst, const CvMat* kernel, CvPoint *anchor) {cvFilter2D(src, dst, kernel, *anchor);}; +void fillConnectedComponents(IplImage* img, int *count)+{+  unsigned char *data, value;+  unsigned int x, y, w, h, pos, step, index;+  CvPoint point;+  CvSize size;+  +  size = cvGetSize(img);+  w = size.width;+  h = size.height;+  data = (unsigned char *)img->imageData;+  step = (unsigned int)(img->widthStep / sizeof(unsigned char));+  +  index = 0;+  for (y = 0; y < h; y++) {+    pos = y * step;+    for (x = 0; x < w; x++, pos++) {+      value = data[pos];+      if (value > index) {+        index++;+        point.x = x;+        point.y = y;+        cvFloodFill(img, point, cvRealScalar(index), cvScalarAll(0), cvScalarAll(0), NULL, 4, NULL);+      }+    }+  }+  *count = index;+}++void maskConnectedComponent(const IplImage *src, IplImage *mask, int id)+{+  unsigned char *data, value, index;+  unsigned int x, y, w, h, pos, step;+  CvPoint point;+  CvSize size;+  +  size = cvGetSize(mask);+  w = size.width;+  h = size.height;+  data = (unsigned char *)mask->imageData;+  step = (unsigned int)(mask->widthStep / sizeof(unsigned char));+  +  if (id > 0 && id < 256) {+    cvCopy(src, mask, NULL);+    index = (unsigned char)id;+    for (y = 0; y < h; y++) {+      pos = y * step;+      for (x = 0; x < w; x++, pos++) {+        value = data[pos];+        if (value > 0) {+          if (value == index) {+            data[pos] = 255;+          }+          else {+            data[pos] = 0;+          }+        }+      }+    }+  }+  else {+    cvSetZero(mask);+  }+}
cbits/wrapImgProc.h view
@@ -3,6 +3,16 @@  #include <opencv2/imgproc/imgproc_c.h> +#define CV_THRESH_OTSU_BINARY     CV_THRESH_OTSU | CV_THRESH_BINARY+#define CV_THRESH_OTSU_BINARY_INV CV_THRESH_OTSU | CV_THRESH_BINARY_INV+#define CV_THRESH_OTSU_TRUNC      CV_THRESH_OTSU | CV_THRESH_TRUNC+#define CV_THRESH_OTSU_TOZERO     CV_THRESH_OTSU | CV_THRESH_TOZERO+#define CV_THRESH_OTSU_TOZERO_INV CV_THRESH_OTSU | CV_THRESH_TOZERO_INV+ void wrapFilter2(const CvArr* src, CvArr* dst, const CvMat* kernel, CvPoint *anchor);++void fillConnectedComponents(IplImage* src, int *count);++void maskConnectedComponent(const IplImage *src, IplImage *mask, int id);  #endif
+ examples/ConnectedComponents.hs view
@@ -0,0 +1,21 @@+module Main where+import CV.Fitting+import CV.Image+import CV.Drawing+import CV.Matrix+import CV.ImageOp++main = do+        let res :: Image GrayScale D32+            res = empty (400,400)+            testPts = [(200+100*sin x-80*cos x,200+60*cos x) | x <- [0,0.1..pi]]+            mat = fromList (1,length testPts) testPts+            ell = fitEllipse mat+            bb  = minAreaRect mat+            br  = boundingRect mat+            pts = res <## [circleOp 1 (round x, round y) 3 Filled | (x,y) <- testPts]+                      <# drawBox2Dop 1 bb+        saveImage "bb_result.png" pts+        print ell+        print bb+        print br
+ examples/TreeTop.hs view
@@ -0,0 +1,66 @@+{-#LANGUAGE ParallelListComp, RecordWildCards, DeriveGeneric#-}+module Main where++import CV.Image+import CV.Tracking+import CV.Bindings.Types+import CV.Drawing+import CV.ImageOp+import Utils.Rectangle+import Text.Printf+import CV.ImageMathOp hiding ((#>))+import CV.Filters+import CV.ColourUtils+import Utils.Rectangle +import Data.List+import Data.Function++import Graphics.Tools.DefaultGUI++data Parameters = P {x :: IntRange Zero Hundred+                    ,y :: IntRange Zero Hundred+                    ,scale :: IntRange One Fifty } deriving (Generic)++instance Default Parameters+instance Persist Parameters+instance Tangible Parameters++main = defaultGUI "Treetop_params" "dsm.tif" f++f P{..} img = resultI+   where +       prec :: Image GrayScale D32+       prec = gaussian (11,11) img +       (w,h) = getSize img+       resultPts = [ (val,res) | x <- [0,15..w-10], y <- [0,15..h-10] +                   , let (val,res) = hillClimber (indfun prec) (-1,(x,y))+                   ]+       groups = group2 (\a b -> abs (a-b) < value scale) (snd.snd) (fst.snd) $ resultPts+       resultI = img-- <## [ lineOp 0.8 1 s (res) #>+                    --       circleOp 2 (res) 1 Filled+                    --      | (s,res) <- resultPts+                    --      ]+                     <## [circleOp 0 m 10 (Stroked 1) | rs <- groups, let (v,m) = maximumBy (compare`on`fst) rs]++       -- (val,res) = -- meanShift prec s1 (EPS 1) ++group2 equal a b = concatMap (f a) . f b+ where+  f a = groupBy (equal `on` a) . sortBy (compare `on` a)+++indfun :: Image GrayScale D32 -> ((Int,Int) -> D32)+indfun img c@(x,y) | x<0 = 0+                   | y<0 = 0+                   | x>=w = 0+                   | y>=h = 0+                   | otherwise = getPixel c img+                where (w,h) = getSize img++hillClimber :: ((Int,Int) -> D32) -> (D32, (Int,Int)) -> (D32, (Int,Int))+hillClimber f (o,init) +    | (o+0.001) >= v = (o,init) +    | otherwise = hillClimber f (v,next)    +    where+     (v,next) = maximumBy (compare`on` fst) $ [(f n, n) | n <- neighbours init ]+     neighbours (x,y) = [(x+i,y+j) | i<-[-5,-4..5], j <- [-5,-4..5], (i,j) /= (0,0)]
− examples/dftPattern.hs 
@@ -1,47 +0,0 @@-{-#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)))-        ]
+ examples/glcm.hs view
@@ -0,0 +1,23 @@+module Main where++import CV.Image+import qualified Data.Vector as V+import CV.Pixelwise+import CV.ColourUtils+++main = do+   Just x <- loadImage "smallLena.jpg" >>= return . fmap unsafeImageTo8Bit+   let+       -- Avustimet+       get (i,j)  = fromIntegral $ getPixel (i,j) x -- Lyhennemerkintä.+       (w,h) = getSize x --koko++       (dx,dy) = (2,2) -- DX/DY on aina positiivinen, sillä talletetaan vain alakolmio.+       toIdx (i,j) =  (max i j*(max i j+1)) `div` 2 + min i j -- Talletetaan vain alakolmiomatriisi++       hist = V.accum (+) (V.replicate (toIdx (255,255)) 0) $ -- Raaka-akkumulaatio+               [(toIdx (get (i,j), get (i+dx,j+dy)),1)+               | i <- [0..w-1-dx]+               , j <- [0..h-1-dy]]+   saveImage "GLCM.png" . logarithmicCompression $ imageFromFunction (255,255) ((V.!) hist . toIdx)