freenect 1.0.2 → 1.1.1
raw patch · 5 files changed
+128/−61 lines, 5 files
Files
- cbits/freenect-helpers.c +27/−1
- freenect.cabal +1/−12
- src/Freenect.hs +70/−6
- src/Freenect/FFI.hs +30/−0
- src/Main.hs +0/−42
cbits/freenect-helpers.c view
@@ -20,7 +20,33 @@ }; /*- * Get a frame mode.+ * Get a video frame mode.+ */+freenect_frame_mode* find_video_mode_freenect(uint32_t res,+ uint32_t fmt){+ freenect_frame_mode* mode = malloc(sizeof (*mode));+ *mode = freenect_find_video_mode(res,fmt);+ return mode;+};++/*+ * Set the video mode of a device.+ */+int set_freenect_video_mode(freenect_device* dev,freenect_frame_mode* mode)+{+ return freenect_set_video_mode(dev,*mode);+}; ++/*+ * Get the video resolution of a device.+ */+uint32_t get_freenect_video_resolution(freenect_device* dev){+ freenect_frame_mode mode = freenect_get_current_video_mode(dev);+ return mode.resolution;+}++/*+ * Get a depth frame mode. */ freenect_frame_mode* find_depth_mode_freenect(uint32_t res, uint32_t fmt){
freenect.cabal view
@@ -1,5 +1,5 @@ Name: freenect-Version: 1.0.2+Version: 1.1.1 Synopsis: Interface to the Kinect device. Description: Interface to the Kinect device. Currently supports depth perception. (No video or audio.)@@ -21,17 +21,6 @@ Library Hs-source-dirs: src Exposed-Modules: Freenect Freenect.FFI- Ghc-options: -O2- Build-depends: base > 4 && < 5, vector- Includes: libfreenect.h libfreenect_sync.h- Extra-libraries: freenect, freenect_sync- C-sources: cbits/freenect-helpers.c- Include-dirs: cbits--Executable freenect-haskell-example- Hs-source-dirs: src- Main-is: Main.hs- Other-Modules: Freenect Freenect.FFI Ghc-options: -O2 Build-depends: base > 4 && < 5, vector Includes: libfreenect.h libfreenect_sync.h
src/Freenect.hs view
@@ -30,9 +30,12 @@ ,closeDevice ,withDevice ,setLogLevel+ ,setVideoCallback+ ,startVideo ,setDepthCallback ,startDepth ,setTiltDegrees+ ,setVideoMode ,setDepthMode ,Context ,Device@@ -40,6 +43,7 @@ ,Subdevice(..) ,LogLevel(..) ,Resolution(..)+ ,VideoFormat(..) ,DepthFormat(..)) where @@ -82,10 +86,13 @@ -- device. | ProcessEvents CInt -- ^ Call to process events failed. | OpenDeviceFailed Integer -- ^ Opening a device failed.+ | StartVideoProblem -- ^ Problem starting the video stream. | StartDepthProblem -- ^ Problem starting the depth stream. | UnableToSetTilt -- ^ Unable to set the tilt.+ | SetVideoMode -- ^ Unable to set the video mode.+ | VideoModeNotSet -- ^ TODO, not used: You didn't set the video mode. | SetDepthMode -- ^ Unable to set the depth mode.- | DepthModeNotSet -- ^ You didn't set the depth mode.+ | DepthModeNotSet -- ^ TODO, not used: You didn't set the depth mode. deriving (Show,Typeable) instance Exception FreenectException @@ -227,6 +234,18 @@ ptr <- peek ptr freenect_set_log_level ptr (fromIntegral (fromEnum level)) +-- | Set callback for video information received event.+setVideoCallback :: Device -> (Vector Word8 -> Word32 -> IO ()) -> IO ()+setVideoCallback d callback = flip withD d $ \dptr -> do+ dptr <- peek dptr+ resolution <- get_freenect_video_resolution dptr+ let !size = resolutionToSize (toEnum (fromIntegral resolution))+ callbackPtr <- wrapVideoCallback $ \_ payloadptr timestamp -> do+ fptr <- newForeignPtr_ payloadptr+ let !vector = unsafeFromForeignPtr fptr 0 (size * 3)+ callback vector timestamp+ freenect_set_video_callback dptr callbackPtr+ -- | Set callback for depth information received event. setDepthCallback :: Device -> (Vector Word16 -> Word32 -> IO ()) -> IO () setDepthCallback d callback = flip withD d $ \dptr -> do@@ -245,13 +264,19 @@ resolutionToSize Medium = 640 * 480 resolutionToSize High = 1280 * 1024 +-- | Start the video information stream for a device.+startVideo :: Device -> IO ()+startVideo = withD $ \ptr -> succeed StartVideoProblem (return ()) $ do+ ptr <- peek ptr+ freenect_start_video ptr+ -- | Start the depth information stream for a device. startDepth :: Device -> IO () startDepth = withD $ \ptr -> succeed StartDepthProblem (return ()) $ do ptr <- peek ptr freenect_start_depth ptr --- | Start the depth information stream for a device.+-- | Set the tilt degrees for a device. setTiltDegrees :: Double -> Device -> IO () setTiltDegrees angle = withD $ \ptr -> succeed UnableToSetTilt (return ()) $ do ptr <- peek ptr@@ -260,6 +285,24 @@ data Resolution = Low | Medium | High deriving (Enum,Show,Eq,Ord) +data VideoFormat+ = RGB+ | Bayer+ | EightBitIR+ | TenBitIR+ | TenBitPackedIR+ | YUVRGB+ | YUVRaw+ deriving (Enum,Show,Eq)+ +setVideoMode :: Device -> Resolution -> VideoFormat -> IO ()+setVideoMode d res fmt = flip withD d $ \dptr -> do+ dptr <- peek dptr+ frameMode <- find_video_mode_freenect (fromIntegral (fromEnum res))+ (fromIntegral (fromEnum fmt))+ succeed SetVideoMode (return ()) $+ set_freenect_video_mode dptr frameMode+ data DepthFormat = ElevenBit | TenBit@@ -335,7 +378,28 @@ -- Once that's done, you start the depth stream: -- -- @startDepth device@-+--+-- Likewise, you can grab video frames. Once you have a context, set the+-- video mode you want using+--+-- @setVideoMode device Medium RGB@+--+-- In this example, we set medium resolution (640x480) with raw RGB24 Bytes.+--+-- Next, set the video callback:+--+-- @+-- setVideoCallback device $ \payload timestamp -> do+-- printf \"Payload: %s\n\" (take 100 $ show payload)+-- @+--+-- Note that unlike depth, which comes in as vector of Word16's, video is a+-- vector of Word8's.+--+-- Lastly, start the video stream:+--+-- @startVideo device@+-- -- $events -- -- Finally you need a way to receieve data. You call `processEvents'@@ -346,6 +410,6 @@ -- processEvents context -- @ ----- Calls `processEvents' trigger the depth callback. Continue calling--- it sequentially as much as you want, but not from the depth--- callback itself.+-- Calls `processEvents' to trigger the depth and/or video callback. Continue calling+-- it sequentially as much as you want, but not from within the depth or video+-- callbacks.
src/Freenect/FFI.hs view
@@ -59,12 +59,29 @@ foreign import ccall "wrapper" wrapDepthCallback :: DepthCallback -> IO (FunPtr DepthCallback) +type VideoCallback = Ptr DeviceStruct -> Ptr Word8 -> Word32 -> IO ()+ foreign import ccall+ "freenect.h freenect_set_video_callback"+ freenect_set_video_callback+ :: Ptr DeviceStruct+ -> (FunPtr VideoCallback)+ -> IO ()++foreign import ccall "wrapper" + wrapVideoCallback :: VideoCallback -> IO (FunPtr VideoCallback)++foreign import ccall "freenect.h freenect_start_depth" freenect_start_depth :: Ptr DeviceStruct -> IO CInt foreign import ccall+ "freenect.h freenect_start_video"+ freenect_start_video :: Ptr DeviceStruct+ -> IO CInt++foreign import ccall "freenect.h freenect_set_tilt_degs" freenect_set_tilt_degs :: Ptr DeviceStruct -> CDouble -> IO CInt @@ -80,6 +97,19 @@ new_freenect_device :: IO (Ptr (Ptr DeviceStruct)) data FrameMode++foreign import ccall+ "freenect.h find_video_mode_freenect"+ find_video_mode_freenect :: Word32+ -> Word32+ -> IO (Ptr FrameMode)+foreign import ccall+ "freenect.h set_freenect_video_mode"+ set_freenect_video_mode :: Ptr DeviceStruct -> Ptr FrameMode -> IO CInt+ +foreign import ccall+ "freenect.h get_freenect_video_resolution"+ get_freenect_video_resolution :: Ptr DeviceStruct -> IO CInt foreign import ccall "freenect.h find_depth_mode_freenect"
− src/Main.hs
@@ -1,42 +0,0 @@--- | Freenect examples.--module Main- (main)- where--import Freenect-import Text.Printf-import Control.Monad-import Control.Monad.Fix-import Data.IORef---- | Demos some Freenect use.-main :: IO ()-main =- withContext $ \context -> do- setLogLevel LogDebug context- deviceCount <- countDevices context- printf "Devices: %d\n" deviceCount- selectSubdevices context devices- printf "Selected devices: %s\n" (show devices)- withDevice context index $ \device -> do- printf "Opened device %d.\n" index- done <- newIORef False- setDepthMode device Medium ElevenBit- setDepthCallback device $ \payload timestamp -> do- printf "Payload: %s\n" (take 100 $ show payload)- writeIORef done True- printf "Setted depth callback.\n"- startDepth device- printf "Started depth stream.\n"- printf "Processing…\n"- fix $ \repeat -> do- processEvents context- isDone <- readIORef done- if isDone- then return ()- else repeat- printf "Finished processing events.\n"-- where devices = [Camera]- index = 0 :: Integer