module CV.Edges (
sobelOp,sobel
,laplaceOp,laplace,canny,susan
,SobelAperture
,sScharr,s1,s3,s5,s7
,LaplacianAperture
,l1,l3,l5,l7
) where
import Foreign.C.Types
import Foreign.C.String
import Foreign.ForeignPtr
import Foreign.Ptr
import CV.ImageOp
import CV.Image
import CV.Image
import System.IO.Unsafe
sobelOp :: (Int,Int) -> SobelAperture -> ImageOperation GrayScale D32
sobelOp (dx,dy) (Sb aperture)
| dx >=0 && dx <3
&& not ((aperture == 1) && (dx>1 || dy>1))
&& dy >=0 && dy<3 = ImgOp $ \i -> withGenImage i $ \image ->
(cvSobel image image cdx cdy cap)
| otherwise = error "Invalid aperture"
where [cdx,cdy,cap] = map fromIntegral [dx,dy,aperture]
sobel dd ap im = unsafeOperate (sobelOp dd ap) im
newtype SobelAperture = Sb Int deriving(Eq,Ord,Show,Read)
sScharr = Sb (1)
s1 = Sb 1
s3 = Sb 3
s5 = Sb 5
s7 = Sb 7
newtype LaplacianAperture = L Int deriving(Eq,Ord,Show,Read)
l1 = L 1
l3 = L 3
l5 = L 5
l7 = L 7
laplaceOp :: LaplacianAperture -> ImageOperation GrayScale D32
laplaceOp (L s) = ImgOp $ \img -> withGenImage img $ \image ->
(cvLaplace image image (fromIntegral s))
laplace s i = unsafeOperate (laplaceOp s) i
canny :: Int -> Int -> Int -> Image GrayScale D8 -> Image GrayScale D8
canny t1 t2 aperture src = unsafePerformIO $ do
withCloneValue src $ \clone ->
withGenImage src $ \si ->
withGenImage clone $ \ci -> do
cvCanny si ci (fromIntegral t1)
(fromIntegral t2)
(fromIntegral aperture)
return clone
susan :: (Int,Int) -> D32 -> Image GrayScale D32 -> Image GrayScale D8
susan (w,h) t image = unsafePerformIO $ do
withGenImage image $ \img ->
creatingImage
(susanEdge img (fromIntegral w) (fromIntegral h) (realToFrac t))
foreign import ccall safe "CV/Edges.chs.h cvSobel"
cvSobel :: ((Ptr ()) -> ((Ptr ()) -> (CInt -> (CInt -> (CInt -> (IO ()))))))
foreign import ccall safe "CV/Edges.chs.h cvLaplace"
cvLaplace :: ((Ptr ()) -> ((Ptr ()) -> (CInt -> (IO ()))))
foreign import ccall safe "CV/Edges.chs.h cvCanny"
cvCanny :: ((Ptr ()) -> ((Ptr ()) -> (CDouble -> (CDouble -> (CInt -> (IO ()))))))
foreign import ccall safe "CV/Edges.chs.h susanEdge"
susanEdge :: ((Ptr (BareImage)) -> (CInt -> (CInt -> (CDouble -> (IO (Ptr (BareImage)))))))