diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2014, Charles Durham + +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 Charles Durham 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cbits/Rift.cpp b/cbits/Rift.cpp new file mode 100644 --- /dev/null +++ b/cbits/Rift.cpp @@ -0,0 +1,118 @@ +// ========================================================================== +// RiftDK - C++ wrapper for reading head tracker data with pure C +// Provide functions to initialize the RiftDK, and to read tracker data. +// ========================================================================== +// Revision History, Last Change First: +// YYYY/MM/DD Author Description +// ========== ==================== ========================================== +// 2013/04/22 Geekmaster First release version. + +#include "Rift.h" +#include "OVR.h" +using namespace OVR; + +SensorFusion* pFusion; +Ptr pManager; +Ptr pHMD; +Ptr pSensor; +HMDInfo hmdInfo; + +extern "C" bool initRift() { + System::Init(Log::ConfigureDefaultLog(LogMask_All)); + pManager = *DeviceManager::Create(); + pHMD = *pManager->EnumerateDevices().CreateDevice(); + + if(pHMD == NULL) { + return false; + } + + pSensor = *pHMD->GetSensor(); + pFusion = new SensorFusion(); + pFusion->AttachToSensor(pSensor); + pHMD->GetDeviceInfo(&hmdInfo); + return true; +} + +extern "C" void clearRift() { + pSensor.Clear(); + pHMD.Clear(); + pManager.Clear(); + + delete pFusion; + + System::Destroy(); +} + +extern "C" void readOrientation(float *roll, float *pitch, float *yaw) { + pFusion->GetOrientation().GetEulerAngles(yaw, pitch, roll); +} + +extern "C" void readOrientationQ(float *x, float *y, float *z, float *w) { + Quatf quatf = pFusion->GetOrientation(); + *x = quatf.x; *y = quatf.y; *z = quatf.z; *w = quatf.w; +} + +extern "C" void readPredictedOrientation(float *roll, float *pitch, float *yaw) { + pFusion->GetPredictedOrientation().GetEulerAngles(yaw, pitch, roll); +} + +extern "C" void readPredictedOrientationQ(float *x, float *y, float *z, float *w) { + Quatf quatf = pFusion->GetPredictedOrientation(); + *x = quatf.x; *y = quatf.y; *z = quatf.z; *w = quatf.w; +} + +extern "C" void readAcceleration(float *x, float *y, float *z) { + Vector3f acc = pFusion->GetAcceleration(); + *x = acc.x; *y = acc.y; *z = acc.z; +} + +extern "C" void populateProductInfo +( char *DisplayDeviceName, + char *ProductName, + char *Manufacturer, + unsigned *Version) { + strncpy(DisplayDeviceName, hmdInfo.DisplayDeviceName,32); + strncpy(ProductName, hmdInfo.ProductName,32); + strncpy(Manufacturer, hmdInfo.Manufacturer,32); + *Version = hmdInfo.Version; +} + +extern "C" void populateScreenInfo +( unsigned *HResolution, + unsigned *VResolution, + float *HScreenSize, + float *VScreenSize, + float *VScreenCenter, + float *EyeToScreenDistance, + float *LensSeparationDistance, + float *InterpupillaryDistance) { + *HResolution = hmdInfo.HResolution; + *VResolution = hmdInfo.VResolution; + *HScreenSize = hmdInfo.HScreenSize; + *VScreenSize = hmdInfo.VScreenSize; + *EyeToScreenDistance = hmdInfo.EyeToScreenDistance; + *LensSeparationDistance = hmdInfo.LensSeparationDistance; + *InterpupillaryDistance = hmdInfo.InterpupillaryDistance; +} + +extern "C" void populateDistortionKInfo +( float *DistortionK0, + float *DistortionK1, + float *DistortionK2, + float *DistortionK3) { + *DistortionK0 = hmdInfo.DistortionK[0]; + *DistortionK1 = hmdInfo.DistortionK[1]; + *DistortionK2 = hmdInfo.DistortionK[2]; + *DistortionK3 = hmdInfo.DistortionK[3]; +} + +extern "C" void populateChromaAbCorrectionInfo +( float *ChromaAbCorrection0, + float *ChromaAbCorrection1, + float *ChromaAbCorrection2, + float *ChromaAbCorrection3) { + *ChromaAbCorrection0 = hmdInfo.ChromaAbCorrection[0]; + *ChromaAbCorrection1 = hmdInfo.ChromaAbCorrection[1]; + *ChromaAbCorrection2 = hmdInfo.ChromaAbCorrection[2]; + *ChromaAbCorrection3 = hmdInfo.ChromaAbCorrection[3]; +} diff --git a/oculus.cabal b/oculus.cabal new file mode 100644 --- /dev/null +++ b/oculus.cabal @@ -0,0 +1,46 @@ +-- Initial oculus.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: oculus +version: 0.1.0.0 +synopsis: Oculus Rift ffi providing head tracking data +description: Bindings to the oculus rift sdk head tracking. Requires installation of the OculusSdk, currently only supported for linux installs. + You're going to need to either install the sdk under the default include and ld search path, or you can point cabal to your local oculusSdk install + by using the \"--extra-include-dirs\" and \"--extra-lib-dirs\" flags. + . + For example + \"cabal install --extra-include-dirs \/path\/to\/OculusSDK\/LibOVR\/Include --extra-lib-dirs \/path\/to\/OculusSDK\/LibOVR\/Lib\/Linux\/Release\/x86_64\" + . + Below is a small program that initializes the rift and prints the orientation every second until ctrl-C + . + >module Main where + > + >import Control.Concurrent (threadDelay) + >import Control.Monad + >import Control.Monad.Trans.Either + > + >import Rift + > + >main = eitherT print printOrientation initRift + > where printOrientation h = forever $ wait1sec >> orientation h >>= print + > wait1sec = threadDelay 1000000 + +homepage: http://github.com/cpdurham/oculus +license: BSD3 +license-file: LICENSE +author: Charles Durham +maintainer: Charles Durham +copyright: (c) 2014 Charles Durham +category: Graphics +build-type: Simple +cabal-version: >=1.8 + +library + Hs-source-dirs: src + c-sources: cbits/Rift.cpp + extra-libraries: ovr, udev, pthread, GL, X11, Xinerama, stdc++ + extensions: ForeignFunctionInterface + exposed-modules: Rift + ghc-options: -Wall -O2 + cc-options: -fpic -shared + build-depends: base ==4.6.*, transformers ==0.3.*, either ==4.1.*, monads-tf ==0.1.*, vect-floating ==0.1.0.3 diff --git a/src/Rift.hs b/src/Rift.hs new file mode 100644 --- /dev/null +++ b/src/Rift.hs @@ -0,0 +1,266 @@ +-- | Access Rift headtracking data and constants related to screen, distortion parameters, etc.. + +module Rift + ( RiftHandle + , initRift, clearRift + , orientation, orientationQ + , predictedOrientation, predictedOrientationQ + , acceleration + + , ProductInfo(..), productInfo + , ScreenInfo(..), screenInfo + , DistortionKInfo(..), distortionKInfoToVec4, distortionKInfo + , ChromaAbCorrectionInfo(..), chromaAbCorrectionInfoToVec4, chromaAbCorrectionInfo + ) where + +import Control.Applicative + +import Control.Monad.IO.Class +import Control.Monad.Trans.Either + +import Control.Monad.Cont + +import Data.Vect.Floating +import Data.Vect.Floating.Util.Quaternion + +import Foreign.C +import Foreign.Ptr +import Foreign.Marshal.Alloc +import Foreign.Storable + +foreign import ccall unsafe "initRift" c_initRift :: IO Bool +foreign import ccall unsafe "clearRift" c_clearRift :: IO () + +foreign import ccall unsafe "readOrientation" c_readOrientation :: Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> IO () +foreign import ccall unsafe "readOrientationQ" c_readOrientationQ :: Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> IO () +foreign import ccall unsafe "readPredictedOrientation" c_readPredictedOrientation :: Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> IO () +foreign import ccall unsafe "readPredictedOrientationQ" c_readPredictedOrientationQ :: Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> IO () +foreign import ccall unsafe "readAcceleration" c_readAcceleration :: Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> IO () + +foreign import ccall unsafe "populateProductInfo" c_populateProductInfo :: CString -> CString -> CString -> Ptr CUInt -> IO () +foreign import ccall unsafe "populateScreenInfo" c_populateScreenInfo :: Ptr CUInt -> Ptr CUInt -> Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> IO () +foreign import ccall unsafe "populateDistortionKInfo" c_populateDistortionKInfo :: Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> IO () +foreign import ccall unsafe "populateChromaAbCorrectionInfo" c_populateChromaAbCorrectionInfo :: Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> IO () + +-- | Handle to rift, constructor intentionally hidden, used to enforce that `initRift` was called before other Rift related functions. +data RiftHandle = R + +-- | Error code for why call to `initRift` might have failed, not very descriptive yet. +data ErrorCode = InitializationFailed + deriving Show + +-- | Initializes the rift, returns ErrorCode if failure, returns a RiftHandle if success. Not safe to call twice without a call to `clearRift`. +initRift :: EitherT ErrorCode IO RiftHandle +initRift = do + b <- liftIO c_initRift + case b of + True -> return R + False -> left InitializationFailed + +-- | Cleans up handle, frees memory, detaches from Rift, makes next call to `initRift` safe. +clearRift :: RiftHandle -> IO () +clearRift _ = c_clearRift + +-- | Returns orientation of Rift in degrees starting at 0, from -pi to pi. +-- Deconstructs to `Vec3` roll pitch yaw +orientation :: RiftHandle -> IO (Vec3 Float) +orientation _ = (`runContT` id) $ do + roll <- ContT alloca + pitch <- ContT alloca + yaw <- ContT alloca + liftIO $ do + c_readOrientation roll pitch yaw + return $ Vec3 + <$> (fmap realToFrac . peek) roll + <*> (fmap realToFrac . peek) pitch + <*> (fmap realToFrac . peek) yaw + +-- | Returns orientation of Rift in the UnitQuaternion, can apply as rotation with functions from `Data.Vect.Floating.Util.Quaternion` module in the package. +orientationQ :: RiftHandle -> IO (UnitQuaternion Float) +orientationQ _ = (`runContT` id) $ do + x <- ContT alloca + y <- ContT alloca + z <- ContT alloca + w <- ContT alloca + liftIO $ do + c_readOrientationQ x y z w + return . fmap unsafeToU $ Vec4 + <$> (fmap realToFrac . peek) x + <*> (fmap realToFrac . peek) y + <*> (fmap realToFrac . peek) z + <*> (fmap realToFrac . peek) w + +-- | Same as `orientation`, however, factors in velocity from Rift to give a predicted orientation with a lookahead defaulted to 0.03 seconds. +predictedOrientation :: RiftHandle -> IO (Vec3 Float) +predictedOrientation _ = (`runContT` id) $ do + roll <- ContT alloca + pitch <- ContT alloca + yaw <- ContT alloca + liftIO $ do + c_readPredictedOrientation roll pitch yaw + return $ Vec3 + <$> (fmap realToFrac . peek) roll + <*> (fmap realToFrac . peek) pitch + <*> (fmap realToFrac . peek) yaw + +-- | Same as 'orientationQ`, however, factors in velocity from Rift to give a predicted orientation with a lookahead defaulted to 0.03 seconds. +predictedOrientationQ :: RiftHandle -> IO (UnitQuaternion Float) +predictedOrientationQ _ = (`runContT` id) $ do + x <- ContT alloca + y <- ContT alloca + z <- ContT alloca + w <- ContT alloca + liftIO $ do + c_readPredictedOrientationQ x y z w + return . fmap unsafeToU $ Vec4 + <$> (fmap realToFrac . peek) x + <*> (fmap realToFrac . peek) y + <*> (fmap realToFrac . peek) z + <*> (fmap realToFrac . peek) w + +-- | Returns last absolute acceleration reading, in m/s^2. Deconstructs to `Vec3` x y z. +acceleration :: RiftHandle -> IO (Vec3 Float) +acceleration _ = (`runContT` id) $ do + x <- ContT alloca + y <- ContT alloca + z <- ContT alloca + liftIO $ do + c_readAcceleration x y z + return $ Vec3 + <$> (fmap realToFrac . peek) x + <*> (fmap realToFrac . peek) y + <*> (fmap realToFrac . peek) z + +{- Constants from Oculus Rift -} + +-- | Info about product. +data ProductInfo = + ProductInfo + { displayDeviceName :: String + , productName :: String + , manufacturer :: String + , version :: Int + } deriving (Show) + +-- | Grabs product info from Rift. +productInfo :: RiftHandle -> IO ProductInfo +productInfo _ = (`runContT` id) $ do + displayDeviceName' <- ContT $ withCString (replicate 33 '0') + productName' <- ContT $ withCString (replicate 33 '0') + manufacturer' <- ContT $ withCString (replicate 33 '0') + version' <- ContT alloca + liftIO $ do + c_populateProductInfo displayDeviceName' productName' manufacturer' version' + return $ ProductInfo + <$> peekCString displayDeviceName' + <*> peekCString productName' + <*> peekCString manufacturer' + <*> (fmap fromIntegral . peek) version' + +-- | Info about screen, all distances are in meters. +data ScreenInfo = + ScreenInfo + { hResolution :: Int + , vResolution :: Int + , hScreenSize :: Float + , vScreenSize :: Float + , vScreenCenter :: Float + , eyeToScreenDistance :: Float + , lensSeparationDistance :: Float + , interpupillaryDistance :: Float + } deriving (Show) + +-- | Grabs screen info from Rift. +screenInfo :: RiftHandle -> IO ScreenInfo +screenInfo _ = (`runContT` id) $ do + hResolution' <- ContT alloca + vResolution' <- ContT alloca + hScreenSize' <- ContT alloca + vScreenSize' <- ContT alloca + vScreenCenter' <- ContT alloca + eyeToScreenDistance' <- ContT alloca + lensSeparationDistance' <- ContT alloca + interpupillaryDistance' <- ContT alloca + liftIO $ do + c_populateScreenInfo + hResolution' + vResolution' + hScreenSize' + vScreenSize' + vScreenCenter' + eyeToScreenDistance' + lensSeparationDistance' + interpupillaryDistance' + return $ ScreenInfo + <$> (fmap fromIntegral . peek) hResolution' + <*> (fmap fromIntegral . peek) vResolution' + <*> (fmap realToFrac . peek) hScreenSize' + <*> (fmap realToFrac . peek) vScreenSize' + <*> (fmap realToFrac . peek) vScreenCenter' + <*> (fmap realToFrac . peek) eyeToScreenDistance' + <*> (fmap realToFrac . peek) lensSeparationDistance' + <*> (fmap realToFrac . peek) interpupillaryDistance' + +-- | Information about distortion correction parameters necessary to correct lenses in Rift. +data DistortionKInfo = + DistortionKInfo + { distortionK0 :: Float + , distortionK1 :: Float + , distortionK2 :: Float + , distortionK3 :: Float + } deriving (Show) + +-- | Converts distortion correction parameters to a 4D vector. +distortionKInfoToVec4 :: DistortionKInfo -> Vec4 Float +distortionKInfoToVec4 (DistortionKInfo c0 c1 c2 c3) = Vec4 c0 c1 c2 c3 + +-- | Grabs distortion correction parameters from Rift. +distortionKInfo :: RiftHandle -> IO DistortionKInfo +distortionKInfo _ = (`runContT` id) $ do + distortionK0' <- ContT alloca + distortionK1' <- ContT alloca + distortionK2' <- ContT alloca + distortionK3' <- ContT alloca + liftIO $ do + c_populateDistortionKInfo + distortionK0' + distortionK1' + distortionK2' + distortionK3' + return $ DistortionKInfo + <$> (fmap realToFrac . peek) distortionK0' + <*> (fmap realToFrac . peek) distortionK1' + <*> (fmap realToFrac . peek) distortionK2' + <*> (fmap realToFrac . peek) distortionK3' + +-- | Information about chromatic aberration correction parameters necessary to correct color changes due to lenses in Rift. +data ChromaAbCorrectionInfo = + ChromaAbCorrectionInfo + { chromaAbCorrection0 :: Float + , chromaAbCorrection1 :: Float + , chromaAbCorrection2 :: Float + , chromaAbCorrection3 :: Float + } deriving (Show) + +-- | Converts chromatic aberration correction parameters to a 4D vector. +chromaAbCorrectionInfoToVec4 :: ChromaAbCorrectionInfo -> Vec4 Float +chromaAbCorrectionInfoToVec4 (ChromaAbCorrectionInfo c0 c1 c2 c3) = Vec4 c0 c1 c2 c3 + +-- | Grabs chromatic aberration correction parameters from Rift. +chromaAbCorrectionInfo :: RiftHandle -> IO ChromaAbCorrectionInfo +chromaAbCorrectionInfo _ = (`runContT` id) $ do + chromaAbCorrection0' <- ContT alloca + chromaAbCorrection1' <- ContT alloca + chromaAbCorrection2' <- ContT alloca + chromaAbCorrection3' <- ContT alloca + liftIO $ do + c_populateChromaAbCorrectionInfo + chromaAbCorrection0' + chromaAbCorrection1' + chromaAbCorrection2' + chromaAbCorrection3' + return $ ChromaAbCorrectionInfo + <$> (fmap realToFrac . peek) chromaAbCorrection0' + <*> (fmap realToFrac . peek) chromaAbCorrection1' + <*> (fmap realToFrac . peek) chromaAbCorrection2' + <*> (fmap realToFrac . peek) chromaAbCorrection3'