freenect (empty) → 1.0

raw patch · 7 files changed

+520/−0 lines, 7 filesdep +basedep +vectorsetup-changed

Dependencies added: base, vector

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• cbits/freenect-helpers.c +46/−0
• freenect.cabal +40/−0
• src/Freenect.hs +264/−0
• src/Freenect/FFI.hs +96/−0
• src/Main.hs +42/−0

@@ -0,0 +1,30 @@+Copyright (c)2011, Chris Done++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Chris Done nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,46 @@+#include <stdio.h>+#include <stdlib.h>++#include <libfreenect.h>++/*+ * Make a new freenect_context.+ */+freenect_context** new_freenect_context(){+  freenect_context** ptr = malloc(sizeof (*ptr));+  *ptr = malloc(sizeof(*ptr));+  return ptr;+};++/*+ * Make a new freenect_device.+ */+freenect_device** new_freenect_device(){+  return malloc(sizeof (freenect_device*));+};++/*+ * Get a frame mode.+ */+freenect_frame_mode* find_depth_mode_freenect(uint32_t res,+                                              uint32_t fmt){+  freenect_frame_mode* mode = malloc(sizeof (*mode));+  *mode = freenect_find_depth_mode(res,fmt);+  return mode;+};++/*+ * Set the depth mode of a device.+ */+int set_freenect_depth_mode(freenect_device* dev,freenect_frame_mode* mode)+{+  return freenect_set_depth_mode(dev,*mode);+};++/*+ * Get the depth resolution of a device.+ */+uint32_t get_freenect_depth_resolution(freenect_device* dev){+  freenect_frame_mode mode = freenect_get_current_depth_mode(dev);+  return mode.resolution;+}

@@ -0,0 +1,40 @@+Name:                freenect+Version:             1.0+Synopsis:            Interface to the Kinect device.+Description:         Interface to the Kinect device. Currently supports+                     depth perception. (No video or audio.)+Homepage:            https://github.com/chrisdone/freenect+License:             BSD3+License-file:        LICENSE+Author:              Chris Done+Maintainer:          chrisdone@gmail.com+Copyright:           Chris Done+Category:            Graphics+Build-type:          Simple+Cabal-version:       >=1.6+Stability:           Experimental++source-repository head+  type:     git+  location: http://github.com/chrisdone/freenect++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+  Extra-libraries:   freenect, freenect_sync+  C-sources:         cbits/freenect-helpers.c+  Include-dirs:      cbits

