freenect-1.2: Interface to the Kinect device.

Safe HaskellNone
LanguageHaskell98

Freenect

Contents

Description

Interface to the Kinect device.

See the package archive for example programs.

Synopsis

Initializing the context

First you need to initalize a context. Example:

do context <- newContext
   initalize context
   ...
   shutdown context

Rather than messing around with this, it's better if you just use withContext, which does this for you:

withContext $ context -> do
  ...

All stuff with this library works within a context.

Working with devices

You need to select which sub devices you want to use from the Kinect (e.g. camera, motor, audio):

selectSubdevices context [Camera,Motor]

Then you open a device context through which you can control the sub devices.

withDevice context 0 $ device -> do
  ...

The second argument is which Kinect to use. You can get a count of these using

deviceCount <- countDevices context

Then you should set the depth mode you want:

setDepthMode device Medium ElevenBit

This should come before the next part, which is setting the callback:

setDepthCallback device $ payload timestamp -> do
  printf "Payload: %sn" (take 100 $ show payload)

Important: Based on the depth mode set earlier, setDepthCallback knows how to copy the payload into a vector for the callback. This is why it should come first. Arguably in future APIs a device should not be initializable without a depth mode.

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: %sn" (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 like this, for example:

forever $ do
  processEvents context

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.

Events; recieving data

initialize :: Context -> IO () Source

Initialize a Freenect context. Throws exception if already initialized.

newContext :: IO Context Source

Create a new Freenect context. Must be initialized before use.

shutdown :: Context -> IO () Source

Shutdown a Freenect context.

countDevices :: Context -> IO Integer Source

Count the number of devices on a Freenect context.

withContext :: (Context -> IO a) -> IO a Source

Do something with an initialized context, and free the context at the end of the comutation, or on exception.

processEvents :: Context -> IO () Source

Process events.

selectSubdevices :: Context -> [Subdevice] -> IO () Source

Set which subdevices any subsequent calls to openDevice should open. This will not affect devices which have already been opened. The default behavior, should you choose not to call this function at all, is to open all supported subdevices - motor, cameras, and audio, if supported on the platform.

newDevice :: IO Device Source

Create a new device.

openDevice :: Context -> Device -> Integer -> IO () Source

Open a Kinect device.

closeDevice :: Device -> IO () Source

Close a device.

withDevice :: Context -> Integer -> (Device -> IO a) -> IO a Source

Do something with an initialized context, and free the context at the end of the comutation, or on exception.

setLogLevel :: LogLevel -> Context -> IO () Source

Set the logging level for the specified context.

setVideoCallback :: Device -> (Vector Word8 -> Word32 -> IO ()) -> IO () Source

Set callback for video information received event.

startVideo :: Device -> IO () Source

Start the video information stream for a device.

setDepthCallback :: Device -> (Vector Word16 -> Word32 -> IO ()) -> IO () Source

Set callback for depth information received event.

startDepth :: Device -> IO () Source

Start the depth information stream for a device.

setTiltDegrees :: Double -> Device -> IO () Source

Set the tilt degrees for a device.

setLed :: Device -> Led -> IO () Source

Sets the current LED state for the specified device

setDepthMode :: Device -> Resolution -> DepthFormat -> IO () Source

Sets the current depth mode for the specified device. The mode cannot be changed while streaming is active.

data Context Source

A Freenect context.

data Device Source

A Freenect device.

data FreenectException Source

Freenect exception type.

Constructors

InitFail

There was a problem initializing.

ShutdownFail

There was a problem shutting down.

CloseDeviceFail

There was a problem closing the device.

AlreadyInitializedContext

Trying to initialize a context that was already initialized.

AlreadyOpenedDevice

Trying to open a device that was already opened.

UseOfUninitializedContext

Attempt to use an uninitialized context.

UseOfUninitializedDevice

Attempt to use an uninitialized 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.

UnableToSetLed

Unable to set active led

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.

data Subdevice Source

A sub-device (motor, camera and audio), if supported on the platform.

Constructors

Motor 
Camera 
Auto 

data LogLevel Source

Message logging levels.

Constructors

LogFatal

Crashing/non-recoverable errors

LogError

Major errors

LogWarning

Warning messages

LogNotice

Important messages

LogInfo

Normal messages

LogDebug

Useful development messages

LogSpew

Slightly less useful messages

LogFlood

EVERYTHING. May slow performance.

data Led Source

Instances