content: {-# language CPP #-}
  {-# language QuasiQuotes #-}
  {-# language TemplateHaskell #-}
  
  #if __GLASGOW_HASKELL__ >= 800
  {-# options_ghc -Wno-redundant-constraints #-}
  #endif
  
  module OpenCV.ImgProc.MiscImgTransform
      ( -- * Color conversion
        cvtColor
      , module OpenCV.ImgProc.MiscImgTransform.ColorCodes
  
        -- * Flood filling
      , floodFill
      , FloodFillOperationFlags(..)
      , defaultFloodFillOperationFlags
  
        -- * Thresholding
      , ThreshType(..)
      , ThreshValue(..)
      , threshold
  
        -- * Watershed
      , watershed
  
        -- * GrabCut
      , GrabCutOperationMode(..)
      , grabCut
  
        -- * In range
      , inRange
      ) where
  
  import "base" Data.Bits
  import "base" Data.Int
  import "base" Data.Proxy ( Proxy(..) )
  import "base" Data.Word
  import "base" Foreign.Marshal.Alloc ( alloca )
  import "base" Foreign.Storable ( peek )
  import "base" GHC.TypeLits
  import "primitive" Control.Monad.Primitive ( PrimMonad, PrimState, unsafePrimToPrim )
  import qualified "inline-c" Language.C.Inline as C
  import qualified "inline-c-cpp" Language.C.Inline.Cpp as C
  import "linear" Linear.V4 ( V4 )
  import "mtl" Control.Monad.Error.Class ( MonadError )
  import "this" OpenCV.Core.Types
  import "this" OpenCV.ImgProc.MiscImgTransform.ColorCodes
  import "this" OpenCV.Internal.C.Inline ( openCvCtx )
  import "this" OpenCV.Internal.C.Types
  import "this" OpenCV.Internal.Exception
  import "this" OpenCV.Internal.Core.Types.Mat
  import "this" OpenCV.Internal.ImgProc.MiscImgTransform
  import "this" OpenCV.Internal.ImgProc.MiscImgTransform.TypeLevel
  import "this" OpenCV.Internal.ImgProc.MiscImgTransform.ColorCodes ( colorConversionCode )
  import "this" OpenCV.TypeLevel
  
  --------------------------------------------------------------------------------
  
  C.context openCvCtx
  
  C.include "opencv2/core.hpp"
  C.include "opencv2/imgproc.hpp"
  C.using "namespace cv"
  
  --------------------------------------------------------------------------------
  
  -- ignore next Haddock code block, because of the hash sign in the link at the end of the comment.
  {- | Converts an image from one color space to another
  
  The function converts an input image from one color space to
  another. In case of a transformation to-from RGB color space, the
  order of the channels should be specified explicitly (RGB or
  BGR). Note that the default color format in OpenCV is often
  referred to as RGB but it is actually BGR (the bytes are
  reversed). So the first byte in a standard (24-bit) color image
  will be an 8-bit Blue component, the second byte will be Green, and
  the third byte will be Red. The fourth, fifth, and sixth bytes
  would then be the second pixel (Blue, then Green, then Red), and so
  on.
  
  The conventional ranges for R, G, and B channel values are:
  
    * 0 to 255 for 'Word8' images
  
    * 0 to 65535 for 'Word16' images
  
    * 0 to 1 for 'Float' images
  
  In case of linear transformations, the range does not matter. But
  in case of a non-linear transformation, an input RGB image should
  be normalized to the proper value range to get the correct results,
  for example, for RGB to L*u*v* transformation. For example, if you
  have a 32-bit floating-point image directly converted from an 8-bit
  image without any scaling, then it will have the 0..255 value range
  instead of 0..1 assumed by the function. So, before calling
  'cvtColor', you need first to scale the image down:
  
  >  cvtColor (img * 1/255) 'ColorConvBGR2Luv'
  
  If you use 'cvtColor' with 8-bit images, the conversion will have
  some information lost. For many applications, this will not be
  noticeable but it is recommended to use 32-bit images in
  applications that need the full range of colors or that convert an
  image before an operation and then convert back.
  
  If conversion adds the alpha channel, its value will set to the
  maximum of corresponding channel range: 255 for 'Word8', 65535 for
  'Word16', 1 for 'Float'.
  
  Example:
  
  @
  cvtColorImg
      :: forall (width    :: Nat)
                (width2   :: Nat)
                (height   :: Nat)
                (channels :: Nat)
                (depth    :: *)
       . ( Mat (ShapeT [height, width]) ('S channels) ('S depth) ~ Kodak_512x341
         , width2 ~ (width + width)
         )
      => Mat (ShapeT [height, width2]) ('S channels) ('S depth)
  cvtColorImg = exceptError $
      withMatM ((Proxy :: Proxy height) ::: (Proxy :: Proxy width2) ::: Z)
               (Proxy :: Proxy channels)
               (Proxy :: Proxy depth)
               white $ \\imgM -> do
        birds_gray <-     cvtColor gray bgr
                      =<< cvtColor bgr gray birds_512x341
        matCopyToM imgM (V2 0 0) birds_512x341 Nothing
        matCopyToM imgM (V2 w 0) birds_gray    Nothing
        lift $ arrowedLine imgM (V2 startX midY) (V2 pointX midY) red 4 LineType_8 0 0.15
    where
      h, w :: Int32
      h = fromInteger $ natVal (Proxy :: Proxy height)
      w = fromInteger $ natVal (Proxy :: Proxy width)
  
      startX, pointX :: Int32
      startX = round $ fromIntegral w * (0.95 :: Double)
      pointX = round $ fromIntegral w * (1.05 :: Double)
      midY = h \`div\` 2
  @
  
  <<doc/generated/examples/cvtColorImg.png cvtColorImg>>
  
  <http://goo.gl/3rfrhu OpenCV Sphinx Doc>
  -}
  
  -- the link avove is minified because it includes a hash, which the CPP tries to parse and fails
  
  -- TODO (RvD): Allow value level color codes
  -- Allow statically unknown color codes: fromColor :: DS ColorCode
  cvtColor :: forall (fromColor   :: ColorCode)
                     (toColor     :: ColorCode)
                     (shape       :: DS [DS Nat])
                     (srcChannels :: DS Nat)
                     (dstChannels :: DS Nat)
                     (srcDepth    :: DS *)
                     (dstDepth    :: DS *)
                     m
            . ( ColorConversion fromColor toColor
              , ColorCodeMatchesChannels fromColor srcChannels
              , dstChannels ~ 'S (ColorCodeChannels toColor)
              , srcDepth `In` ['D, 'S Word8, 'S Word16, 'S Float]
              , dstDepth ~ ColorCodeDepth fromColor toColor srcDepth
              , MonadError CvException m
              )
           => Proxy fromColor -- ^ Convert from 'ColorCode'. Make sure the source image has this 'ColorCode'
           -> Proxy toColor   -- ^ Convert to 'ColorCode'.
           -> Mat shape srcChannels srcDepth -- ^ Source image
           -> m (Mat shape dstChannels dstDepth)
  cvtColor fromColor toColor src = unsafeWrapException $ do
      dst <- newEmptyMat
      handleCvException (pure $ unsafeCoerceMat dst) $
        withPtr src $ \srcPtr ->
        withPtr dst $ \dstPtr ->
          [cvExcept|
            cv::cvtColor( *$(Mat * srcPtr)
                        , *$(Mat * dstPtr)
                        , $(int32_t c'code)
                        , 0
                        );
          |]
    where
      c'code = colorConversionCode fromColor toColor
  
  {- | The function 'floodFill' fills a connected component starting from the seed point with the specified color.
  
  The connectivity is determined by the color/brightness closeness of the neighbor pixels. See the OpenCV
  documentation for details on the algorithm.
  
  Example:
  
  @
  floodFillImg
      :: forall (width    :: Nat)
                (width2   :: Nat)
                (height   :: Nat)
                (channels :: Nat)
                (depth    :: *)
       . ( Mat (ShapeT [height, width]) ('S channels) ('S depth) ~ Kodak_768x512
         , width2 ~ (width + width)
         )
      => Mat (ShapeT [height, width2]) ('S channels) ('S depth)
  floodFillImg = exceptError $
      withMatM ((Proxy :: Proxy height) ::: (Proxy :: Proxy width2) ::: Z)
               (Proxy :: Proxy channels)
               (Proxy :: Proxy depth)
               white $ \\imgM -> do
        sailboatEvening_768x512 <- thaw sailboat_768x512
        mask <- mkMatM (Proxy :: Proxy [height + 2, width + 2])
                       (Proxy :: Proxy 1)
                       (Proxy :: Proxy Word8)
                       black
        circle mask (V2 450 120 :: V2 Int32) 45 white (-1) LineType_AA 0
        rect <- floodFill sailboatEvening_768x512 (Just mask) seedPoint eveningRed (Just tolerance) (Just tolerance) defaultFloodFillOperationFlags
        rectangle sailboatEvening_768x512 rect blue 2 LineType_8 0
        frozenSailboatEvening_768x512 <- freeze sailboatEvening_768x512
        matCopyToM imgM (V2 0 0) sailboat_768x512 Nothing
        matCopyToM imgM (V2 w 0) frozenSailboatEvening_768x512 Nothing
        lift $ arrowedLine imgM (V2 startX midY) (V2 pointX midY) red 4 LineType_8 0 0.15
    where
      h, w :: Int32
      h = fromInteger $ natVal (Proxy :: Proxy height)
      w = fromInteger $ natVal (Proxy :: Proxy width)
  
      startX, pointX :: Int32
      startX = round $ fromIntegral w * (0.95 :: Double)
      pointX = round $ fromIntegral w * (1.05 :: Double)
  
      midY = h \`div\` 2
  
      seedPoint :: V2 Int32
      seedPoint = V2 100 50
  
      eveningRed :: V4 Double
      eveningRed = V4 0 100 200 255
  
      tolerance :: V4 Double
      tolerance = pure 7
  @
  
  <<doc/generated/examples/floodFillImg.png floodFillImg>>
  
  <http://goo.gl/9XIIne OpenCV Sphinx Doc>
  -}
  floodFill
      :: ( PrimMonad m
         , channels `In` '[ 'S 1, 'S 3 ]
         , depth `In` '[ 'D, 'S Word8, 'S Float, 'S Double ]
         , IsPoint2 point2 Int32
         , ToScalar color
         )
      => Mut (Mat shape channels depth) (PrimState m)
          -- ^ Input/output 1- or 3-channel, 8-bit, or floating-point image. It is modified by the function unless the FLOODFILL_MASK_ONLY flag is set.
      -> Maybe (Mut (Mat (WidthAndHeightPlusTwo shape) ('S 1) ('S Word8)) (PrimState m))
          -- ^ Operation mask that should be a single-channel 8-bit image, 2 pixels wider and 2 pixels taller than image. Since this is both an input and output parameter, you must take responsibility of initializing it. Flood-filling cannot go across non-zero pixels in the input mask. For example, an edge detector output can be used as a mask to stop filling at edges. On output, pixels in the mask corresponding to filled pixels in the image are set to 1 or to the a value specified in flags as described below. It is therefore possible to use the same mask in multiple calls to the function to make sure the filled areas do not overlap.
          -- Note: Since the mask is larger than the filled image, a pixel  (x, y) in image corresponds to the pixel  (x+1, y+1) in the mask.
      -> point2 Int32
          -- ^ Starting point.
      -> color
          -- ^ New value of the repainted domain pixels.
      -> Maybe color
          -- ^ Maximal lower brightness/color difference between the currently observed pixel and one of its neighbors belonging to the component, or a seed pixel being added to the component. Zero by default.
      -> Maybe color
          -- ^ Maximal upper brightness/color difference between the currently observed pixel and one of its neighbors belonging to the component, or a seed pixel being added to the component. Zero by default.
      -> FloodFillOperationFlags
      -> m Rect2i
  floodFill img mbMask seedPoint color mLoDiff mUpDiff opFlags =
      unsafePrimToPrim $
      withPtr img $ \matPtr ->
      withPtr mbMask $ \maskPtr ->
      withPtr (toPoint seedPoint) $ \seedPointPtr ->
      withPtr (toScalar color) $ \colorPtr ->
      withPtr loDiff $ \loDiffPtr ->
      withPtr upDiff $ \upDiffPtr ->
      withPtr rect $ \rectPtr -> do
        [C.block|void {
          cv::Mat * maskPtr = $(Mat * maskPtr);
          cv::floodFill( *$(Mat * matPtr)
                       , maskPtr ? cv::_InputOutputArray(*maskPtr) : cv::_InputOutputArray(noArray())
                       , *$(Point2i * seedPointPtr)
                       , *$(Scalar * colorPtr)
                       , $(Rect2i * rectPtr)
                       , *$(Scalar * loDiffPtr)
                       , *$(Scalar * upDiffPtr)
                       , $(int32_t c'opFlags)
                       );
        }|]
        pure rect
    where
      rect :: Rect2i
      rect = toRect HRect{ hRectTopLeft = pure 0
                         , hRectSize    = pure 0
                         }
      c'opFlags = marshalFloodFillOperationFlags opFlags
      zeroScalar = toScalar (pure 0 :: V4 Double)
      loDiff = maybe zeroScalar toScalar mLoDiff
      upDiff = maybe zeroScalar toScalar mUpDiff
  
  data FloodFillOperationFlags
     = FloodFillOperationFlags
     { floodFillConnectivity :: Word8
        -- ^ Connectivity value. The default value of 4 means that only the four nearest neighbor pixels (those that share
        -- an edge) are considered. A connectivity value of 8 means that the eight nearest neighbor pixels (those that share
        -- a corner) will be considered.
     , floodFillMaskFillColor :: Word8
        -- ^ Value between 1 and 255 with which to fill the mask (the default value is 1).
     , floodFillFixedRange :: Bool
        -- ^ If set, the difference between the current pixel and seed pixel is considered. Otherwise, the difference
        -- between neighbor pixels is considered (that is, the range is floating).
     , floodFillMaskOnly :: Bool
        -- ^ If set, the function does not change the image ( newVal is ignored), and only fills the mask with the
        -- value specified in bits 8-16 of flags as described above. This option only make sense in function variants
        -- that have the mask parameter.
     }
  
  defaultFloodFillOperationFlags :: FloodFillOperationFlags
  defaultFloodFillOperationFlags =
      FloodFillOperationFlags
      { floodFillConnectivity = 4
      , floodFillMaskFillColor = 1
      , floodFillFixedRange = False
      , floodFillMaskOnly = False
      }
  
  marshalFloodFillOperationFlags :: FloodFillOperationFlags -> Int32
  marshalFloodFillOperationFlags opFlags =
      let connectivityBits = fromIntegral (floodFillConnectivity opFlags)
          maskFillColorBits = fromIntegral (floodFillMaskFillColor opFlags) `shiftL` 8
          fixedRangeBits = if floodFillFixedRange opFlags then c'FLOODFILL_FIXED_RANGE else 0
          fillMaskOnlyBits = if floodFillMaskOnly opFlags then c'FLOODFILL_MASK_ONLY else 0
      in connectivityBits .|. maskFillColorBits .|. fixedRangeBits .|. fillMaskOnlyBits
  
  -- TODO (RvD): Otsu and triangle are only implemented for 8 bit images.
  
  {- | Applies a fixed-level threshold to each array element
  
  The function applies fixed-level thresholding to a single-channel array. The
  function is typically used to get a bi-level (binary) image out of a
  grayscale image or for removing a noise, that is, filtering out pixels with
  too small or too large values. There are several types of thresholding
  supported by the function.
  
  Example:
  
  @
  grayBirds :: Mat (ShapeT [341, 512]) ('S 1) ('S Word8)
  grayBirds = exceptError $ cvtColor bgr gray birds_512x341
  
  threshBinaryBirds :: Mat (ShapeT [341, 512]) ('S 3) ('S Word8)
  threshBinaryBirds =
      exceptError $ cvtColor gray bgr $ fst $ exceptError $
      threshold (ThreshVal_Abs 100) (Thresh_Binary 150) grayBirds
  
  threshBinaryInvBirds :: Mat (ShapeT [341, 512]) ('S 3) ('S Word8)
  threshBinaryInvBirds =
      exceptError $ cvtColor gray bgr $ fst $ exceptError $
      threshold (ThreshVal_Abs 100) (Thresh_BinaryInv 150) grayBirds
  
  threshTruncateBirds :: Mat (ShapeT [341, 512]) ('S 3) ('S Word8)
  threshTruncateBirds =
      exceptError $ cvtColor gray bgr $ fst $ exceptError $
      threshold (ThreshVal_Abs 100) Thresh_Truncate grayBirds
  
  threshToZeroBirds :: Mat (ShapeT [341, 512]) ('S 3) ('S Word8)
  threshToZeroBirds =
      exceptError $ cvtColor gray bgr $ fst $ exceptError $
      threshold (ThreshVal_Abs 100) Thresh_ToZero grayBirds
  
  threshToZeroInvBirds :: Mat (ShapeT [341, 512]) ('S 3) ('S Word8)
  threshToZeroInvBirds =
      exceptError $ cvtColor gray bgr $ fst $ exceptError $
      threshold (ThreshVal_Abs 100) Thresh_ToZeroInv grayBirds
  @
  
  <<doc/generated/examples/threshBinaryBirds.png threshBinaryBirds>>
  <<doc/generated/examples/threshBinaryInvBirds.png threshBinaryInvBirds>>
  <<doc/generated/examples/threshTruncateBirds.png threshTruncateBirds>>
  <<doc/generated/examples/threshToZeroBirds.png threshToZeroBirds>>
  <<doc/generated/examples/threshToZeroInvBirds.png threshToZeroInvBirds>>
  
  <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/miscellaneous_transformations.html#threshold OpenCV Sphinx doc>
  -}
  threshold
      :: (depth `In` [Word8, Float], MonadError CvException m)
      => ThreshValue -- ^
      -> ThreshType
      -> (Mat shape ('S 1) ('S depth))
      -> m (Mat shape ('S 1) ('S depth), Double)
  threshold threshVal threshType src = unsafeWrapException $ do
      dst <- newEmptyMat
      alloca $ \calcThreshPtr ->
        handleCvException ((unsafeCoerceMat dst, ) . realToFrac <$> peek calcThreshPtr) $
        withPtr src $ \srcPtr ->
        withPtr dst $ \dstPtr ->
          [cvExcept|
            *$(double * calcThreshPtr) =
              cv::threshold( *$(Mat * srcPtr)
                           , *$(Mat * dstPtr)
                           , $(double c'threshVal)
                           , $(double c'maxVal)
                           , $(int32_t c'type)
                           );
          |]
    where
      c'type = c'threshType .|. c'threshValMode
      (c'threshType, c'maxVal) = marshalThreshType threshType
      (c'threshValMode, c'threshVal) = marshalThreshValue threshVal
  
  
  {- | Performs a marker-based image segmentation using the watershed algorithm.
  
  The function implements one of the variants of watershed, non-parametric marker-based segmentation algorithm, described in [Meyer, F. Color Image Segmentation, ICIP92, 1992].
  
  Before passing the image to the function, you have to roughly outline the desired regions in the image markers with positive (>0) indices. So, every region is represented as one or more connected components with the pixel values 1, 2, 3, and so on. Such markers can be retrieved from a binary mask using 'findContours' and 'drawContours'. The markers are “seeds” of the future image regions. All the other pixels in markers , whose relation to the outlined regions is not known and should be defined by the algorithm, should be set to 0’s. In the function output, each pixel in markers is set to a value of the “seed” components or to -1 at boundaries between the regions.
  
  <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/miscellaneous_transformations.html#watershed OpenCV Sphinx doc>
  -}
  watershed
    :: (PrimMonad m, MonadError CvException m)
    => Mat ('S [h, w]) ('S 3) ('S Word8) -- ^ Input 8-bit 3-channel image
    -> Mut (Mat ('S [h, w]) ('S 1) ('S Int32)) (PrimState m) -- ^ Input/output 32-bit single-channel image (map) of markers
    -> m ()
  watershed img markers =
      unsafePrimToPrim $
      withPtr img $ \imgPtr ->
      withPtr markers $ \markersPtr ->
        [C.exp|void {
          cv::watershed( *$(Mat * imgPtr)
                       , *$(Mat * markersPtr)
                       )
        }|]
  
  {- | Runs the <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/miscellaneous_transformations.html#grabcut GrabCut> algorithm.
  
  Example:
  
  @
  grabCutBird :: Kodak_512x341
  grabCutBird = exceptError $ do
      mask <- withMatM (Proxy :: Proxy [341, 512])
                       (Proxy :: Proxy 1)
                       (Proxy :: Proxy Word8)
                       black $ \\mask -> do
        fgTmp <- mkMatM (Proxy :: Proxy [1, 65]) (Proxy :: Proxy 1) (Proxy :: Proxy Double) black
        bgTmp <- mkMatM (Proxy :: Proxy [1, 65]) (Proxy :: Proxy 1) (Proxy :: Proxy Double) black
        grabCut birds_512x341 mask fgTmp bgTmp 5 (GrabCut_InitWithRect rect)
      mask' <- matScalarCompare mask 3 Cmp_Ge
      withMatM (Proxy :: Proxy [341, 512])
               (Proxy :: Proxy 3)
               (Proxy :: Proxy Word8)
               transparent $ \\imgM -> do
        matCopyToM imgM (V2 0 0) birds_512x341 (Just mask')
    where
      rect :: Rect Int32
      rect = toRect $ HRect { hRectTopLeft = V2 264 60, hRectSize = V2 248 281 }
  @
  
  <<doc/generated/examples/grabCutBird.png grabCutBird>>
  
  -}
  grabCut
      :: ( PrimMonad m
         , MonadError CvException m
         , depth `In` '[ 'D, 'S Word8 ]
         )
      => Mat shape ('S 3) depth
          -- ^ Input 8-bit 3-channel image.
      -> Mut (Mat shape ('S 1) ('S Word8)) (PrimState m)
          -- ^ Input/output 8-bit single-channel mask. The mask is initialized by the function when mode is set to GC_INIT_WITH_RECT. Its elements may have one of following values:
          --
          --     * GC_BGD defines an obvious background pixels.
          --
          --     * GC_FGD defines an obvious foreground (object) pixel.
          --
          --     * GC_PR_BGD defines a possible background pixel.
          --
          --     * GC_PR_FGD defines a possible foreground pixel.
      -> Mut (Mat ('S ['S 1, 'S 65]) ('S 1) ('S Double)) (PrimState m)
          -- ^ Temporary array for the background model. Do not modify it while you are processing the same image.
      -> Mut (Mat ('S ['S 1, 'S 65]) ('S 1) ('S Double)) (PrimState m)
          -- ^ Temporary arrays for the foreground model. Do not modify it while you are processing the same image.
      -> Int32
          -- ^ Number of iterations the algorithm should make before returning the result. Note that the result can be refined with further calls with mode==GC_INIT_WITH_MASK or mode==GC_EVAL.
      -> GrabCutOperationMode
          -- ^ Operation mode
      -> m ()
  grabCut img mask bgdModel fgdModel iterCount mode =
      unsafePrimToPrim $
      withPtr img $ \imgPtr ->
      withPtr mask $ \maskPtr ->
      withPtr rect $ \rectPtr ->
      withPtr bgdModel $ \bgdModelPtr ->
      withPtr fgdModel $ \fgdModelPtr ->
        [C.block|void {
          cv::grabCut( *$(Mat * imgPtr)
                     , *$(Mat * maskPtr)
                     , *$(Rect2i * rectPtr)
                     , *$(Mat * bgdModelPtr)
                     , *$(Mat * fgdModelPtr)
                     , $(int32_t iterCount)
                     , $(int32_t c'modeFlags)
                     );
        }|]
    where
      rect = marshalGrabCutOperationModeRect mode
      c'modeFlags = marshalGrabCutOperationMode mode
  
  {- | Returns 0 if the pixels are not in the range, 255 otherwise. -}
  inRange ::
       (ToScalar scalar, MonadError CvException m)
    => Mat ('S [w, h]) channels depth
    -> scalar -- ^ Lower bound
    -> scalar -- ^ Upper bound
    -> m (Mat ('S [w, h]) ('S 1) ('S Word8))
  inRange src lo hi = unsafeWrapException $ do
    dst <- newEmptyMat
    withPtr src $ \srcPtr ->
      handleCvException (return (unsafeCoerceMat dst)) $
      withPtr (toScalar lo) $ \loPtr ->
      withPtr (toScalar hi) $ \hiPtr ->
      withPtr dst $ \dstPtr ->
        [cvExcept|
          cv::inRange(*$(Mat * srcPtr), *$(Scalar * loPtr), *$(Scalar * hiPtr), *$(Mat * dstPtr));
        |]
  