@@ -0,0 +1,264 @@+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS -fno-warn-name-shadowing #-}+{-# LANGUAGE DeriveDataTypeable #-}++-- | Interface to the Kinect device.++module Freenect+       (initialize+       ,newContext+       ,shutdown+       ,countDevices+       ,withContext+       ,processEvents+       ,selectSubdevices+       ,newDevice+       ,openDevice+       ,closeDevice+       ,withDevice+       ,setLogLevel+       ,setDepthCallback+       ,startDepth+       ,setTiltDegrees+       ,setDepthMode+       ,Context+       ,FreenectException(..)+       ,Subdevice(..)+       ,LogLevel(..)+       ,Resolution(..)+       ,DepthFormat(..))+       where++import Freenect.FFI++import Control.Exception (bracket,throw,Exception(..))+import Data.Bits+import Data.IORef+import Data.List+import Data.Typeable+import Foreign+import Foreign.C+import Data.Vector.Storable (Vector,unsafeFromForeignPtr)++-- | An acquireable resource. This abstracts the notion of C-level+--   pointers that may or may not refer to something in memory. Avoids+--   segmentation faults and other nasties. Nobody wants segmentation+--   faults in their Haskell code.+data Resource a = Initialized a | Uninitialized a+  deriving Show++-- | A Freenect context.+newtype Context = CPtr (IORef (Resource (Ptr (Ptr ContextStruct))))++-- | A Freenect device.+newtype Device = DPtr (IORef (Resource (Ptr (Ptr DeviceStruct))))++-- | Freenect exception type.+data FreenectException+  = 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.+  | StartDepthProblem        -- ^ Problem starting the depth stream.+  | UnableToSetTilt          -- ^ Unable to set the tilt.+  | SetDepthMode             -- ^ Unable to set the depth mode.+  | DepthModeNotSet          -- ^ You didn't set the depth mode.+    deriving (Show,Typeable)+instance Exception FreenectException++-- | Initialize a Freenect context. Throws exception if already+--   initialized.+initialize :: Context -> IO ()+initialize (CPtr ptrRef) = do+  ptr <- readIORef ptrRef+  case ptr of+    Initialized{} -> throw AlreadyInitializedContext+    Uninitialized ptr -> do+      succeed InitFail (writeIORef ptrRef (Initialized ptr)) $+        freenect_init ptr 0++-- | Create a new Freenect context. Must be initialized before use.+newContext :: IO Context+newContext = new_freenect_context >>= fmap CPtr . newIORef . Uninitialized++-- | Shutdown a Freenect context.+shutdown :: Context -> IO ()+shutdown cptr@(CPtr ptrRef) = flip withC cptr $ \ptr ->+  succeed ShutdownFail+          (writeIORef ptrRef (Uninitialized ptr))+          (peek ptr >>= freenect_shutdown)+  +-- | Count the number of devices on a Freenect context.+countDevices :: Context -> IO Integer+countDevices =+  withC $ \ptr ->+    fmap fromIntegral (peek ptr >>= freenect_num_devices)++-- | Do something with an initialized context, and free the context at+--   the end of the comutation, or on exception.+withContext :: (Context -> IO a) -> IO a+withContext f = bracket newContext shutdown (\c -> do initialize c; f c)++-- | Process events.+processEvents :: Context -> IO ()+processEvents = withC $ \cptr -> do+  cptr <- peek cptr+  result <- freenect_process_events cptr+  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 ()+succeed e ok m = do+  result <- m+  if result == 0 +     then ok+     else throw e++-- | A sub-device (motor, camera and audio), if supported on the+--   platform.+data Subdevice = Motor | Camera | Auto+  deriving (Show,Eq)++-- | 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.+selectSubdevices :: Context -> [Subdevice] -> IO ()+selectSubdevices c (nub -> subdevices) = flip withC c $ \ptr -> do+  ptr <- peek ptr+  freenect_select_subdevices  ptr (foldl1 (.|.) (map toDeviceId subdevices))++  where toDeviceId Motor = 1+        toDeviceId Camera = 2+        toDeviceId Auto = 4++-- | Create a new device.+newDevice :: IO Device+newDevice = new_freenect_device >>= fmap DPtr . newIORef . Uninitialized++-- | Open a Kinect device.+openDevice :: Context -> Device -> Integer -> IO ()+openDevice c (DPtr devptr) index = flip withC c $ \cptr -> do+  dptr <- readIORef devptr+  case dptr of+    Initialized{} -> throw AlreadyOpenedDevice+    Uninitialized dptr -> do+      succeed (OpenDeviceFailed index) (writeIORef devptr (Initialized dptr)) $ do+        cptr <- peek cptr+        freenect_open_device cptr dptr (fromIntegral index)++-- | Close a device.+closeDevice :: Device -> IO ()+closeDevice dptr@(DPtr ptrRef) = do+  flip withD dptr $ \ptr -> do+    succeed CloseDeviceFail+            (writeIORef ptrRef (Uninitialized ptr))+            (peek ptr >>= freenect_close_device)++-- | Do something with an initialized context, and free the context at+--   the end of the comutation, or on exception.+withDevice :: Context -> Integer -> (Device -> IO a) -> IO a+withDevice ctx i f = bracket newDevice closeDevice (\d -> do openDevice ctx d i; f d)++-- | Do something with a device pointer. Unexported.+withD :: (Ptr (Ptr DeviceStruct) -> IO a) -> Device -> IO a+withD cons (DPtr ptr) = do+  ptr <- readIORef ptr+  case ptr of+    Uninitialized{} -> throw UseOfUninitializedDevice+    Initialized ptr -> cons ptr++-- | Do something with a context pointer. Unexported.+withC :: (Ptr (Ptr ContextStruct) -> IO a) -> Context -> IO a+withC cons (CPtr ptr) = do+  ptr <- readIORef ptr+  case ptr of+    Uninitialized{} -> throw UseOfUninitializedContext+    Initialized ptr -> cons ptr++-- | Message logging levels.+data LogLevel+  = 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.+  deriving (Show,Eq,Enum)++-- | Set the logging level for the specified context.+setLogLevel :: LogLevel -> Context -> IO ()+setLogLevel level = withC $ \ptr -> do+  ptr <- peek ptr+  freenect_set_log_level ptr (fromIntegral (fromEnum level))++-- | Set callback for depth information received event.+setDepthCallback :: Device -> (Vector Word16 -> Word32 -> IO ()) -> IO ()+setDepthCallback d callback = flip withD d $ \dptr -> do+  dptr <- peek dptr+  resolution <- get_freenect_depth_resolution dptr+  let !size = resolutionToSize (toEnum (fromIntegral resolution))+  callbackPtr <- wrapDepthCallback $ \_ payloadptr timestamp -> do+    fptr <- newForeignPtr_ payloadptr+    let !vector = unsafeFromForeignPtr fptr 0 size+    callback vector timestamp+  freenect_set_depth_callback dptr callbackPtr++-- | Resolution to size.+resolutionToSize :: Resolution -> Int+resolutionToSize Low    = 320  * 240+resolutionToSize Medium = 640  * 480+resolutionToSize High   = 1280 * 1024++-- | 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.+setTiltDegrees :: Double -> Device -> IO ()+setTiltDegrees angle = withD $ \ptr -> succeed UnableToSetTilt (return ()) $ do+  ptr <- peek ptr+  freenect_set_tilt_degs ptr (realToFrac angle)++data Resolution = Low | Medium | High+  deriving (Enum,Show,Eq,Ord)++data DepthFormat+  = ElevenBit+  | TenBit+  | ElevenBitPacked+  | TenBitPacked+  deriving (Enum,Show,Eq)++-- | Sets the current depth mode for the specified device.  The mode+--    cannot be changed while streaming is active.+setDepthMode :: Device -> Resolution -> DepthFormat -> IO ()+setDepthMode d res fmt = flip withD d $ \dptr -> do+  dptr <- peek dptr+  frameMode <- find_depth_mode_freenect (fromIntegral (fromEnum res))+                                        (fromIntegral (fromEnum fmt))+  succeed SetDepthMode (return ()) $+    set_freenect_depth_mode dptr frameMode

