module CV.Filters(
gaussian,gaussianOp
,blurOp,blur,blurNS
,bilateral
,HasMedianFiltering,median
,susan,getCentralMoment,getAbsCentralMoment
,getMoment,secondMomentBinarize,secondMomentBinarizeOp
,secondMomentAdaptiveBinarize,secondMomentAdaptiveBinarizeOp
,selectiveAvg,convolve2D,convolve2DI,haar,haarAt
,IntegralImage(),integralImage,verticalAverage) where
import Foreign.C.Types
import Foreign.Ptr
import Foreign.Marshal.Utils
import CV.Bindings.ImgProc
import Utils.GeometryClass
import CV.Matrix (Matrix,withMatPtr)
import CV.ImageOp
import System.IO.Unsafe
import CV.Image
susan :: (Int, Int) -> Double -> Double
-> Image GrayScale D32 -> Image GrayScale D32
susan (w,h) t sigma image = unsafePerformIO $ do
withGenImage image $ \img ->
creatingImage
(susanSmooth img (fromIntegral w) (fromIntegral h)
(realToFrac t) (realToFrac sigma))
selectiveAvg :: (Int, Int) -> Double
-> Image GrayScale D32 -> Image GrayScale D32
selectiveAvg (w,h) t image = unsafePerformIO $ do
withGenImage image $ \img ->
creatingImage
(selectiveAvgFilter
img (realToFrac t) (fromIntegral w) (fromIntegral h))
getCentralMoment n (w,h) image = unsafePerformIO $ do
withGenImage image $ \img ->
creatingImage
(getNthCentralMoment img n w h)
getAbsCentralMoment n (w,h) image = unsafePerformIO $ do
withGenImage image $ \img ->
creatingImage
(getNthAbsCentralMoment img n w h)
getMoment n (w,h) image = unsafePerformIO $ do
withGenImage image $ \img ->
creatingImage
(getNthMoment img n w h)
secondMomentBinarizeOp t = ImgOp $ \image ->
withGenImage image (flip smb $ t)
secondMomentBinarize t i = unsafeOperate (secondMomentBinarizeOp t) i
secondMomentAdaptiveBinarizeOp w h t = ImgOp $ \image ->
withGenImage image
(\i-> smab i w h t)
secondMomentAdaptiveBinarize w h t i = unsafeOperate (secondMomentAdaptiveBinarizeOp w h t) i
data SmoothType = BlurNoScale
| Blur
| Gaussian
| Median
| Bilateral
instance Enum SmoothType where
fromEnum BlurNoScale = 0
fromEnum Blur = 1
fromEnum Gaussian = 2
fromEnum Median = 3
fromEnum Bilateral = 4
toEnum 0 = BlurNoScale
toEnum 1 = Blur
toEnum 2 = Gaussian
toEnum 3 = Median
toEnum 4 = Bilateral
toEnum unmatched = error ("SmoothType.toEnum: Cannot match " ++ show unmatched)
smooth' :: Image GrayScale D32 -> Image GrayScale D32 -> Int -> Int -> Int -> Float -> Float -> IO ()
smooth' a1 a2 a3 a4 a5 a6 a7 =
withGenImage a1 $ \a1' ->
withGenImage a2 $ \a2' ->
let {a3' = fromIntegral a3} in
let {a4' = fromIntegral a4} in
let {a5' = fromIntegral a5} in
let {a6' = realToFrac a6} in
let {a7' = realToFrac a7} in
smooth''_ a1' a2' a3' a4' a5' a6' a7' >>= \res ->
return ()
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
gaussian,blur,blurNS :: (Int, Int) -> Image GrayScale D32 -> Image GrayScale D32
gaussian = unsafeOperate . gaussianOp
blur = unsafeOperate . blurOp
blurNS = unsafeOperate . blurNSOp
withMask (w,h) op
| maskIsOk (w,h) = ImgOp $ op (w,h)
| otherwise = error "One of aperture dimensions is incorrect (should be >=1 and odd))"
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
cvSmooth cimg ccln (fromIntegral $ fromEnum Bilateral)
(fromIntegral w) (fromIntegral h)
(realToFrac s1) (realToFrac s2)
class HasMedianFiltering a where
median :: (Int,Int) -> a -> a
instance HasMedianFiltering (Image GrayScale D8) where
median = median'
instance HasMedianFiltering (Image GrayScale D32) where
median a = unsafeImageTo32F . median' a . unsafeImageTo8Bit
instance HasMedianFiltering (Image RGB D8) where
median = median'
median' :: (Int,Int) -> Image c D8 -> Image c D8
median' (w,h) img
| maskIsOk (w,h) = unsafePerformIO $ do
clone2 <- cloneImage img
withGenImage img $ \c1 ->
withGenImage clone2 $ \c2 ->
cvSmooth c1 c2 (fromIntegral $ fromEnum Median)
(fromIntegral w) (fromIntegral h) 0 0
return clone2
| otherwise = error "One of aperture dimensions is incorrect (should be >=1 and odd))"
maskIsOk (w,h) = odd w && odd h && w >0 && h>0
convolve2D :: (Point2D anchor, ELP anchor ~ Int) =>
Matrix D32 -> anchor -> Image GrayScale D32 -> Image GrayScale D32
convolve2D kernel anchor image = unsafePerformIO $ do
result <- create (getSize image)
withGenImage image $ \c_img->
withGenImage result $ \c_res->
withMatPtr kernel $ \c_mat ->
with (convertPt anchor) $ \c_pt ->
c'wrapFilter2 c_img c_res c_mat c_pt
>> return result
convolve2DI (x,y) kernel image = unsafePerformIO $
withImage image $ \img->
withImage kernel $ \k ->
creatingImage $
wrapFilter2DImg
img k x y
verticalAverage :: Image GrayScale D32 -> Image GrayScale D32
verticalAverage image = unsafePerformIO $ do
let (w,h) = getSize image
s <- create (w,h)
withGenImage image $ \i -> do
withGenImage s $ \sum -> do
vertical_average i sum
return s
newtype IntegralImage = IntegralImage (Image GrayScale D64)
instance Sized IntegralImage where
type Size IntegralImage = (Int,Int)
getSize (IntegralImage i) = getSize i
instance GetPixel IntegralImage where
type P IntegralImage = Double
getPixel = getPixel
integralImage :: Image GrayScale D32 -> IntegralImage
integralImage image = unsafePerformIO $ do
let (w,h) = getSize image
s <- create (w+1,h+1)
withGenImage image $ \i -> do
withGenImage s $ \sum -> do
cvIntegral i sum nullPtr nullPtr
return $ IntegralImage s
haar :: IntegralImage -> (Int,Int,Int,Int) -> Image GrayScale D32
haar (IntegralImage image) (a',b',c',d') = unsafePerformIO $ do
let (w,h) = getSize image
let [a,b,c,d] = map fromIntegral [a',b',c',d']
r <- create (w,h)
withImage image $ \sum ->
withImage r $ \res -> do
haarFilter sum
(min a c)
(max b d)
(max a c)
(min b d)
res
return r
haarAt :: IntegralImage -> (Int,Int,Int,Int) -> Double
haarAt (IntegralImage ii) (a,b,w,h) = realToFrac $ unsafePerformIO $ withImage ii $ \i ->
haar_at i (f a) (f b) (f w) (f h)
where f = fromIntegral
foreign import ccall safe "CV/Filters.chs.h susanSmooth"
susanSmooth :: ((Ptr (BareImage)) -> (CInt -> (CInt -> (CDouble -> (CDouble -> (IO (Ptr (BareImage))))))))
foreign import ccall safe "CV/Filters.chs.h selectiveAvgFilter"
selectiveAvgFilter :: ((Ptr (BareImage)) -> (CDouble -> (CInt -> (CInt -> (IO (Ptr (BareImage)))))))
foreign import ccall safe "CV/Filters.chs.h getNthCentralMoment"
getNthCentralMoment :: ((Ptr (BareImage)) -> (CInt -> (CInt -> (CInt -> (IO (Ptr (BareImage)))))))
foreign import ccall safe "CV/Filters.chs.h getNthAbsCentralMoment"
getNthAbsCentralMoment :: ((Ptr (BareImage)) -> (CInt -> (CInt -> (CInt -> (IO (Ptr (BareImage)))))))
foreign import ccall safe "CV/Filters.chs.h getNthMoment"
getNthMoment :: ((Ptr (BareImage)) -> (CInt -> (CInt -> (CInt -> (IO (Ptr (BareImage)))))))
foreign import ccall safe "CV/Filters.chs.h smb"
smb :: ((Ptr (BareImage)) -> (CDouble -> (IO ())))
foreign import ccall safe "CV/Filters.chs.h smab"
smab :: ((Ptr (BareImage)) -> (CInt -> (CInt -> (CDouble -> (IO ())))))
foreign import ccall safe "CV/Filters.chs.h cvSmooth"
smooth''_ :: ((Ptr ()) -> ((Ptr ()) -> (CInt -> (CInt -> (CInt -> (CDouble -> (CDouble -> (IO ()))))))))
foreign import ccall safe "CV/Filters.chs.h cvSmooth"
cvSmooth :: ((Ptr ()) -> ((Ptr ()) -> (CInt -> (CInt -> (CInt -> (CDouble -> (CDouble -> (IO ()))))))))
foreign import ccall safe "CV/Filters.chs.h wrapFilter2DImg"
wrapFilter2DImg :: ((Ptr (BareImage)) -> ((Ptr (BareImage)) -> (CInt -> (CInt -> (IO (Ptr (BareImage)))))))
foreign import ccall safe "CV/Filters.chs.h vertical_average"
vertical_average :: ((Ptr (BareImage)) -> ((Ptr (BareImage)) -> (IO ())))
foreign import ccall safe "CV/Filters.chs.h cvIntegral"
cvIntegral :: ((Ptr ()) -> ((Ptr ()) -> ((Ptr ()) -> ((Ptr ()) -> (IO ())))))
foreign import ccall safe "CV/Filters.chs.h haarFilter"
haarFilter :: ((Ptr (BareImage)) -> (CInt -> (CInt -> (CInt -> (CInt -> ((Ptr (BareImage)) -> (IO ())))))))
foreign import ccall safe "CV/Filters.chs.h haar_at"
haar_at :: ((Ptr (BareImage)) -> (CInt -> (CInt -> (CInt -> (CInt -> (IO CDouble))))))