diff --git a/opencv-examples/opencv-examples.cabal b/opencv-examples/opencv-examples.cabal index e1d8e22f..bb56134e 100644 --- a/opencv-examples/opencv-examples.cabal +++ b/opencv-examples/opencv-examples.cabal @@ -46,6 +46,18 @@ executable highgui default-language: Haskell2010 +executable videoio-bilateral + main-is: videoio-bilateral.hs + hs-source-dirs: src + ghc-options: -Wall -O2 + + build-depends: + base >= 4.8 && < 4.10 + , opencv + , opencv-examples + + default-language: Haskell2010 + executable videoio main-is: videoio.hs hs-source-dirs: src diff --git a/opencv-examples/src/videoio-bilateral.hs b/opencv-examples/src/videoio-bilateral.hs new file mode 100644 index 00000000..a9a4e345 --- /dev/null +++ b/opencv-examples/src/videoio-bilateral.hs @@ -0,0 +1,59 @@ +{-# language DataKinds #-} +{-# language FlexibleInstances #-} +{-# language FlexibleContexts #-} +{-# language OverloadedStrings #-} + +module Main where + +import qualified OpenCV as CV +import qualified OpenCV.Internal.Core.Types.Mat as CV +import qualified OpenCV.VideoIO.VideoWriter as CVW +import OpenCV.ImgProc.ImgFiltering +import OpenCV.TypeLevel +import OpenCV.Example +import OpenCV.VideoIO.Types as T +import System.Environment +import System.Exit +import Data.Word +import Control.Monad +import Text.Read + +main :: IO () +main = do + args <- getArgs + when (length args /= 2) $ print "videoio-bilateral input d output.mov " + let (_:d:output:_) = args ++ ["5", "/dev/null"] + cap <- createCaptureArg + + fps <- CV.videoCaptureGetD cap VideoCapPropFps + w <- CV.videoCaptureGetI cap VideoCapPropFrameWidth + h <- CV.videoCaptureGetI cap VideoCapPropFrameHeight + print (fps, w, h) + + isOpened <- CV.videoCaptureIsOpened cap + + if not isOpened + then putStrLn "Couldn't open video capture device" + else CV.withWindow "video" $ \window -> + CV.withWindow "input video" $ \windowlv -> do + wr <- CVW.videoWriterOpen $ CVW.VideoFileSink' $ CVW.VideoFileSink output "avc1" fps (w , h) + loop (readMaybe d) cap wr window windowlv 0 + CV.exceptErrorIO $ CVW.videoWriterRelease wr + where + loop d cap wr window windowlv i = do + _ok <- CV.videoCaptureGrab cap + print (i :: Int) + mbImg <- CV.videoCaptureRetrieve cap + case mbImg of + Just img -> do + let img' :: CV.Mat ('S ['D, 'D]) ('S 3) ('S Word8) + img' = CV.exceptError (CV.coerceMat img) + let dnImg = CV.exceptError $ bilateralFilter d (Just 20) (Just 500) Nothing img' + CV.exceptErrorIO $ CVW.videoWriterWrite wr $ CV.unsafeCoerceMat dnImg + + CV.imshow window dnImg + CV.imshow windowlv img' + key <- CV.waitKey 20 + -- Loop unless the escape key is pressed. + unless (key == 27) $ loop d cap wr window windowlv (i + 1) + Nothing -> pure () diff --git a/opencv/src/OpenCV/ImgProc/ImgFiltering.hsc b/opencv/src/OpenCV/ImgProc/ImgFiltering.hsc index e86f63d5..8b79619f 100644 --- a/opencv/src/OpenCV/ImgProc/ImgFiltering.hsc +++ b/opencv/src/OpenCV/ImgProc/ImgFiltering.hsc @@ -34,6 +34,7 @@ module OpenCV.ImgProc.ImgFiltering ( MorphShape(..) , MorphOperation(..) + , bilateralFilter , laplacian , medianBlur , erode @@ -132,6 +133,84 @@ marshalMorphOperation = \case -- Image Filtering -------------------------------------------------------------------------------- +{- | Calculates the bilateralFilter of an image + +The function applies bilateral filtering to the input image, as described in + +bilateralFilter can reduce unwanted noise very well while keeping edges fairly sharp. However, it is very slow compared to most filters. +Example: + +@ +bilateralFilterImg + :: forall (width :: Nat) + (width2 :: Nat) + (height :: Nat) + (channels :: Nat) + (depth :: *) + . ( Mat (ShapeT [height, width]) ('S channels) ('S depth) ~ Birds_512x341 + , width2 ~ ((*) width 2) -- TODO (RvD): HSE parse error with infix type operator + ) + => Mat (ShapeT [height, width2]) ('S channels) ('S depth) +bilateralFilterImg = exceptError $ + withMatM (Proxy :: Proxy [height, width2]) + (Proxy :: Proxy channels) + (Proxy :: Proxy depth) + white $ \imgM -> do + birdsFiltered <- pureExcept $ bilateralFilter (Just 9) Nothing Nothing Nothing birds_512x341 + matCopyToM imgM (V2 0 0) birds_512x341 Nothing + matCopyToM imgM (V2 w 0) birdsFiltered Nothing + where + w = fromInteger $ natVal (Proxy :: Proxy width) +@ + +<> + + +-} +bilateralFilter + :: ( depth `In` '[Word8, Float, Double] + , channels `In` '[1, 3] + -- , Length shape <= 2 + ) + => Maybe Int32 + -- ^ Diameter of each pixel neighborhood that is used during filtering. + -- If it is non-positive, it is computed from sigmaSpace. Default value is 5. + -> Maybe Double + -- ^ Filter sigma in the color space. A larger value of the parameter means that farther colors within + -- the pixel neighborhood (see sigmaSpace) will be mixed together, resulting in larger areas of semi-equal color. + -- Default value is 50 + -> Maybe Double + -- ^ Filter sigma in the coordinate space. A larger value of the parameter means that farther pixels will + -- influence each other as long as their colors are close enough (see sigmaColor ). When d>0, it specifies + -- the neighborhood size regardless of sigmaSpace. Otherwise, d is proportional to sigmaSpace. + -- Default value is 50 + -> Maybe BorderMode + -- ^ Pixel extrapolation method. Default value is BorderReflect101 + -> Mat shape ('S channels) ('S depth) + -> CvExcept (Mat shape ('S channels) ('S depth)) +bilateralFilter d sigmaColor sigmaSpace borderType src = unsafeWrapException $ do + dst <- newEmptyMat + handleCvException (pure $ unsafeCoerceMat dst) $ + withPtr src $ \srcPtr -> + withPtr dst $ \dstPtr -> + [cvExcept| + cv::bilateralFilter + ( *$(Mat * srcPtr ) + , *$(Mat * dstPtr ) + , $(int32_t c'd ) + , $(double c'sigmaColor) + , $(double c'sigmaSpace) + , $(int32_t c'borderType) + ); + |] + where + c'd = fromMaybe 5 d + c'sigmaColor = maybe 50 realToFrac sigmaColor + c'sigmaSpace = maybe 50 realToFrac sigmaSpace + c'borderType = fst $ marshalBorderMode $ fromMaybe BorderReflect101 borderType + + + {- | Calculates the Laplacian of an image The function calculates the Laplacian of the source image by adding up