module CV.Video where
import CV.Image
import Foreign.Marshal.Array
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Storable
import Foreign.C.Types
import Foreign.C.String
import System.IO.Unsafe
import Utils.Stream
newtype Capture = Capture (ForeignPtr (Capture))
withCapture (Capture fptr) = withForeignPtr fptr
foreign import ccall "& wrapReleaseCapture" releaseCapture :: FinalizerPtr Capture
newtype VideoWriter = VideoWriter (ForeignPtr (VideoWriter))
withVideoWriter (VideoWriter fptr) = withForeignPtr fptr
foreign import ccall "& wrapReleaseVideoWriter" releaseVideoWriter :: FinalizerPtr VideoWriter
type VideoStream c d = Stream IO (Image c d)
streamFromVideo cap = dropS 1 $ streamFromVideo' (undefined) cap
streamFromVideo' p cap = Value $ do
x <- getFrame cap
case x of
Just f -> return (p,(streamFromVideo' f cap))
Nothing -> return (p,Terminated)
captureFromFile fn = withCString fn $ \cfn -> do
ptr <- cvCreateFileCapture cfn
fptr <- newForeignPtr releaseCapture ptr
return . Capture $ fptr
captureFromCam int = do
ptr <- cvCreateCameraCapture (fromIntegral int)
if ptr==nullPtr
then
return Nothing
else do
fptr <- newForeignPtr releaseCapture ptr
return . Just . Capture $ fptr
dropFrame cap = withCapture cap $ \ccap -> cvGrabFrame ccap >> return ()
getFrame :: Capture -> IO (Maybe (Image RGB D32))
getFrame cap = withCapture cap $\ccap -> do
p_frame <- cvQueryFrame ccap
if p_frame==nullPtr then return Nothing
else creatingImage (ensure32F p_frame) >>= return . Just
data CapProp = CAP_PROP_POS_MSEC
| CAP_PROP_POS_FRAMES
| CAP_PROP_POS_AVI_RATIO
| CAP_PROP_FRAME_WIDTH
| CAP_PROP_FRAME_HEIGHT
| CAP_PROP_FPS
| CAP_PROP_FOURCC
| CAP_PROP_FRAME_COUNT
| CAP_PROP_FORMAT
| CAP_PROP_MODE
| CAP_PROP_BRIGHTNESS
| CAP_PROP_CONTRAST
| CAP_PROP_SATURATION
| CAP_PROP_HUE
| CAP_PROP_GAIN
| CAP_PROP_EXPOSURE
| CAP_PROP_CONVERT_RGB
| CAP_PROP_WHITE_BALANCE_BLUE_U
| CAP_PROP_WHITE_BALANCE_RED_V
| CAP_PROP_RECTIFICATION
| CAP_PROP_MONOCROME
instance Enum CapProp where
fromEnum CAP_PROP_POS_MSEC = 0
fromEnum CAP_PROP_POS_FRAMES = 1
fromEnum CAP_PROP_POS_AVI_RATIO = 2
fromEnum CAP_PROP_FRAME_WIDTH = 3
fromEnum CAP_PROP_FRAME_HEIGHT = 4
fromEnum CAP_PROP_FPS = 5
fromEnum CAP_PROP_FOURCC = 6
fromEnum CAP_PROP_FRAME_COUNT = 7
fromEnum CAP_PROP_FORMAT = 8
fromEnum CAP_PROP_MODE = 9
fromEnum CAP_PROP_BRIGHTNESS = 10
fromEnum CAP_PROP_CONTRAST = 11
fromEnum CAP_PROP_SATURATION = 12
fromEnum CAP_PROP_HUE = 13
fromEnum CAP_PROP_GAIN = 14
fromEnum CAP_PROP_EXPOSURE = 15
fromEnum CAP_PROP_CONVERT_RGB = 16
fromEnum CAP_PROP_WHITE_BALANCE_BLUE_U = 17
fromEnum CAP_PROP_WHITE_BALANCE_RED_V = 26
fromEnum CAP_PROP_RECTIFICATION = 18
fromEnum CAP_PROP_MONOCROME = 19
toEnum 0 = CAP_PROP_POS_MSEC
toEnum 1 = CAP_PROP_POS_FRAMES
toEnum 2 = CAP_PROP_POS_AVI_RATIO
toEnum 3 = CAP_PROP_FRAME_WIDTH
toEnum 4 = CAP_PROP_FRAME_HEIGHT
toEnum 5 = CAP_PROP_FPS
toEnum 6 = CAP_PROP_FOURCC
toEnum 7 = CAP_PROP_FRAME_COUNT
toEnum 8 = CAP_PROP_FORMAT
toEnum 9 = CAP_PROP_MODE
toEnum 10 = CAP_PROP_BRIGHTNESS
toEnum 11 = CAP_PROP_CONTRAST
toEnum 12 = CAP_PROP_SATURATION
toEnum 13 = CAP_PROP_HUE
toEnum 14 = CAP_PROP_GAIN
toEnum 15 = CAP_PROP_EXPOSURE
toEnum 16 = CAP_PROP_CONVERT_RGB
toEnum 17 = CAP_PROP_WHITE_BALANCE_BLUE_U
toEnum 26 = CAP_PROP_WHITE_BALANCE_RED_V
toEnum 18 = CAP_PROP_RECTIFICATION
toEnum 19 = CAP_PROP_MONOCROME
toEnum unmatched = error ("CapProp.toEnum: Cannot match " ++ show unmatched)
fromProp = fromIntegral . fromEnum
getCapProp cap prop = withCapture cap $\ccap ->
cvGetCaptureProperty
ccap (fromProp prop) >>= return . realToFrac
getFrameRate cap = unsafePerformIO $
withCapture cap $\ccap ->
cvGetCaptureProperty
ccap (fromProp CAP_PROP_FPS) >>= return . realToFrac
getFrameSize cap = unsafePerformIO $
withCapture cap $\ccap -> do
w <- cvGetCaptureProperty ccap (fromProp CAP_PROP_FRAME_WIDTH)
>>= return . round
h <- cvGetCaptureProperty ccap (fromProp CAP_PROP_FRAME_HEIGHT)
>>= return . round
return (w,h)
setCapProp cap prop val = withCapture cap $\ccap ->
cvSetCaptureProperty
ccap (fromProp prop) (realToFrac val)
numberOfFrames cap = unsafePerformIO $
withCapture cap $\ccap ->
cvGetCaptureProperty
ccap (fromProp CAP_PROP_FRAME_COUNT)
>>= return . floor
frameNumber cap = unsafePerformIO $
withCapture cap $\ccap ->
cvGetCaptureProperty
ccap (fromProp CAP_PROP_POS_FRAMES) >>= return . floor
data Codec = MPG4 deriving (Eq,Show)
createVideoWriter filename codec framerate frameSize =
withCString filename $ \cfilename -> do
ptr <- wrapCreateVideoWriter cfilename fourcc
framerate w h 0
if ptr == nullPtr then error "Could not create video writer" else return ()
fptr <- newForeignPtr releaseVideoWriter ptr
return . VideoWriter $ fptr
where
(fromIntegral -> w, fromIntegral -> h) = frameSize
fourcc | codec == MPG4 = 0x4d504734
writeFrame :: VideoWriter -> Image RGB D32 -> IO ()
writeFrame writer img = withVideoWriter writer $\cwriter ->
withImage img $ \cimg ->
cvWriteFrame cwriter cimg >> return ()
foreign import ccall safe "CV/Video.chs.h cvCreateFileCapture"
cvCreateFileCapture :: ((Ptr CChar) -> (IO (Ptr (Capture))))
foreign import ccall safe "CV/Video.chs.h cvCreateCameraCapture"
cvCreateCameraCapture :: (CInt -> (IO (Ptr (Capture))))
foreign import ccall safe "CV/Video.chs.h cvGrabFrame"
cvGrabFrame :: ((Ptr (Capture)) -> (IO CInt))
foreign import ccall safe "CV/Video.chs.h cvQueryFrame"
cvQueryFrame :: ((Ptr (Capture)) -> (IO (Ptr (BareImage))))
foreign import ccall safe "CV/Video.chs.h cvGetCaptureProperty"
cvGetCaptureProperty :: ((Ptr (Capture)) -> (CInt -> (IO CDouble)))
foreign import ccall safe "CV/Video.chs.h cvSetCaptureProperty"
cvSetCaptureProperty :: ((Ptr (Capture)) -> (CInt -> (CDouble -> (IO CInt))))
foreign import ccall safe "CV/Video.chs.h wrapCreateVideoWriter"
wrapCreateVideoWriter :: ((Ptr CChar) -> (CInt -> (CDouble -> (CInt -> (CInt -> (CInt -> (IO (Ptr (VideoWriter)))))))))
foreign import ccall safe "CV/Video.chs.h cvWriteFrame"
cvWriteFrame :: ((Ptr (VideoWriter)) -> ((Ptr (BareImage)) -> (IO CInt)))