module AI.CV.OpenCV.CxCore where
import Foreign.ForeignPtrWrap
import Foreign.C.Types
import Foreign.C.String
import Foreign
import Data.VectorSpace as VectorSpace
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))
alignment _ = alignment (undefined :: CInt)
peek ptr = do
w <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
h <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
return (CvSize w h)
poke ptr (CvSize w h) = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr w
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr h
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
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))
alignment _ = alignment (undefined :: CInt)
peek ptr = do
x <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
y <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
w <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
h <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
return (CvRect x y w h)
poke ptr (CvRect x y w h) = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr x
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr y
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr w
((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr h
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
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
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
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
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 ()
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 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'
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
foreign import ccall unsafe "HOpenCV_warp.h debug_print_image_header"
c_debug_print_image_header :: Ptr IplImage -> IO ()