-- GENERATED by C->Haskell Compiler, version 0.16.3 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./CV/Morphology.chs" #-}{-#LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, UnicodeSyntax, ViewPatterns#-}
module CV.Morphology (StructuringElement
                  ,structuringElement
                  ,customSE
                  ,basicSE,bigSE
                  ,geodesic
                  ,openOp,closeOp
                  ,open,close
                  ,erode,dilate
                  ,blackTopHat,whiteTopHat
                  ,dilateOp,erodeOp,KernelShape(EllipseShape,CrossShape,RectShape) 
                  )
where

import Foreign.C.Types
import Foreign.C.String
import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Marshal.Array

import CV.Image 

import CV.ImageOp
import qualified CV.ImageMath as IM

import System.IO.Unsafe

-- Morphological opening
openOp :: StructuringElement -> ImageOperation GrayScale D32
openOp se = erodeOp se 1 #> dilateOp se 1                    
open se = unsafeOperate (openOp se) 
a ○ b = open b a
-- a ○ b = (a ⊖ b) ⊕ b 


-- Morphological closing
closeOp :: StructuringElement -> ImageOperation GrayScale D32
closeOp se = dilateOp se 1 #> erodeOp se 1                    
close se = unsafeOperate (closeOp se) 
a ● b = close b a

geodesic :: Image GrayScale D32 -> ImageOperation GrayScale D32 -> ImageOperation GrayScale D32
geodesic mask op = op #> IM.limitToOp mask

-- | Perform a black tophat filtering of size
blackTopHat size i =
                  let se = structuringElement 
                        (size,size) (size `div` 2, size `div` 2) RectShape
                      x  = unsafeOperate (closeOp se) i
                  in x `IM.sub` i

-- | Perform a white tophat filtering of size
whiteTopHat size i =
                  let se = structuringElement 
                        (size,size) (size `div` 2, size `div` 2) RectShape
                      x  = unsafeOperate (openOp se) i
                  in i `IM.sub` x

basicSE = structuringElement (3,3) (1,1) RectShape
bigSE = structuringElement (9,9) (4,4) RectShape

---------- Low level wrapper
data KernelShape = RectShape
                 | CrossShape
                 | EllipseShape
                 | CustomShape
                 
instance Enum KernelShape where
  fromEnum RectShape = 0
  fromEnum CrossShape = 1
  fromEnum EllipseShape = 2
  fromEnum CustomShape = 100

  toEnum 0 = RectShape
  toEnum 1 = CrossShape
  toEnum 2 = EllipseShape
  toEnum 100 = CustomShape
  toEnum unmatched = error ("KernelShape.toEnum: Cannot match " ++ show unmatched)

{-# LINE 72 "./CV/Morphology.chs" #-}

newtype ConvKernel = ConvKernel (ForeignPtr (ConvKernel))
withConvKernel (ConvKernel fptr) = withForeignPtr fptr
{-# LINE 74 "./CV/Morphology.chs" #-}

type StructuringElement = ConvKernel

foreign import ccall "& wrapReleaseStructuringElement" 
    releaseSE :: FinalizerPtr ConvKernel


-- Check morphology element
isGoodSE s@(w,h) d@(x,y) | x>=0 && y>=0 
                         && w>=0 && h>=0
                         && x<w  && y<h 
                         = True

                         | otherwise = False 


-- Create a structuring element for morphological operations
structuringElement s d | isGoodSE s d = createSE s d 
                       | otherwise = error "Bad values in structuring element"

-- Create SE with custom shape that is taken from flat list shape.
createSE (w,h) (x,y) shape = unsafePerformIO $ do
    iptr <- cvCreateStructuringElementEx
{-# LINE 97 "./CV/Morphology.chs" #-}
             w h x y (fromIntegral . fromEnum $ shape) nullPtr
    fptr <- newForeignPtr releaseSE iptr
    return (ConvKernel fptr)

customSE s@(w,h) o shape | isGoodSE s o 
                         && length shape == fromIntegral (w*h)
                            = createCustomSE s o shape

createCustomSE (w,h) (x,y) shape = unsafePerformIO $ do
            iptr <- withArray shape $ \arr ->
                    cvCreateStructuringElementEx
{-# LINE 108 "./CV/Morphology.chs" #-}
                      w h x y (fromIntegral . fromEnum $ CustomShape) arr
            fptr <- newForeignPtr releaseSE iptr
            return (ConvKernel fptr)

erosion :: BareImage -> BareImage -> ConvKernel -> Int -> IO ()
erosion a1 a2 a3 a4 =
  withGenBareImage a1 $ \a1' -> 
  withGenBareImage a2 $ \a2' -> 
  withConvKernel a3 $ \a3' -> 
  let {a4' = fromIntegral a4} in 
  erosion'_ a1' a2' a3' a4' >>= \res ->
  return ()
{-# LINE 117 "./CV/Morphology.chs" #-}
dilation :: BareImage -> BareImage -> ConvKernel -> Int -> IO ()
dilation a1 a2 a3 a4 =
  withGenBareImage a1 $ \a1' -> 
  withGenBareImage a2 $ \a2' -> 
  withConvKernel a3 $ \a3' -> 
  let {a4' = fromIntegral a4} in 
  dilation'_ a1' a2' a3' a4' >>= \res ->
  return ()
{-# LINE 122 "./CV/Morphology.chs" #-}


erodeOp se count = ImgOp $ \(unS -> img)  -> erosion img img se count
dilateOp se count = ImgOp $ \(unS -> img) -> dilation img img se count

erode se count  i = unsafeOperate (erodeOp se count)  i
dilate se count i = unsafeOperate (dilateOp se count) i

a ⊕ b = dilate b 1 a
a ⊖ b = erode b 1 a
                       
erode' se count img = withImage img $ \image ->
               withConvKernel se $ \ck ->
             cvErode (castPtr image) 
                              (castPtr image) 
                              ck count
                              
dilate' se count img = withImage img $ \image ->
               withConvKernel se $ \ck ->
             cvDilate (castPtr image) 
                              (castPtr image) 
                              ck count

foreign import ccall safe "CV/Morphology.chs.h cvCreateStructuringElementEx"
  cvCreateStructuringElementEx :: (CInt -> (CInt -> (CInt -> (CInt -> (CInt -> ((Ptr CInt) -> (IO (Ptr (ConvKernel)))))))))

foreign import ccall safe "CV/Morphology.chs.h cvErode"
  erosion'_ :: ((Ptr ()) -> ((Ptr ()) -> ((Ptr (ConvKernel)) -> (CInt -> (IO ())))))

foreign import ccall safe "CV/Morphology.chs.h cvDilate"
  dilation'_ :: ((Ptr ()) -> ((Ptr ()) -> ((Ptr (ConvKernel)) -> (CInt -> (IO ())))))

foreign import ccall safe "CV/Morphology.chs.h cvErode"
  cvErode :: ((Ptr ()) -> ((Ptr ()) -> ((Ptr (ConvKernel)) -> (CInt -> (IO ())))))

foreign import ccall safe "CV/Morphology.chs.h cvDilate"
  cvDilate :: ((Ptr ()) -> ((Ptr ()) -> ((Ptr (ConvKernel)) -> (CInt -> (IO ())))))