never executed always true always false
    1 {-# language CPP #-}
    2 {-# language QuasiQuotes #-}
    3 {-# language TemplateHaskell #-}
    4 
    5 #if __GLASGOW_HASKELL__ >= 800
    6 {-# options_ghc -Wno-redundant-constraints #-}
    7 #endif
    8 
    9 module OpenCV.Photo
   10   ( InpaintingMethod(..)
   11   , decolor
   12   , inpaint
   13   , denoise_TVL1
   14   , fastNlMeansDenoisingColored
   15   , fastNlMeansDenoisingColoredMulti
   16   ) where
   17 
   18 import "base" Data.Int ( Int32 )
   19 import "base" Data.Word ( Word8 )
   20 import qualified "inline-c" Language.C.Inline as C
   21 import qualified "inline-c-cpp" Language.C.Inline.Cpp as C
   22 import "this" OpenCV.Internal.C.Inline ( openCvCtx )
   23 import "this" OpenCV.Internal.C.Types ( withPtr )
   24 import "this" OpenCV.Internal.Exception
   25 import "this" OpenCV.Internal.Photo.Constants
   26 import "this" OpenCV.Internal.Core.Types.Mat
   27 import "this" OpenCV.Internal.Core.Types ( withArrayPtr )
   28 import "this" OpenCV.TypeLevel
   29 
   30 import qualified "vector" Data.Vector as V
   31 
   32 --------------------------------------------------------------------------------
   33 
   34 C.context openCvCtx
   35 
   36 C.include "opencv2/core.hpp"
   37 C.include "opencv2/photo.hpp"
   38 C.using "namespace cv"
   39 
   40 --------------------------------------------------------------------------------
   41 
   42 data InpaintingMethod
   43    = InpaintNavierStokes
   44      -- ^ Navier-Stokes based method.
   45    | InpaintTelea
   46      -- ^ Method by Alexandru Telea.
   47      deriving Show
   48 
   49 marshalInpaintingMethod :: InpaintingMethod -> Int32
   50 marshalInpaintingMethod = \case
   51   InpaintNavierStokes -> c'INPAINT_NS
   52   InpaintTelea        -> c'INPAINT_TELEA
   53 
   54 {- | Restores the selected region in an image using the region neighborhood.
   55 
   56 Example:
   57 
   58 @
   59 inpaintImg
   60     :: forall h h2 w w2 c d
   61      . ( Mat (ShapeT [h, w]) ('S c) ('S d) ~ Kodak_512x341
   62        , h2 ~ ((*) h 2)
   63        , w2 ~ ((*) w 2)
   64        )
   65     => Mat ('S ['S h2, 'S w2]) ('S c) ('S d)
   66 inpaintImg = exceptError $ do
   67     maskInv <- bitwiseNot mask
   68     maskBgr <- cvtColor gray bgr maskInv
   69     damaged <- bitwiseAnd bikes_512x341 maskBgr
   70     repairedNS <- inpaint 3 InpaintNavierStokes damaged mask
   71     repairedT  <- inpaint 3 InpaintTelea        damaged mask
   72     withMatM
   73       (Proxy :: Proxy [h2, w2])
   74       (Proxy :: Proxy c)
   75       (Proxy :: Proxy d)
   76       black $ \\imgM -> do
   77         matCopyToM imgM (V2 0 0) damaged Nothing
   78         matCopyToM imgM (V2 w 0) maskBgr Nothing
   79         matCopyToM imgM (V2 0 h) repairedNS Nothing
   80         matCopyToM imgM (V2 w h) repairedT  Nothing
   81   where
   82     mask = damageMask
   83 
   84     w = fromInteger $ natVal (Proxy :: Proxy w)
   85     h = fromInteger $ natVal (Proxy :: Proxy h)
   86 @
   87 
   88 <<doc/generated/examples/inpaintImg.png inpaintImg>>
   89 -}
   90 inpaint
   91    :: (channels `In` [1, 3])
   92    => Double
   93       -- ^ inpaintRadius - Radius of a circular neighborhood of each
   94       -- point inpainted that is considered by the algorithm.
   95    -> InpaintingMethod
   96    -> Mat ('S [h, w]) ('S channels) ('S Word8) -- ^ Input image.
   97    -> Mat ('S [h, w]) ('S 1) ('S Word8) -- ^ Inpainting mask.
   98    -> CvExcept (Mat ('S [h, w]) ('S channels) ('S Word8)) -- ^ Output image.
   99 inpaint inpaintRadius method src inpaintMask = unsafeWrapException $ do
  100     dst <- newEmptyMat
  101     handleCvException (pure $ unsafeCoerceMat dst) $
  102       withPtr src         $ \srcPtr         ->
  103       withPtr inpaintMask $ \inpaintMaskPtr ->
  104       withPtr dst         $ \dstPtr         ->
  105       [cvExcept|
  106         cv::inpaint( *$(Mat * srcPtr)
  107                    , *$(Mat * inpaintMaskPtr)
  108                    , *$(Mat * dstPtr)
  109                    , $(double c'inpaintRadius)
  110                    , $(int32_t c'method)
  111                    );
  112       |]
  113   where
  114     c'method = marshalInpaintingMethod method
  115     c'inpaintRadius = realToFrac inpaintRadius
  116 
  117 {- | Perform fastNlMeansDenoising function for colored images. Denoising is not
  118      per channel but in a different colour space
  119 
  120 Example:
  121 
  122 @
  123 fastNlMeansDenoisingColoredImg
  124     :: forall h w w2 c d
  125      . ( Mat (ShapeT [h, w]) ('S c) ('S d) ~ Lenna_512x512
  126        , w2 ~ ((*) w 2)
  127        )
  128     => Mat ('S ['S h, 'S w2]) ('S c) ('S d)
  129 fastNlMeansDenoisingColoredImg = exceptError $ do
  130     denoised <- fastNlMeansDenoisingColored 3 10 7 21 lenna_512x512
  131     withMatM
  132       (Proxy :: Proxy [h, w2])
  133       (Proxy :: Proxy c)
  134       (Proxy :: Proxy d)
  135       black $ \\imgM -> do
  136         matCopyToM imgM (V2 0 0) lenna_512x512 Nothing
  137         matCopyToM imgM (V2 w 0) denoised Nothing
  138   where
  139     w = fromInteger $ natVal (Proxy :: Proxy w)
  140 @
  141 
  142 <<doc/generated/examples/fastNlMeansDenoisingColoredImg.png fastNlMeansDenoisingColoredImg>>
  143 -}
  144 
  145 fastNlMeansDenoisingColored
  146    :: Double -- ^ Parameter regulating filter strength for luminance component.
  147              -- Bigger h value perfectly removes noise but also removes image
  148              -- details, smaller h value preserves details but also preserves
  149              -- some noise
  150    -> Double -- ^ The same as h but for color components. For most images value
  151              -- equals 10 will be enough to remove colored noise and do not
  152              -- distort colors
  153    -> Int32  -- ^ templateWindowSize Size in pixels of the template patch that
  154              -- is used to compute weights.
  155              -- Should be odd. Recommended value 7 pixels
  156    -> Int32  -- ^ searchWindowSize. Size in pixels of the window that is used
  157              -- to compute weighted average for given pixel. Should be odd.
  158              -- Affect performance linearly: greater searchWindowsSize
  159              -- - greater denoising time. Recommended value 21 pixels
  160    -> Mat ('S [h, w]) ('S 3) ('S Word8) -- ^ Input image 8-bit 3-channel image.
  161    -> CvExcept (Mat ('S [h, w]) ('S 3) ('S Word8))
  162              -- ^ Output image same size and type as input.
  163 fastNlMeansDenoisingColored h hColor templateWindowSize searchWindowSize src =
  164   unsafeWrapException $ do
  165     dst <- newEmptyMat
  166     handleCvException (pure $ unsafeCoerceMat dst) $
  167       withPtr src         $ \srcPtr         ->
  168       withPtr dst         $ \dstPtr         ->
  169       [cvExcept|
  170         cv::fastNlMeansDenoisingColored( *$(Mat * srcPtr)
  171                                        , *$(Mat * dstPtr)
  172                                        , $(double c'h)
  173                                        , $(double c'hColor)
  174                                        , $(int32_t templateWindowSize)
  175                                        , $(int32_t searchWindowSize)
  176                                        );
  177       |]
  178   where
  179     c'h = realToFrac h
  180     c'hColor = realToFrac hColor
  181 
  182 {- | Perform fastNlMeansDenoisingColoredMulti function for colored images.
  183      Denoising is not pre channel but in a different colour space.
  184      This wrapper differs from the original OpenCV version by using all input
  185      images and denoising the middle one. The original version would allow
  186      to have some arbitrary length vector and slide window over it. As we have
  187      to copy the haskell vector before we can use it as `std::vector` on the cpp
  188      side it is easier to trim the vector before sending and use all frames.
  189 
  190 Example:
  191 
  192 @
  193 fastNlMeansDenoisingColoredMultiImg
  194     :: forall h w w2 c d
  195      . ( Mat (ShapeT [h, w]) ('S c) ('S d) ~ Lenna_512x512
  196        , w2 ~ ((*) w 2)
  197        )
  198     => Mat ('S ['S h, 'S w2]) ('S c) ('S d)
  199 fastNlMeansDenoisingColoredMultiImg = exceptError $ do
  200     denoised <- fastNlMeansDenoisingColoredMulti 3 10 7 21 (V.singleton lenna_512x512)
  201     withMatM
  202       (Proxy :: Proxy [h, w2])
  203       (Proxy :: Proxy c)
  204       (Proxy :: Proxy d)
  205       black $ \\imgM -> do
  206         matCopyToM imgM (V2 0 0) lenna_512x512 Nothing
  207         matCopyToM imgM (V2 w 0) denoised Nothing
  208   where
  209     w = fromInteger $ natVal (Proxy :: Proxy w)
  210 @
  211 
  212 <<doc/generated/examples/fastNlMeansDenoisingColoredMultiImg.png fastNlMeansDenoisingColoredMultiImg>>
  213 -}
  214 
  215 fastNlMeansDenoisingColoredMulti
  216    :: Double -- ^ Parameter regulating filter strength for luminance component.
  217              -- Bigger h value perfectly removes noise but also removes image
  218              -- details, smaller h value preserves details but also preserves
  219              -- some noise
  220    -> Double -- ^ The same as h but for color components. For most images value
  221              -- equals 10 will be enough to remove colored noise and do not
  222              -- distort colors
  223    -> Int32  -- ^ templateWindowSize Size in pixels of the template patch that
  224              -- is used to compute weights. Should be odd.
  225              -- Recommended value 7 pixels
  226    -> Int32  -- ^ searchWindowSize. Size in pixels of the window that is used to
  227              -- compute weighted average for given pixel. Should be odd.
  228              -- Affect performance linearly: greater searchWindowsSize -
  229              -- greater denoising time. Recommended value 21 pixels
  230    -> V.Vector (Mat ('S [h, w]) ('S 3) ('S Word8))
  231              -- ^ Vector of odd number of input 8-bit 3-channel images.
  232    -> CvExcept (Mat ('S [h, w]) ('S 3) ('S Word8))
  233              -- ^ Output image same size and type as input.
  234 
  235 fastNlMeansDenoisingColoredMulti h hColor templateWindowSize searchWindowSize srcVec =
  236   unsafeWrapException $ do
  237     dst <- newEmptyMat
  238     handleCvException (pure $ unsafeCoerceMat dst) $
  239       withArrayPtr srcVec $ \srcVecPtr      ->
  240       withPtr dst         $ \dstPtr         ->
  241       [cvExcept|
  242         std::vector<Mat> buffer( $(Mat * srcVecPtr)
  243                     , $(Mat * srcVecPtr) + $(int32_t c'temporalWindowSize) );
  244         cv::fastNlMeansDenoisingColoredMulti( buffer
  245                                             , *$(Mat * dstPtr)
  246                                             , $(int32_t c'imgToDenoiseIndex)
  247                                             , $(int32_t c'temporalWindowSize)
  248                                             , $(double c'h)
  249                                             , $(double c'hColor)
  250                                             , $(int32_t templateWindowSize)
  251                                             , $(int32_t searchWindowSize)
  252                                             );
  253       |]
  254   where
  255     c'h = realToFrac h
  256     c'hColor = realToFrac hColor
  257     c'srcVecLength = fromIntegral $ V.length srcVec
  258     -- if it is not odd we drop the last image
  259     c'temporalWindowSize
  260         | c'srcVecLength `mod` 2 == 1 = c'srcVecLength
  261         | otherwise                   = c'srcVecLength - 1
  262     c'imgToDenoiseIndex = (c'temporalWindowSize - 1) `div` 2
  263 
  264 {- | Perform denoise_TVL1
  265 
  266 Example:
  267 
  268 @
  269 
  270 denoise_TVL1Img
  271     :: forall h w w2 c d
  272      . ( Mat (ShapeT [h, w]) ('S c) ('S d) ~ Lenna_512x512
  273        , w2 ~ ((*) w 2)
  274        )
  275     => Mat ('S ['S h, 'S w2]) ('S c) ('S d)
  276 denoise_TVL1Img = exceptError $ do
  277     denoised <- matChannelMapM (denoise_TVL1 2 50 . V.singleton) lenna_512x512
  278     withMatM
  279       (Proxy :: Proxy [h, w2])
  280       (Proxy :: Proxy c)
  281       (Proxy :: Proxy d)
  282       black $ \\imgM -> do
  283         matCopyToM imgM (V2 0 0) lenna_512x512 Nothing
  284         matCopyToM imgM (V2 w 0) denoised Nothing
  285   where
  286     w = fromInteger $ natVal (Proxy :: Proxy w)
  287 @
  288 
  289 <<doc/generated/examples/denoise_TVL1Img.png denoise_TVL1Img>>
  290 -}
  291 
  292 denoise_TVL1
  293    :: Double -- ^ details more is more 2
  294    -> Int32  -- ^ Number of iterations that the algorithm will run
  295    -> V.Vector (Mat ('S [h, w]) ('S 1) ('S Word8))
  296              -- ^ Vector of odd number of input 8-bit 3-channel images.
  297    -> CvExcept (Mat ('S [h, w]) ('S 1) ('S Word8))
  298              -- ^ Output image same size and type as input.
  299 
  300 denoise_TVL1 lambda niters srcVec = unsafeWrapException $ do
  301     dst <- newEmptyMat
  302     handleCvException (pure $ unsafeCoerceMat dst) $
  303       withArrayPtr srcVec $ \srcVecPtr      ->
  304       withPtr dst         $ \dstPtr         ->
  305       [cvExcept|
  306         std::vector<Mat> buffer( $(Mat * srcVecPtr)
  307                            , $(Mat * srcVecPtr) + $(int32_t c'srcVecLength) );
  308         cv::denoise_TVL1( buffer
  309                         , *$(Mat * dstPtr)
  310                         , $(double c'lambda)
  311                         , $(int32_t niters)
  312                         );
  313       |]
  314   where
  315     c'lambda = realToFrac lambda
  316     c'srcVecLength = fromIntegral $ V.length srcVec
  317 
  318 
  319 {- | Perform decolor
  320 
  321 Decolor a color image to a grayscale (1 channel) and a color boosted image (3 channel)
  322 
  323 Example:
  324 
  325 @
  326 decolorImg
  327     :: forall h h2 w w2 c d
  328      . ( Mat (ShapeT [h, w]) ('S c) ('S d) ~ Kodak_512x341
  329        , h2 ~ ((*) h 2)
  330        , w2 ~ ((*) w 2)
  331        )
  332     => Mat ('S ['S h2, 'S w2]) ('S c) ('S d)
  333 decolorImg = exceptError $ do
  334     (bikesGray, boost) <- decolor bikes_512x341
  335     colorGray <- cvtColor gray bgr bikesGray
  336     withMatM
  337       (Proxy :: Proxy [h2, w2])
  338       (Proxy :: Proxy c)
  339       (Proxy :: Proxy d)
  340       white $ \\imgM -> do
  341         matCopyToM imgM (V2 0 0) bikes_512x341 Nothing
  342         matCopyToM imgM (V2 0 h) colorGray Nothing
  343         matCopyToM imgM (V2 w h) boost  Nothing
  344   where
  345     w = fromInteger $ natVal (Proxy :: Proxy w)
  346     h = fromInteger $ natVal (Proxy :: Proxy h)
  347 @
  348 
  349 <<doc/generated/examples/decolorImg.png decolorImg>>
  350 -}
  351 
  352 decolor
  353    :: Mat ('S [h, w]) ('S 3) ('S Word8) -- ^ Input image.
  354    -> CvExcept (Mat ('S [h, w]) ('S 1) ('S Word8), Mat ('S [h, w]) ('S 3) ('S Word8)) -- ^ Output images.
  355 
  356 decolor src = unsafeWrapException $ do
  357     gray <- newEmptyMat
  358     boost <- newEmptyMat
  359 
  360     handleCvException (pure (unsafeCoerceMat gray, unsafeCoerceMat boost)) $
  361       withPtr src         $ \srcPtr         ->
  362       withPtr gray        $ \grayPtr        ->
  363       withPtr boost       $ \boostPtr       ->
  364       [cvExcept|
  365         cv::decolor( *$(Mat * srcPtr)
  366                    , *$(Mat * grayPtr)
  367                    , *$(Mat * boostPtr)
  368                    );
  369       |]