module CV.ImageMath(
add
, sub
, absDiff
, mul
, CV.ImageMath.div
, CV.ImageMath.min
, CV.ImageMath.max
, maskedMerge
, averageImages
, CV.ImageMath.atan2
, subMean
, subMeanAbs
, CV.ImageMath.sqrt
, CV.ImageMath.log
, CV.ImageMath.abs
, CV.ImageMath.atan
, invert
, addS
, subS
, subRS
, mulS
, minS
, maxS
, lessThan
, moreThan
, less2Than
, more2Than
, CV.ImageMath.sum
, average
, averageMask
, stdDeviation
, stdDeviationMask
, findMinMax
, findMinMaxLoc
, findMinMaxMask
, imageMinMax
, minValue
, maxValue
, imageAvgSdv
, gaussianImage
, fadedEdgeImage
, fadeToCenter
, maximalCoveringCircle
, limitToOp
) where
import Foreign.C.Types
import Foreign.C.String
import Foreign.ForeignPtr
import Foreign.Ptr
import CV.Bindings.Types
import CV.Bindings.Core
import CV.Image
import CV.ImageOp
import CV.Image
import Foreign.Marshal
import Foreign.Storable
import Foreign.Ptr
import System.IO.Unsafe
import Control.Applicative ((<$>))
mkBinaryImageOpIO f = \a -> \b ->
withGenImage a $ \ia ->
withGenImage b $ \ib ->
withCloneValue a $ \clone ->
withGenImage clone $ \cl -> do
f ia ib cl
return clone
mkBinaryImageOp
:: (Ptr () -> Ptr () -> Ptr () -> IO a)
-> CV.Image.Image c1 d1
-> CV.Image.Image c1 d1
-> CV.Image.Image c1 d1
mkBinaryImageOp f = \a -> \b -> unsafePerformIO $
withGenImage a $ \ia ->
withGenImage b $ \ib ->
withCloneValue a $ \clone ->
withGenImage clone $ \cl -> do
f ia ib cl
return clone
abcNullPtr f = \a b c -> f a b c nullPtr
addOp imageToBeAdded = ImgOp $ \target ->
withGenImage target $ \ctarget ->
withGenImage imageToBeAdded $ \cadd ->
cvAdd ctarget cadd ctarget nullPtr
add = mkBinaryImageOp $ abcNullPtr cvAdd
sub = mkBinaryImageOp $ abcNullPtr cvSub
subFrom what = ImgOp $ \from ->
withGenImage from $ \ifrom ->
withGenImage what $ \iwhat ->
cvSub ifrom iwhat ifrom nullPtr
logOp :: ImageOperation GrayScale D32
logOp = ImgOp $ \i -> withGenImage i (\img -> cvLog img img)
log = unsafeOperate logOp
sqrtOp :: ImageOperation GrayScale D32
sqrtOp = ImgOp $ \i -> withGenImage i (\img -> sqrtImage img img)
sqrt = unsafeOperate sqrtOp
limitToOp what = ImgOp $ \from ->
withGenImage from $ \ifrom ->
withGenImage what $ \iwhat ->
cvMin ifrom iwhat ifrom
limitTo x y = unsafeOperate (limitToOp x) y
mul = mkBinaryImageOp
(\a b c -> cvMul a b c 1)
div = mkBinaryImageOp
(\a b c -> cvDiv a b c 1)
min = mkBinaryImageOp cvMin
max = mkBinaryImageOp cvMax
absDiff = mkBinaryImageOp cvAbsDiff
atan :: Image GrayScale D32 -> Image GrayScale D32
atan i = unsafePerformIO $ do
let (w,h) = getSize i
res <- create (w,h)
withImage i $ \s ->
withImage res $ \r -> do
calculateAtan s r
return res
atan2 :: Image GrayScale D32 -> Image GrayScale D32 -> Image GrayScale D32
atan2 a b = unsafePerformIO $ do
res <- create (getSize a)
withImage a $ \c_a ->
withImage b $ \c_b ->
withImage res $ \c_res -> do
calculateAtan2 c_a c_b c_res
return res
subtractMeanAbsOp = ImgOp $ \image -> do
av <- average' image
withGenImage image $ \i ->
wrapAbsDiffS i (realToFrac av) i
subMeanAbs = unsafeOperate subtractMeanAbsOp
invert i = addS 1 $ mulS (1) i
absOp = ImgOp $ \image -> do
withGenImage image $ \i ->
wrapAbsDiffS i 0 i
abs = unsafeOperate absOp
subtractMeanOp :: ImageOperation GrayScale D32
subtractMeanOp = ImgOp $ \image -> do
let s = CV.ImageMath.sum image
let mean = s / (fromIntegral $ getArea image )
let (ImgOp subop) = subRSOp (realToFrac mean)
subop image
subMean = unsafeOperate subtractMeanOp
subRSOp :: D32 -> ImageOperation GrayScale D32
subRSOp scalar = ImgOp $ \a ->
withGenImage a $ \ia -> do
wrapSubRS ia (realToFrac scalar) ia
subRS s a= unsafeOperate (subRSOp s) a
subSOp scalar = ImgOp $ \a ->
withGenImage a $ \ia -> do
wrapSubS ia (realToFrac scalar) ia
subS a s = unsafeOperate (subSOp s) a
mulSOp :: D32 -> ImageOperation GrayScale D32
mulSOp scalar = ImgOp $ \a ->
withGenImage a $ \ia -> do
cvConvertScale ia ia s 0
return ()
where s = realToFrac scalar
mulS s = unsafeOperate $ mulSOp s
mkImgScalarOp op scalar = ImgOp $ \a ->
withGenImage a $ \ia -> do
op ia (realToFrac scalar) ia
return ()
addSOp :: D32 -> ImageOperation GrayScale D32
addSOp = mkImgScalarOp $ wrapAddS
addS s = unsafeOperate $ addSOp s
minSOp = mkImgScalarOp $ cvMinS
minS :: Float -> Image c d -> Image c d
minS s = unsafeOperate $ minSOp s
maxSOp = mkImgScalarOp $ cvMaxS
maxS :: Float -> Image c d -> Image c d
maxS s = unsafeOperate $ maxSOp s
cmpEQ = 0
cmpGT = 1
cmpGE = 2
cmpLT = 3
cmpLE = 4
cmpNE = 5
mkCmpOp :: CInt -> D32 -> (Image GrayScale D32 -> Image GrayScale D8)
mkCmpOp cmp = \scalar a -> unsafePerformIO $
withGenImage a $ \ia -> do
new <- create (getSize a) --8UC1
withGenImage new $ \cl -> do
cvCmpS ia (realToFrac scalar) cl cmp
return new
mkCmp2Op :: (CreateImage (Image GrayScale d)) =>
CInt -> (Image GrayScale d -> Image GrayScale d -> Image GrayScale D8)
mkCmp2Op cmp = \imgA imgB -> unsafePerformIO $ do
withGenImage imgA $ \ia -> do
withGenImage imgB $ \ib -> do
new <- create (getSize imgA)
withGenImage new $ \cl -> do
cvCmp ia ib cl cmp
return new
lessThan :: D32 -> Image GrayScale D32 -> Image GrayScale D8
lessThan = mkCmpOp cmpLT
moreThan :: D32 -> Image GrayScale D32 -> Image GrayScale D8
moreThan = mkCmpOp cmpGT
less2Than,lessEq2Than,more2Than :: (CreateImage (Image GrayScale d)) => Image GrayScale d
-> Image GrayScale d -> Image GrayScale D8
less2Than = mkCmp2Op cmpLT
lessEq2Than = mkCmp2Op cmpLE
more2Than = mkCmp2Op cmpGT
average' :: Image GrayScale D32 -> IO D32
average' img = withGenImage img $ \image ->
wrapAvg image nullPtr >>= return . realToFrac
average :: Image GrayScale D32 -> D32
average = realToFrac.unsafePerformIO.average'
averageMask :: Image GrayScale D32 -> Image GrayScale D8 -> D32
averageMask img mask = unsafePerformIO $
withGenImage img $ \c_image ->
withGenImage mask $ \c_mask ->
wrapAvg c_image c_mask >>= return . realToFrac
sum :: Image GrayScale D32 -> D32
sum img = realToFrac $ unsafePerformIO $ withGenImage img $ \image ->
wrapSum image
averageImages is = ( (1/(fromIntegral $ length is)) `mulS`) (foldl1 add is)
stdDeviation' img = withGenImage img wrapStdDev
stdDeviation :: Image GrayScale D32 -> D32
stdDeviation = realToFrac . unsafePerformIO . stdDeviation'
stdDeviationMask img mask = unsafePerformIO $
withGenImage img $ \i ->
withGenImage mask $ \m ->
wrapStdDevMask i m
peekFloatConv :: (Storable a, RealFloat a, RealFloat b) => Ptr a -> IO b
peekFloatConv a = fmap realToFrac (peek a)
findMinMax' :: BareImage -> BareImage -> IO (D32, D32)
findMinMax' a1 a2 =
withGenBareImage a1 $ \a1' ->
withGenBareImage a2 $ \a2' ->
alloca $ \a3' ->
alloca $ \a4' ->
findMinMax''_ a1' a2' a3' a4' >>= \res ->
peekFloatConv a3'>>= \a3'' ->
peekFloatConv a4'>>= \a4'' ->
return (a3'', a4'')
findMinMaxLoc img = unsafePerformIO $
alloca $ \(ptrintmaxx :: Ptr CInt)->
alloca $ \(ptrintmaxy :: Ptr CInt)->
alloca $ \(ptrintminx :: Ptr CInt)->
alloca $ \(ptrintminy :: Ptr CInt)->
alloca $ \(ptrintmin :: Ptr CDouble)->
alloca $ \(ptrintmax :: Ptr CDouble)->
withImage img $ \cimg -> do {
wrapMinMaxLoc cimg ptrintminx ptrintminy ptrintmaxx ptrintmaxy ptrintmin ptrintmax;
minx <- fromIntegral <$> peek ptrintminx;
miny <- fromIntegral <$> peek ptrintminy;
maxx <- fromIntegral <$> peek ptrintmaxx;
maxy <- fromIntegral <$> peek ptrintmaxy;
maxval <- realToFrac <$> peek ptrintmax;
minval <- realToFrac <$> peek ptrintmin;
return (((minx,miny),minval),((maxx,maxy),maxval));}
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 $ \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))
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))
imageAvgSdv :: (Fractional d) => Image GrayScale d -> (d,d)
imageAvgSdv i = unsafePerformIO $ do
withImage i $ \i_ptr -> do
let
avg = (C'CvScalar 0 0 0 0)
sdv = (C'CvScalar 0 0 0 0)
with avg $ \avg_ptr ->
with sdv $ \sdv_ptr -> do
c'cvAvgSdv (castPtr i_ptr) avg_ptr sdv_ptr nullPtr
(C'CvScalar a1 _ _ _) <- peek avg_ptr
(C'CvScalar s1 _ _ _) <- peek sdv_ptr
return (realToFrac a1, realToFrac s1)
findMinMax i = unsafePerformIO $ do
nullp <- newForeignPtr_ nullPtr
(findMinMax' (unS i) (BareImage nullp))
findMinMaxMask i mask = unsafePerformIO (findMinMax' i mask)
maxValue,minValue :: Image GrayScale D32 -> D32
maxValue = snd.findMinMax
minValue = fst.findMinMax
gaussianImage :: (Int,Int) -> (Double,Double) -> Image GrayScale D32
gaussianImage (w,h) (stdX,stdY) = unsafePerformIO $ do
dst <- create (w,h)
withImage dst $ \d-> do
render_gaussian d (realToFrac stdX) (realToFrac stdY)
return dst
fadedEdgeImage (w,h) edgeW = unsafePerformIO $creatingImage (fadedEdges w h edgeW)
fadeToCenter (w,h) = unsafePerformIO $creatingImage (rectangularDistance w h )
maskedMerge :: Image GrayScale D8 -> Image GrayScale D32 -> Image GrayScale D32 -> Image GrayScale D32
maskedMerge mask img img2 = unsafePerformIO $ do
res <- create (getSize img)
withImage img $ \cimg ->
withImage img2 $ \cimg2 ->
withImage res $ \cres ->
withImage (unsafeImageTo32F mask) $ \cmask ->
masked_merge cimg cmask cimg2 cres
return res
maximalCoveringCircle distMap (x,y,r)
= unsafePerformIO $
withImage distMap $ \c_distmap ->
alloca $ \(ptr_int_max_x :: Ptr CInt) ->
alloca $ \(ptr_int_max_y :: Ptr CInt) ->
alloca $ \(ptr_double_max_r :: Ptr CDouble) ->
do
maximal_covering_circle x y r c_distmap ptr_int_max_x ptr_int_max_y ptr_double_max_r
max_x <- fromIntegral <$> peek ptr_int_max_x
max_y <- fromIntegral <$> peek ptr_int_max_y
max_r <- realToFrac <$> peek ptr_double_max_r
return (max_x,max_y,max_r)
foreign import ccall safe "CV/ImageMath.chs.h cvAdd"
cvAdd :: ((Ptr ()) -> ((Ptr ()) -> ((Ptr ()) -> ((Ptr ()) -> (IO ())))))
foreign import ccall safe "CV/ImageMath.chs.h cvSub"
cvSub :: ((Ptr ()) -> ((Ptr ()) -> ((Ptr ()) -> ((Ptr ()) -> (IO ())))))
foreign import ccall safe "CV/ImageMath.chs.h cvLog"
cvLog :: ((Ptr ()) -> ((Ptr ()) -> (IO ())))
foreign import ccall safe "CV/ImageMath.chs.h sqrtImage"
sqrtImage :: ((Ptr (BareImage)) -> ((Ptr (BareImage)) -> (IO ())))
foreign import ccall safe "CV/ImageMath.chs.h cvMin"
cvMin :: ((Ptr ()) -> ((Ptr ()) -> ((Ptr ()) -> (IO ()))))
foreign import ccall safe "CV/ImageMath.chs.h cvMul"
cvMul :: ((Ptr ()) -> ((Ptr ()) -> ((Ptr ()) -> (CDouble -> (IO ())))))
foreign import ccall safe "CV/ImageMath.chs.h cvDiv"
cvDiv :: ((Ptr ()) -> ((Ptr ()) -> ((Ptr ()) -> (CDouble -> (IO ())))))
foreign import ccall safe "CV/ImageMath.chs.h cvMax"
cvMax :: ((Ptr ()) -> ((Ptr ()) -> ((Ptr ()) -> (IO ()))))
foreign import ccall safe "CV/ImageMath.chs.h cvAbsDiff"
cvAbsDiff :: ((Ptr ()) -> ((Ptr ()) -> ((Ptr ()) -> (IO ()))))
foreign import ccall safe "CV/ImageMath.chs.h calculateAtan"
calculateAtan :: ((Ptr (BareImage)) -> ((Ptr (BareImage)) -> (IO ())))
foreign import ccall safe "CV/ImageMath.chs.h calculateAtan2"
calculateAtan2 :: ((Ptr (BareImage)) -> ((Ptr (BareImage)) -> ((Ptr (BareImage)) -> (IO ()))))
foreign import ccall safe "CV/ImageMath.chs.h wrapAbsDiffS"
wrapAbsDiffS :: ((Ptr ()) -> (CDouble -> ((Ptr ()) -> (IO ()))))
foreign import ccall safe "CV/ImageMath.chs.h wrapSubRS"
wrapSubRS :: ((Ptr ()) -> (CDouble -> ((Ptr ()) -> (IO ()))))
foreign import ccall safe "CV/ImageMath.chs.h wrapSubS"
wrapSubS :: ((Ptr ()) -> (CDouble -> ((Ptr ()) -> (IO ()))))
foreign import ccall safe "CV/ImageMath.chs.h cvConvertScale"
cvConvertScale :: ((Ptr ()) -> ((Ptr ()) -> (CDouble -> (CDouble -> (IO ())))))
foreign import ccall safe "CV/ImageMath.chs.h wrapAddS"
wrapAddS :: ((Ptr ()) -> (CDouble -> ((Ptr ()) -> (IO ()))))
foreign import ccall safe "CV/ImageMath.chs.h cvMinS"
cvMinS :: ((Ptr ()) -> (CDouble -> ((Ptr ()) -> (IO ()))))
foreign import ccall safe "CV/ImageMath.chs.h cvMaxS"
cvMaxS :: ((Ptr ()) -> (CDouble -> ((Ptr ()) -> (IO ()))))
foreign import ccall safe "CV/ImageMath.chs.h cvCmpS"
cvCmpS :: ((Ptr ()) -> (CDouble -> ((Ptr ()) -> (CInt -> (IO ())))))
foreign import ccall safe "CV/ImageMath.chs.h cvCmp"
cvCmp :: ((Ptr ()) -> ((Ptr ()) -> ((Ptr ()) -> (CInt -> (IO ())))))
foreign import ccall safe "CV/ImageMath.chs.h wrapAvg"
wrapAvg :: ((Ptr ()) -> ((Ptr ()) -> (IO CDouble)))
foreign import ccall safe "CV/ImageMath.chs.h wrapSum"
wrapSum :: ((Ptr ()) -> (IO CDouble))
foreign import ccall safe "CV/ImageMath.chs.h wrapStdDev"
wrapStdDev :: ((Ptr ()) -> (IO CDouble))
foreign import ccall safe "CV/ImageMath.chs.h wrapStdDevMask"
wrapStdDevMask :: ((Ptr ()) -> ((Ptr ()) -> (IO CDouble)))
foreign import ccall safe "CV/ImageMath.chs.h wrapMinMax"
findMinMax''_ :: ((Ptr ()) -> ((Ptr ()) -> ((Ptr CDouble) -> ((Ptr CDouble) -> (IO ())))))
foreign import ccall safe "CV/ImageMath.chs.h wrapMinMaxLoc"
wrapMinMaxLoc :: ((Ptr (BareImage)) -> ((Ptr CInt) -> ((Ptr CInt) -> ((Ptr CInt) -> ((Ptr CInt) -> ((Ptr CDouble) -> ((Ptr CDouble) -> (IO ()))))))))
foreign import ccall safe "CV/ImageMath.chs.h render_gaussian"
render_gaussian :: ((Ptr (BareImage)) -> (CDouble -> (CDouble -> (IO ()))))
foreign import ccall safe "CV/ImageMath.chs.h fadedEdges"
fadedEdges :: (CInt -> (CInt -> (CInt -> (IO (Ptr (BareImage))))))
foreign import ccall safe "CV/ImageMath.chs.h rectangularDistance"
rectangularDistance :: (CInt -> (CInt -> (IO (Ptr (BareImage)))))
foreign import ccall safe "CV/ImageMath.chs.h masked_merge"
masked_merge :: ((Ptr (BareImage)) -> ((Ptr (BareImage)) -> ((Ptr (BareImage)) -> ((Ptr (BareImage)) -> (IO ())))))
foreign import ccall safe "CV/ImageMath.chs.h maximal_covering_circle"
maximal_covering_circle :: (CInt -> (CInt -> (CDouble -> ((Ptr (BareImage)) -> ((Ptr CInt) -> ((Ptr CInt) -> ((Ptr CDouble) -> (IO ()))))))))