diff --git a/cbits/freenect-helpers.c b/cbits/freenect-helpers.c --- a/cbits/freenect-helpers.c +++ b/cbits/freenect-helpers.c @@ -70,3 +70,16 @@ freenect_frame_mode mode = freenect_get_current_depth_mode(dev); return mode.resolution; } + + +int process_events_timeout(freenect_context* ctx, int microseconds) +{ + struct timeval timeout; + + timeout.tv_sec = microseconds / 1000000; + timeout.tv_usec = microseconds - timeout.tv_sec * 1000000; + + return freenect_process_events_timeout(ctx, &timeout); + +} + diff --git a/freenect.cabal b/freenect.cabal --- a/freenect.cabal +++ b/freenect.cabal @@ -1,5 +1,5 @@ Name: freenect -Version: 1.2 +Version: 1.2.1 Synopsis: Interface to the Kinect device. Description: Interface to the Kinect device. Currently supports depth perception. (No video or audio.) @@ -27,3 +27,4 @@ Extra-libraries: freenect, freenect_sync C-sources: cbits/freenect-helpers.c Include-dirs: cbits + Pkgconfig-Depends: libfreenect diff --git a/src/Freenect.hs b/src/Freenect.hs --- a/src/Freenect.hs +++ b/src/Freenect.hs @@ -24,6 +24,7 @@ ,countDevices ,withContext ,processEvents + ,processEventsTimeout ,selectSubdevices ,newDevice ,openDevice @@ -32,21 +33,30 @@ ,setLogLevel ,setVideoCallback ,startVideo + ,stopVideo ,setDepthCallback ,startDepth + ,stopDepth ,setTiltDegrees + ,getTiltDegrees + ,getAcceleration ,setLed ,setVideoMode ,setDepthMode + ,setFlag ,Context ,Device ,FreenectException(..) ,Subdevice(..) ,LogLevel(..) ,Led(..) + ,Flag(..) ,Resolution(..) ,VideoFormat(..) - ,DepthFormat(..)) + ,DepthFormat(..) + ,setAudioInCallback + ,startAudio + ,stopAudio) where import Freenect.FFI @@ -89,13 +99,18 @@ | ProcessEvents CInt -- ^ Call to process events failed. | OpenDeviceFailed Integer -- ^ Opening a device failed. | StartVideoProblem -- ^ Problem starting the video stream. + | StopVideoProblem -- ^ Problem stopping the video stream | StartDepthProblem -- ^ Problem starting the depth stream. + | StopDepthProblem -- ^ Problem stopping the depth stream | UnableToSetTilt -- ^ Unable to set the tilt. | UnableToSetLed -- ^ Unable to set active led + | UnableToSetFlag -- ^ Failed to enable a specific device flag | 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 -- ^ TODO, not used: You didn't set the depth mode. + | StartAudioProblem -- ^ Problem starting the audio stream + | StopAudioProblem -- ^ Problem stopping the audio stream deriving (Show,Typeable) instance Exception FreenectException @@ -147,6 +162,22 @@ _ | result < 0 -> throw (ProcessEvents result) | otherwise -> return () + +processEventsTimeout :: Context -> Int -> IO () +processEventsTimeout ctx timeout = flip withC ctx $ \cptr -> do + cptr <- peek cptr + result <- process_events_timeout cptr (fromIntegral timeout) + case result of + -- LIBUSB_ERROR_INTERRUPTED + -- System call interrupted (perhaps due to signal). + -- I think the GHC runtime sends interrupts sometimes, or + -- otherwise signals are coming from somewhere but are they appear + -- to be ignorable. + -10 -> return () + _ | result < 0 -> throw (ProcessEvents result) + | otherwise -> return () + + -- | Run a computation for which the CInt result is zero (in C this is -- success), and thrown an exception if the result is non-zero. succeed :: Exception e => e -> IO () -> IO CInt -> IO () @@ -158,7 +189,7 @@ -- | A sub-device (motor, camera and audio), if supported on the -- platform. -data Subdevice = Motor | Camera | Auto +data Subdevice = Motor | Camera | Audio deriving (Show,Eq) -- | Set which subdevices any subsequent calls to openDevice should @@ -173,7 +204,7 @@ where toDeviceId Motor = 1 toDeviceId Camera = 2 - toDeviceId Auto = 4 + toDeviceId Audio = 4 -- | Create a new device. newDevice :: IO Device @@ -273,18 +304,65 @@ ptr <- peek ptr freenect_start_video ptr +-- | Start the video information stream for a device. +stopVideo :: Device -> IO () +stopVideo = withD $ \ptr -> succeed StopVideoProblem (return ()) $ do + ptr <- peek ptr + freenect_stop_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 +-- | Stop the depth information stream for a device. +stopDepth :: Device -> IO () +stopDepth = withD $ \ptr -> succeed StopDepthProblem (return ()) $ do + ptr <- peek ptr + freenect_stop_depth ptr + + -- | Set the tilt degrees for a device. setTiltDegrees :: Double -> Device -> IO () setTiltDegrees angle = withD $ \ptr -> succeed UnableToSetTilt (return ()) $ do ptr <- peek ptr freenect_set_tilt_degs ptr (realToFrac angle) + +-- | Get the tilt degrees for a device +getTiltDegrees :: Device -> IO Double +getTiltDegrees= withD $ \ptr -> do + ptr <- peek ptr + _ <- freenect_update_tilt_state ptr + tiltstate <- freenect_get_tilt_state ptr + fmap realToFrac (freenect_get_tilt_degs tiltstate) + + +-- | Get the accelaretion for (x, y, z) axes from the internal tilt state +getAcceleration :: Device -> IO (Double, Double, Double) +getAcceleration = withD $ \ptr -> do + ptr <- peek ptr + _ <- freenect_update_tilt_state ptr + tiltstate <- freenect_get_tilt_state ptr + + allocaArray 3 $ \temp -> do + let step = sizeOf (undefined :: CDouble) + + let temp_x = temp :: Ptr CDouble + let temp_y = plusPtr temp step :: Ptr CDouble + let temp_z = plusPtr temp (2 * step) :: Ptr CDouble + + freenect_get_mks_accel tiltstate temp_x temp_y temp_z + + x <- peek temp_x + y <- peek temp_y + z <- peek temp_z + + return (realToFrac x, realToFrac y, realToFrac z) + + + data Resolution = Low | Medium | High deriving (Enum,Show,Eq,Ord) @@ -341,6 +419,74 @@ freenect_set_led ptr (if ledcode == 5 then 6 else ledcode) where ledcode = (fromIntegral (fromEnum led)) + + + +data Flag + = AutoExposure + | AutoWhiteBalance + | RawColor + | MirrorDepth + | MirrorVideo + deriving(Show,Eq) + +-- | Sets a specific device flag for depth and video cameras. The +-- bool value defines to enable or disable the given flag. The specific camera +-- has to be started with startVideo/startDepth before Freenect accepts +-- these flags (seems to be a small bug for me, an issue is written at libfreenect) +setFlag :: Device -> Flag -> Bool -> IO () +setFlag d flag enabled = flip withD d $ \ptr -> do + ptr <- peek ptr + succeed UnableToSetFlag (return ()) $ + freenect_set_flag ptr key value + where + key = toEnumInteger flag + value = fromIntegral (if enabled then 1 else 0) + + toEnumInteger AutoExposure = 1 `shift` 14 + toEnumInteger AutoWhiteBalance = 1 `shift` 1 + toEnumInteger RawColor = 1 `shift` 4 + toEnumInteger MirrorDepth = 1 `shift` 16 + toEnumInteger MirrorVideo = 1 `shift` 17 + + +-- | Start the audio information stream for a device. +startAudio :: Device -> IO () +startAudio = withD $ \ptr -> succeed StartAudioProblem (return ()) $ do + ptr <- peek ptr + freenect_start_audio ptr + +-- | Stop the audio information stream for a device. +stopAudio :: Device -> IO () +stopAudio = withD $ \ptr -> succeed StopAudioProblem (return ()) $ do + ptr <- peek ptr + freenect_stop_audio ptr + + +-- | Set callback for incoming audio events. +setAudioInCallback + :: Device + -> (Int -> Vector Word32 -> Vector Word32 -> Vector Word32 -> Vector Word32 -> Vector Word16 -> IO ()) + -> IO () +setAudioInCallback d callback = flip withD d $ \dptr -> do + dptr <- peek dptr + callbackPtr <- wrapAudioInCallback $ \_ num lptr lmptr rmptr rptr nptr _ -> do + let !size = (fromIntegral num) + + l_ptr <- newForeignPtr_ lptr + lm_ptr <- newForeignPtr_ lmptr + rm_ptr <- newForeignPtr_ rmptr + r_ptr <- newForeignPtr_ rptr + n_ptr <- newForeignPtr_ nptr + + let !l_vector = unsafeFromForeignPtr l_ptr 0 size + let !lm_vector = unsafeFromForeignPtr lm_ptr 0 size + let !rm_vector = unsafeFromForeignPtr rm_ptr 0 size + let !r_vector = unsafeFromForeignPtr r_ptr 0 size + let !n_vector = unsafeFromForeignPtr n_ptr 0 size + + callback size l_vector lm_vector rm_vector r_vector n_vector + freenect_set_audio_in_callback dptr callbackPtr diff --git a/src/Freenect/FFI.hs b/src/Freenect/FFI.hs --- a/src/Freenect/FFI.hs +++ b/src/Freenect/FFI.hs @@ -10,6 +10,7 @@ data ContextStruct data DeviceStruct +data RawTiltState -------------------------------------------------------------------------------- -- Freenect lib functions. @@ -77,19 +78,76 @@ -> IO CInt foreign import ccall + "freenect.h freenect_stop_depth" + freenect_stop_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_stop_video" + freenect_stop_video :: Ptr DeviceStruct + -> IO CInt + +foreign import ccall + "freenect.h freenect_set_led" + freenect_set_led :: Ptr DeviceStruct -> CInt -> IO CInt + + +foreign import ccall + "freenect.h freenect_set_flag" + freenect_set_flag :: Ptr DeviceStruct -> CInt -> CInt -> IO CInt + + +foreign import ccall "freenect.h freenect_set_tilt_degs" freenect_set_tilt_degs :: Ptr DeviceStruct -> CDouble -> IO CInt +foreign import ccall + "freenect.h freenect_update_tilt_state" + freenect_update_tilt_state :: Ptr DeviceStruct -> IO CInt foreign import ccall - "freenect.h freenect_set_led" - freenect_set_led :: Ptr DeviceStruct -> CInt -> IO CInt + "freenect.h freenect_get_tilt_state" + freenect_get_tilt_state :: Ptr DeviceStruct -> IO (Ptr RawTiltState) + +foreign import ccall + "freenect.h freenect_get_tilt_degs" + freenect_get_tilt_degs :: Ptr RawTiltState -> IO CDouble + +foreign import ccall + "freenect.h freenect_get_mks_accel" + freenect_get_mks_accel :: Ptr RawTiltState -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO () + -------------------------------------------------------------------------------- +-- Audio + +foreign import ccall + "freenect_audio.h freenect_start_audio" + freenect_start_audio :: Ptr DeviceStruct -> IO CInt + +foreign import ccall + "freenect_audio.h freenect_stop_audio" + freenect_stop_audio :: Ptr DeviceStruct -> IO CInt + +type AudioInCallback = Ptr DeviceStruct -> CInt -> Ptr Word32 -> Ptr Word32 -> Ptr Word32 -> Ptr Word32 -> Ptr Word16 -> Ptr CUChar -> IO () + +foreign import ccall + "freenect.h freenect_set_audio_in_callback" + freenect_set_audio_in_callback + :: Ptr DeviceStruct + -> (FunPtr AudioInCallback) + -> IO () + +foreign import ccall "wrapper" + wrapAudioInCallback :: AudioInCallback -> IO (FunPtr AudioInCallback) + + + +-------------------------------------------------------------------------------- -- Helpers. foreign import ccall @@ -99,6 +157,10 @@ foreign import ccall "freenect-helpers.h new_freenect_device" new_freenect_device :: IO (Ptr (Ptr DeviceStruct)) + +foreign import ccall + "freenect-helpers.h process_events_timeout" + process_events_timeout :: Ptr ContextStruct -> CInt -> IO CInt data FrameMode