{-# LINE 1 "src/AI/CV/OpenCV/CxCore.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, TypeFamilies #-}
{-# LINE 2 "src/AI/CV/OpenCV/CxCore.hsc" #-}

module AI.CV.OpenCV.CxCore where

import Foreign.ForeignPtrWrap
import Foreign.C.Types
import Foreign.C.String
import Foreign

import Data.VectorSpace as VectorSpace


{-# LINE 13 "src/AI/CV/OpenCV/CxCore.hsc" #-}

------------------------------------------------------
toFromIntegral :: (RealFrac c, Integral b, Integral a, Num b1) => (b1 -> c) -> a -> b
toFromIntegral f = round . f . fromIntegral

toFromIntegral2 :: (Integral a, Num b, Integral a1, Num b1, RealFrac a2, Integral b2) => (b -> b1 -> a2) -> a -> a1 -> b2
toFromIntegral2 f x y = round (f (fromIntegral x) (fromIntegral y))
------------------------------------------------------

data CvSize  = CvSize { sizeWidth :: CInt, sizeHeight :: CInt }
               deriving (Show, Eq)
instance Storable CvSize where
    sizeOf    _ = ((8))
{-# LINE 26 "src/AI/CV/OpenCV/CxCore.hsc" #-}
    alignment _ = alignment (undefined :: CInt)
    peek ptr = do
        w <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 29 "src/AI/CV/OpenCV/CxCore.hsc" #-}
        h <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 30 "src/AI/CV/OpenCV/CxCore.hsc" #-}
        return  (CvSize w h)
    poke ptr (CvSize w h) = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr w
{-# LINE 33 "src/AI/CV/OpenCV/CxCore.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr h
{-# LINE 34 "src/AI/CV/OpenCV/CxCore.hsc" #-}

liftCvSize ::(RealFrac c, Num b) => (b -> c) -> CvSize -> CvSize
liftCvSize f (CvSize w h) = CvSize (f' w) (f' h)
    where f' = toFromIntegral f

liftCvSize2 :: (Num b, Num b1, RealFrac a) => (b -> b1 -> a) -> CvSize -> CvSize -> CvSize
liftCvSize2 f (CvSize w1 h1) (CvSize w2 h2) = CvSize (f' w1 w2) (f' h1 h2)
    where f' = toFromIntegral2 f

instance AdditiveGroup CvSize where
  zeroV = CvSize 0 0
  (^+^) = liftCvSize2 (+)
  negateV = liftCvSize (0-)

instance VectorSpace CvSize where
  type Scalar CvSize = Double -- todo: use CInt instead of Double here?
  a *^ s = liftCvSize (a*) s


data CvRect  = CvRect { rectX :: CInt, rectY :: CInt, rectWidth :: CInt, rectHeight :: CInt }
               deriving (Show, Eq)
                        
instance Storable CvRect where
    sizeOf    _ = ((16))
{-# LINE 58 "src/AI/CV/OpenCV/CxCore.hsc" #-}
    alignment _ = alignment (undefined :: CInt)
    peek ptr = do
        x <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 61 "src/AI/CV/OpenCV/CxCore.hsc" #-}
        y <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 62 "src/AI/CV/OpenCV/CxCore.hsc" #-}
        w <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 63 "src/AI/CV/OpenCV/CxCore.hsc" #-}
        h <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
{-# LINE 64 "src/AI/CV/OpenCV/CxCore.hsc" #-}
        return  (CvRect x y w h)
    poke ptr (CvRect x y w h) = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr x
{-# LINE 67 "src/AI/CV/OpenCV/CxCore.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr y
{-# LINE 68 "src/AI/CV/OpenCV/CxCore.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr w
{-# LINE 69 "src/AI/CV/OpenCV/CxCore.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr h
{-# LINE 70 "src/AI/CV/OpenCV/CxCore.hsc" #-}
        

liftCvRect :: (RealFrac c, Num b) => (b -> c) -> CvRect -> CvRect
liftCvRect f (CvRect x y w h) = CvRect (f' x) (f' y) (f' w) (f' h)
    where f' = toFromIntegral f

liftCvRect2 :: (Num b, Num b1, RealFrac a) => (b -> b1 -> a) -> CvRect -> CvRect -> CvRect
liftCvRect2 f (CvRect x1 y1 w1 h1) (CvRect x2 y2 w2 h2) = CvRect (f' x1 x2) (f' y1 y2) (f' w1 w2) (f' h1 h2)
    where f' = toFromIntegral2 f

instance AdditiveGroup CvRect where
  zeroV = CvRect 0 0 0 0
  (^+^) = liftCvRect2 (+)
  negateV = liftCvRect (0-)

instance VectorSpace CvRect where
  type Scalar CvRect = Double -- todo: use CInt instead of Double here?
  a *^ r = liftCvRect (a*) r
  


------------------------------------------------------
class IplArrayType a

data CvArr
instance IplArrayType CvArr

data IplImage
instance IplArrayType IplImage

data CvMemStorage

data CvSeq a

fromArr :: IplArrayType a => Ptr a -> Ptr CvArr
fromArr = castPtr 

newtype Depth = Depth { unDepth :: CInt } 
    deriving (Eq, Show)
             
iplDepth1u  :: Depth
iplDepth1u  = Depth 1
iplDepth8u  :: Depth
iplDepth8u  = Depth 8
iplDepth8s  :: Depth
iplDepth8s  = Depth 2147483656
iplDepth16u  :: Depth
iplDepth16u  = Depth 16
iplDepth16s  :: Depth
iplDepth16s  = Depth 2147483664
iplDepth32s  :: Depth
iplDepth32s  = Depth 2147483680
iplDepth32f  :: Depth
iplDepth32f  = Depth 32
iplDepth64f  :: Depth
iplDepth64f  = Depth 64
               
{-# LINE 120 "src/AI/CV/OpenCV/CxCore.hsc" #-}

validDepths :: [Depth]
validDepths = [iplDepth1u, iplDepth8u, iplDepth8s, iplDepth16u, iplDepth16s, iplDepth32s, iplDepth32f, iplDepth64f]

depthsLookupList :: [(CInt, Depth)]
depthsLookupList = map (\d -> (unDepth d, d)) validDepths

numToDepth :: CInt -> Maybe Depth
numToDepth x = lookup x depthsLookupList
  

---------------------------------------------------------------
-- mem storage
foreign import ccall unsafe "cxcore.h cvCreateMemStorage"
  c_cvCreateMemStorage :: CInt -> IO (Ptr CvMemStorage)

cvCreateMemStorage :: CInt -> IO (Ptr CvMemStorage)
cvCreateMemStorage = errorName "Failed to create mem storage" . checkPtr . c_cvCreateMemStorage 

foreign import ccall unsafe "HOpenCV_warp.h release_mem_storage"
  cvReleaseMemStorage :: Ptr CvMemStorage -> IO ()

foreign import ccall unsafe "HOpenCV_warp.h &release_mem_storage"
  cp_release_mem_storage :: FunPtr (Ptr CvMemStorage -> IO ())

createMemStorageF :: CInt -> IO (ForeignPtr CvMemStorage)
createMemStorageF = (createForeignPtr cp_release_mem_storage) . cvCreateMemStorage
  

-- images / matrices / arrays

foreign import ccall unsafe "HOpenCV_warp.h create_image"
  c_cvCreateImage :: CInt -> CInt -> CInt -> CInt -> IO (Ptr IplImage)

cvCreateImage :: CvSize -> CInt -> Depth -> IO (Ptr IplImage)
cvCreateImage size numChans depth = errorName "Failed to create image" . checkPtr $ c_cvCreateImage (sizeWidth size) (sizeHeight size) (unDepth depth) numChans

foreign import ccall unsafe "HOpenCV_warp.h release_image"
  cvReleaseImage :: Ptr IplImage -> IO ()

foreign import ccall unsafe "HOpenCV_warp.h &release_image"
  cp_release_image :: FunPtr (Ptr IplImage -> IO ())

createImageF :: CvSize -> CInt -> Depth -> IO (ForeignPtr IplImage)
createImageF x y z = createForeignPtr cp_release_image $ cvCreateImage x y z

foreign import ccall unsafe "cxcore.h cvCloneImage"
  c_cvCloneImage :: Ptr IplImage -> IO (Ptr IplImage)

cvCloneImage :: Ptr IplImage -> IO (Ptr IplImage)
cvCloneImage = errorName "Failed to clone image" . checkPtr . c_cvCloneImage
                  
cloneImageF :: Ptr IplImage -> IO (ForeignPtr IplImage)
cloneImageF x = createForeignPtr cp_release_image $ cvCloneImage x
  
foreign import ccall unsafe "HOpenCV_warp.h get_size"
  c_get_size :: Ptr CvArr -> Ptr CvSize -> IO ()

foreign import ccall unsafe "cxcore.h cvCopy"
  c_cvCopy :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO ()
                   
-- todo add mask support
cvCopy :: IplArrayType a => Ptr a -> Ptr a -> IO ()
cvCopy src dst = c_cvCopy (fromArr src) (fromArr dst) nullPtr

cvGetSize :: IplArrayType a => Ptr a -> CvSize
cvGetSize p = unsafePerformIO $
              alloca $ \cvSizePtr -> do
                c_get_size (castPtr p) cvSizePtr
                size <- peek cvSizePtr
                return size

foreign import ccall unsafe "HOpenCV_warp.h get_depth"
  c_get_depth :: Ptr IplImage -> IO CInt

getDepth :: Ptr IplImage -> IO Depth
getDepth img = do
  depthInt <- c_get_depth img
  case numToDepth depthInt of
    Nothing -> fail "Bad depth in image struct"
    Just depth -> return depth

foreign import ccall unsafe "HOpenCV_warp.h get_nChannels"
  c_get_nChannels :: Ptr IplImage -> IO CInt

getNumChannels :: Integral a => Ptr IplImage -> IO a
getNumChannels img = fmap fromIntegral $ c_get_nChannels img


foreign import ccall unsafe "cxcore.h cvConvertScale"
  cvConvertScale :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> IO ()

                                
foreign import ccall unsafe "HOpenCV_warp.h cv_free"
  cvFree :: Ptr a -> IO ()
            
foreign import ccall unsafe "cxcore.h cvLoad"
  c_cvLoad :: CString -> Ptr CvMemStorage -> CString -> Ptr CString -> IO (Ptr a)

cvLoad :: String -> Ptr CvMemStorage -> Maybe String -> IO (Ptr a, Maybe String)
cvLoad filename memstorage name = withCString filename cvLoad'
    where cvLoad' filenameC = do
            case name of
              Nothing -> cvLoad'' filenameC nullPtr
              Just n' -> withCString n' $ cvLoad'' filenameC
          cvLoad'' filenameC nameC = alloca $ \ptrRealNameC -> do
              ptrObj <- errorName "cvLoad failed" . checkPtr $ c_cvLoad filenameC memstorage nameC ptrRealNameC
              realNameC <- peek ptrRealNameC
              realName <- if realNameC == nullPtr 
                          then return Nothing 
                          else fmap Just $ peekCString realNameC
              cvFree realNameC
              return (ptrObj, realName)
              
foreign import ccall unsafe "cxcore.h cvGetSeqElem"
  cvGetSeqElem :: Ptr (CvSeq a) -> CInt -> IO (Ptr a)
  
-- foreign import ccall unsafe "HOpenCV_warp.h c_rect_cvGetSeqElem"
--   cvGetSeqElemRect :: Ptr (CvSeq (Ptr CvRect)) -> CInt -> IO (Ptr CvRect)

foreign import ccall unsafe "HOpenCV_warp.h seq_total"
  seqNumElems :: Ptr (CvSeq a) -> IO CInt

seqToPList :: Ptr (CvSeq a) -> IO [Ptr a]
seqToPList pseq = do
  numElems <- seqNumElems pseq
  mapM (cvGetSeqElem pseq) [1..(numElems)]

seqToList :: Storable a => Ptr (CvSeq a) -> IO [a]
seqToList pseq = do
  numElems <- seqNumElems pseq
  flip mapM [1..(numElems)] $ \i -> do
    elemP <- cvGetSeqElem pseq i
    elem' <- peek elemP
    return elem'

-- seqToRectList :: Ptr (CvSeq (Ptr CvRect)) -> IO [CvRect]
-- seqToRectList pseq = do
--   numElems <- seqNumElems pseq
--   flip mapM [1..(numElems)] $ \i -> do
--     rectP <- cvGetSeqElemRect pseq i
--     rect <- peek rectP
--     return rect

foreign import ccall unsafe "HOpenCV_warp.h c_cvRectangle"
  c_cvRectangle :: Ptr CvArr -> CInt -> CInt -> CInt -> CInt -> IO ()

cvRectangle :: IplArrayType a => Ptr a -> CvRect -> IO ()
cvRectangle dst (CvRect x y w h) = c_cvRectangle (fromArr dst) x y w h

------------------------------------------------------------------------------
-- Debugging stuff, not part of opencv

-- | Debugging function to print some of the internal details of an IplImage structure
foreign import ccall unsafe "HOpenCV_warp.h debug_print_image_header"
  c_debug_print_image_header :: Ptr IplImage -> IO ()