@@ -0,0 +1,96 @@+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE ForeignFunctionInterface #-}++-- | Foreign functions, some helpers some from Freenect C lib.++module Freenect.FFI where++import Foreign.C+import Foreign++data ContextStruct+data DeviceStruct++--------------------------------------------------------------------------------+-- Freenect lib functions.++foreign import ccall+  "freenect.h freenect_init"+  freenect_init :: Ptr (Ptr ContextStruct) -> CInt -> IO CInt++foreign import ccall+  "freenect.h freenect_shutdown"+  freenect_shutdown :: Ptr ContextStruct -> IO CInt++foreign import ccall+  "freenect.h freenect_num_devices"+  freenect_num_devices :: Ptr ContextStruct -> IO CInt++foreign import ccall+  "freenect.h freenect_process_events"+  freenect_process_events :: Ptr ContextStruct -> IO CInt++foreign import ccall+  "freenect.h freenect_select_subdevices"+  freenect_select_subdevices :: Ptr ContextStruct -> CInt -> IO ()++foreign import ccall+  "freenect.h freenect_set_log_level"+  freenect_set_log_level :: Ptr ContextStruct -> CInt -> IO ()++foreign import ccall+  "freenect.h freenect_close_device"+  freenect_close_device :: Ptr DeviceStruct -> IO CInt++foreign import ccall+  "freenect.h freenect_open_device"+  freenect_open_device :: Ptr ContextStruct -> Ptr (Ptr DeviceStruct) -> CInt+                       -> IO CInt++type DepthCallback = Ptr DeviceStruct -> Ptr Word16 -> Word32 -> IO ()++foreign import ccall+  "freenect.h freenect_set_depth_callback"+  freenect_set_depth_callback+    :: Ptr DeviceStruct+    -> (FunPtr DepthCallback)+    -> IO ()++foreign import ccall "wrapper"  +  wrapDepthCallback :: DepthCallback -> IO (FunPtr DepthCallback)++foreign import ccall+  "freenect.h freenect_start_depth"+  freenect_start_depth :: Ptr DeviceStruct+                       -> IO CInt++foreign import ccall+  "freenect.h freenect_set_tilt_degs"+  freenect_set_tilt_degs :: Ptr DeviceStruct -> CDouble -> IO CInt++--------------------------------------------------------------------------------+-- Helpers.++foreign import ccall+  "freenect-helpers.h new_freenect_context"+  new_freenect_context :: IO (Ptr (Ptr ContextStruct))++foreign import ccall+  "freenect-helpers.h new_freenect_device"+  new_freenect_device :: IO (Ptr (Ptr DeviceStruct))++data FrameMode++foreign import ccall+  "freenect.h find_depth_mode_freenect"+  find_depth_mode_freenect :: Word32+                           -> Word32+                           -> IO (Ptr FrameMode)++foreign import ccall+  "freenect.h set_freenect_depth_mode"+  set_freenect_depth_mode :: Ptr DeviceStruct -> Ptr FrameMode -> IO CInt++foreign import ccall+  "freenect.h get_freenect_depth_resolution"+  get_freenect_depth_resolution :: Ptr DeviceStruct -> IO CInt

@@ -0,0 +1,42 @@+-- | 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