diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2015 Brian W Bush + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/ReadMe.md b/ReadMe.md new file mode 100644 --- /dev/null +++ b/ReadMe.md @@ -0,0 +1,44 @@ +Bindings for VRPN +================= + +This package contains bindings to VRPN, <> and is loosely modeled on the code in <>. This has been tested using VRPN 07.30 on Linux. It requires the VRPN C++ header files. + +Please report issues at <>. + + +Skeletal example illustrating the use of VRPN bindings +------------------------------------------------------ + +```haskell +data ButtonType = LeftButton | RightButton + deriving (Enum, Eq, Show) + +main :: IO () +main = + do + putStrLn "Press the left button to exit." + done <- newEmptyMVar + let + -- A remote button that signals completion when the left button is released. + button :: Device Int ButtonType Double + button = + Button "spacenav0@localhost" + $ Just + $ \time button state -> + do + print (time, button, state) + if button == LeftButton && not state + then void $ tryPutMVar done () + else return () + -- An analog device. + analog :: Device Int Int Int Double + analog = Analog "spacenav0@localhost" + $ Just + $ curry print + -- Open the remote devices. + devices <- sequence [openDevice button, openDevice analog] + -- Loop until a signal to complete is received. + mainLoops (not <$> isEmptyMVar done) 10 devices + -- Close the remote devices. + mapM_ closeDevice devices +``` 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/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,51 @@ +{-| +Module : Main +Copyright : (c) 2015 Brian W Bush +License : MIT +Maintainer : Brian W Bush +Stability : Stable +Portability : Portable + +Simple VRPN client. +-} + + +module Main ( + main +) where + + +import Network.VRPN (Device(..), closeDevice, mainLoops, openDevice) +import System.Environment (getArgs) +import System.IO (hFlush, stdout) + + +-- | Action for a simple VRPN client. +main :: IO () +main = + do + names <- getArgs + let + out s = putStrLn s >> hFlush stdout + devices :: [Device Int Int Int Double] + devices = + concat + [ + [ + Tracker name + (Just $ \t s p o -> out $ show t ++ ", sensor " ++ show s ++ ", position " ++ show p ++ ", orientation " ++ show o) + (Just $ \t s v o d -> out $ show t ++ ", sensor " ++ show s ++ ", velocity " ++ show v ++ ", orientation " ++ show o ++ ", delta " ++ show d) + (Just $ \t s a o d -> out $ show t ++ ", sensor " ++ show s ++ ", acceleration " ++ show a ++ ", orientation " ++ show o ++ ", delta " ++ show d) + , Button name + (Just $ \t b p -> out $ show t ++ ", button " ++ show b ++ ", pressed " ++ show p) + , Analog name + (Just $ \t v -> out $ show t ++ ", analog " ++ show v) + , Dial name + (Just $ \t d c -> out $ show t ++ ", dial " ++ show d ++ ", change " ++ show c) + ] + | + name <- names + ] + remotes <- mapM openDevice devices + mainLoops (return False) (10 :: Double) remotes + mapM_ closeDevice remotes diff --git a/src/Network/VRPN.hs b/src/Network/VRPN.hs new file mode 100644 --- /dev/null +++ b/src/Network/VRPN.hs @@ -0,0 +1,501 @@ +{-| +Module : Network.VRPN +Copyright : (c) 2015 Brian W Bush +License : MIT +Maintainer : Brian W Bush +Stability : Stable +Portability : Portable + +Bindings to VRPN, \<\>, and is loosely modeled on the code in \<\>. This has been tested using VRPN 07.30 on Linux. It requires the VRPN C++ header files. + +Here is a simple example that illustrates the use of this module: + +@ +data ButtonType = LeftButton | RightButton + deriving (Enum, Eq, Show) + +main :: IO () +main = + do + putStrLn "Press the left button to exit." + done <- newEmptyMVar + let + -- A remote button that signals completion when the left button is released. + button :: Device Int ButtonType Double + button = + Button "spacenav0@localhost" + $ Just + $ \time button state -> + do + print (time, button, state) + if button == LeftButton && not state + then void $ tryPutMVar done () + else return () + -- An analog device. + analog :: Device Int Int Int Double + analog = Analog "spacenav0@localhost" + $ Just + $ curry print + -- Open the remote devices. + devices <- sequence [openDevice button, openDevice analog] + -- Loop until a signal to complete is received. + mainLoops (not <$> isEmptyMVar done) 10 devices + -- Close the remote devices. + mapM_ closeDevice devices +@ +-} + + +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE RecordWildCards #-} + + +module Network.VRPN ( +-- * Devices + Device(..) +, RemoteDevice +-- * Callbacks +, PositionCallback +, VelocityCallback +, AccelerationCallback +, ButtonCallback +, AnalogCallback +, DialCallback +, ExitCallback +-- * Operations on devices +, openDevice +, closeDevice +, mainLoop +, mainLoops +-- * Time +, TimeVal(..) +, sleep +) where + + +import Control.Monad (unless) +import Foreign.C.String (CString, withCString) +import Foreign.C.Types (CDouble(..), CInt(..), CLong(..)) +import Foreign.Concurrent (newForeignPtr) +import Foreign.Marshal.Array (peekArray) +import Foreign.ForeignPtr (ForeignPtr, finalizeForeignPtr, withForeignPtr) +import Foreign.Ptr (FunPtr, Ptr, freeHaskellFunPtr, nullFunPtr) + + +-- | A VRPN device. +data Device s b d a = + -- | A tracker. + Tracker + { + device :: String -- ^ The device name. + , positionCallback :: Maybe (PositionCallback s a) -- ^ The position callback. + , velocityCallback :: Maybe (VelocityCallback s a) -- ^ The velocity callback. + , accelerationCallback :: Maybe (AccelerationCallback s a) -- ^ The acceleration callback. + } + -- | A button. + | Button + { + device :: String -- ^ The device name. + , buttonCallback :: Maybe (ButtonCallback b) -- ^ The button callback. + } + -- | An analog device. + | Analog + { + device :: String -- ^ The device name. + , analogCallback :: Maybe (AnalogCallback a) -- ^ The analog callback. + } + -- | A dial. + | Dial + { + device :: String -- ^ The device name. + , dialCallback :: Maybe (DialCallback d a) -- ^ The dial callback. + } + + +-- | Timestamps in seconds and fractions of a section. +data TimeVal = + TimeVal + { + timeSeconds :: Int -- ^ The seconds. + , timeMicroSeconds :: Int -- ^ The microseconds. + } + deriving (Eq, Ord, Read, Show) + + +-- | Callback for position information. +type PositionCallback s a = TimeVal -- ^ The timestamp. + -> s -- ^ Which sensor is reporting. + -> (a, a, a) -- ^ The position vector. + -> (a, a, a, a) -- ^ The orientation quaternion. + -> IO () -- ^ The action performed by the callback. + + +-- | Callback for position information. +type PositionCallback' = CLong -- ^ Seconds of the timestamp. + -> CLong -- ^ Microseconds of the timestamp. + -> CInt -- ^ Which sensor is reporting. + -> CDouble -- ^ 1st component of the position vector. + -> CDouble -- ^ 2nd component of the position vector. + -> CDouble -- ^ 3rd component of the position vector. + -> CDouble -- ^ 1st component of the orientation quaternion. + -> CDouble -- ^ 2nd component of the orientation quaternion. + -> CDouble -- ^ 3rd component of the orientation quaternion. + -> CDouble -- ^ 4th component of the orientation quaternion. + -> IO () -- ^ The action performed by the callback. + +-- | Wrap a position callback. +foreign import ccall "wrapper" + wrapPositionCallback :: PositionCallback' -> IO (FunPtr PositionCallback') + + +-- | Make a position callback suitable for FFI. +makePositionCallback :: (Enum s, RealFloat a) + => PositionCallback s a -- ^ The callback. + -> PositionCallback' -- ^ An equivalent FFI callback. +makePositionCallback callback seconds microseconds sensor px py pz ox oy oz ow = + callback + (TimeVal (fromEnum seconds) (fromEnum microseconds)) + (toEnum $ fromEnum sensor) + (realToFrac px, realToFrac py, realToFrac pz) + (realToFrac ox, realToFrac oy, realToFrac oz, realToFrac ow) + + +-- | Callback for velocity information. +type VelocityCallback s a = TimeVal -- ^ The timestamp. + -> s -- ^ Which sensor is reporting. + -> (a, a, a) -- ^ The velocity vector. + -> (a, a, a, a) -- ^ The future orientation quaternion. + -> a -- ^ Delta time for the future orientation quaternion, in seconds. + -> IO () -- ^ The action performed by the callback. + + +-- | Callback for velocity information. +type VelocityCallback' = CLong -- ^ Seconds of the timestamp. + -> CLong -- ^ Microseconds of the timestamp. + -> CInt -- ^ Which sensor is reporting. + -> CDouble -- ^ 1st component of the velocity vector. + -> CDouble -- ^ 2nd component of the velocity vector. + -> CDouble -- ^ 3rd component of the velocity vector. + -> CDouble -- ^ 1st component of the future orientation quaternion. + -> CDouble -- ^ 2nd component of the future orientation quaternion. + -> CDouble -- ^ 3rd component of the future orientation quaternion. + -> CDouble -- ^ 4th component of the future orientation quaternion. + -> CDouble -- ^ Delta time for the future orientation quaternion, in seconds. + -> IO () -- ^ The action performed by the callback. + + +-- | Wrap a velocity callback. +foreign import ccall "wrapper" + wrapVelocityCallback :: VelocityCallback' -> IO (FunPtr VelocityCallback') + + +-- | Make a velocity callback suitable for FFI. +makeVelocityCallback :: (Enum s, RealFloat a) + => VelocityCallback s a -- ^ The callback. + -> VelocityCallback' -- ^ An equivalent FFI callback. +makeVelocityCallback callback seconds microseconds sensor vx vy vz ox oy oz ow dt = + callback + (TimeVal (fromEnum seconds) (fromEnum microseconds)) + (toEnum $ fromEnum sensor) + (realToFrac vx, realToFrac vy, realToFrac vz) + (realToFrac ox, realToFrac oy, realToFrac oz, realToFrac ow) + (realToFrac dt) + + +-- | Callback for acceleration information. +type AccelerationCallback s a = TimeVal -- ^ The timestamp. + -> s -- ^ Which sensor is reporting. + -> (a, a, a) -- ^ The acceleration vector. + -> (a, a, a, a) -- ^ The acceleration orientation quaternion. + -> a -- ^ Delta time for the acceleration quaternion, in seconds. + -> IO () -- ^ The action performed by the callback. + + +-- | Callback for acceleration information. +type AccelerationCallback' = CLong -- ^ Seconds of the timestamp. + -> CLong -- ^ Microseconds of the timestamp. + -> CInt -- ^ Which sensor is reporting. + -> CDouble -- ^ 1st component of the acceleration vector. + -> CDouble -- ^ 2nd component of the acceleration vector. + -> CDouble -- ^ 3rd component of the acceleration vector. + -> CDouble -- ^ 1st component of the acceleration quaternion. + -> CDouble -- ^ 2nd component of the acceleration quaternion. + -> CDouble -- ^ 3rd component of the acceleration quaternion. + -> CDouble -- ^ 4th component of the acceleration quaternion. + -> CDouble -- ^ Delta time for the acceleration quaternion, in seconds. + -> IO () -- ^ The action performed by the callback. + + +-- | Wrap an acceleration callback. +foreign import ccall "wrapper" + wrapAccelerationCallback :: AccelerationCallback' -> IO (FunPtr AccelerationCallback') + + +-- | Make an acceleration callback suitable for FFI. +makeAccelerationCallback :: (Enum s, RealFloat a) + => AccelerationCallback s a -- ^ The callback. + -> AccelerationCallback' -- ^ An equivalent FFI callback. +makeAccelerationCallback callback seconds microseconds sensor ax ay az ox oy oz ow dt = + callback + (TimeVal (fromEnum seconds) (fromEnum microseconds)) + (toEnum $ fromEnum sensor) + (realToFrac ax, realToFrac ay, realToFrac az) + (realToFrac ox, realToFrac oy, realToFrac oz, realToFrac ow) + (realToFrac dt) + + +-- | Callback for button information. +type ButtonCallback b = TimeVal -- ^ The timestamp. + -> b -- ^ Which button was pressed, counting from 0. + -> Bool -- ^ Whether the button is pressed. + -> IO () -- ^ The action performed by the callback. + + +-- | Callback for button information. +type ButtonCallback' = CLong -- ^ Seconds of the timestamp. + -> CLong -- ^ Microseconds of the timestamp. + -> CInt -- ^ Which button was pressed, counting from 0. + -> CInt -- ^ The button state (0 = off, 1 = on). + -> IO () -- ^ The action performed by the callback. + + +-- | Wrap a button callback. +foreign import ccall "wrapper" + wrapButtonCallback :: ButtonCallback' -> IO (FunPtr ButtonCallback') + + +-- | Make a button callback suitable for FFI. +makeButtonCallback :: Enum b + => ButtonCallback b -- ^ The callback. + -> ButtonCallback' -- ^ An equivalent FFI callback. +makeButtonCallback callback seconds microseconds button state = + callback + (TimeVal (fromEnum seconds) (fromEnum microseconds)) + (toEnum $ fromEnum button) + (state /= 0) + + +-- | Callback for analog information. +type AnalogCallback a = TimeVal -- ^ The timestamp. + -> [a] -- ^ The analog values. + -> IO () -- ^ The action performed by the callback. + + +-- | Callback for analog information. +type AnalogCallback' = CLong -- ^ Seconds of the timestamp. + -> CLong -- ^ Microseconds of the timestamp. + -> CInt -- ^ The number of values. + -> Ptr CDouble -- ^ The analog values. + -> IO () -- ^ The action performed by the callback. + + +-- | Wrap an analog callback. +foreign import ccall "wrapper" + wrapAnalogCallback :: AnalogCallback' -> IO (FunPtr AnalogCallback') + + +-- | Make an analog callback suitable for FFI. +makeAnalogCallback :: RealFloat a + => AnalogCallback a -- ^ The callback. + -> AnalogCallback' -- ^ An equivalent FFI callback. +makeAnalogCallback callback seconds microseconds n ptr = + do + values <- peekArray (fromEnum n) ptr + callback + (TimeVal (fromEnum seconds) (fromEnum microseconds)) + (map realToFrac values) + + +-- | Callback for dial information. +type DialCallback d a = TimeVal -- ^ The timestamp. + -> d -- ^ Which dial changed. + -> a -- ^ The fraction of a revolution it changed. + -> IO () -- ^ The action performed by the callback. + + +-- | Callback for dial information. +type DialCallback' = CLong -- ^ Seconds of the timestamp. + -> CLong -- ^ Microseconds of the timestamp. + -> CInt -- ^ Which dial changed. + -> CDouble -- ^ The fraction of a revolution it changed. + -> IO () -- ^ The action performed by the callback. + + +-- | Wrap a dial callback. +foreign import ccall "wrapper" + wrapDialCallback :: DialCallback' -> IO (FunPtr DialCallback') + + +-- | Make an analog callback suitable for FFI. +makeDialCallback :: (Enum d, RealFloat a) + => DialCallback d a -- ^ The callback. + -> DialCallback' -- ^ An equivalent FFI callback. +makeDialCallback callback seconds microseconds dial value = + callback + (TimeVal (fromEnum seconds) (fromEnum microseconds)) + (toEnum $ fromEnum dial) + (realToFrac value) + + +-- | Callback for exiting the main loop. +type ExitCallback = IO Bool -- ^ An action indicate whether to exit the main loop. + + +-- | A remote object. +data Remote + + +-- | Construct a remote tracker. +foreign import ccall "makeTracker" + makeTracker :: CString -> FunPtr PositionCallback' -> FunPtr VelocityCallback' -> FunPtr AccelerationCallback' -> IO (Ptr Remote) + + +-- | Run the main loop of a remote tracker. +foreign import ccall "mainloopTracker" + mainloopTracker :: Ptr Remote -> IO () + + +-- | Destroy a remote tracker. +foreign import ccall "deleteTracker" + deleteTracker :: Ptr Remote -> IO () + + +-- | Construct a remote button. +foreign import ccall "makeButton" + makeButton :: CString -> FunPtr ButtonCallback' -> IO (Ptr Remote) + + +-- | Run the main loop of a remote button. +foreign import ccall "mainloopButton" + mainloopButton :: Ptr Remote -> IO () + + +-- | Destory a remote button. +foreign import ccall "deleteButton" + deleteButton :: Ptr Remote -> IO () + + +-- | Construct a remote analog. +foreign import ccall "makeAnalog" + makeAnalog :: CString -> FunPtr AnalogCallback' -> IO (Ptr Remote) + + +-- | Run the main loop of a remote analog. +foreign import ccall "mainloopAnalog" + mainloopAnalog :: Ptr Remote -> IO () + + +-- | Destroy a remote analog. +foreign import ccall "deleteAnalog" + deleteAnalog :: Ptr Remote -> IO () + + +-- | Construction a remote dial. +foreign import ccall "makeDial" + makeDial :: CString -> FunPtr DialCallback' -> IO (Ptr Remote) + + +-- | Run the main loop of a remote dial. +foreign import ccall "mainloopDial" + mainloopDial :: Ptr Remote -> IO () + + +-- | Destory a remote dial. +foreign import ccall "deleteDial" + deleteDial :: Ptr Remote -> IO () + + +-- | Sleep for the specified milliseconds. +foreign import ccall "vrpnSleep" + vrpnSleep :: CDouble -> IO () + + +-- | Sleep for the specified amount of time. +sleep :: RealFloat a => a -- ^ The number of milliseconds. + -> IO () -- ^ An action to sleep the specified amount of time +sleep = vrpnSleep . realToFrac + + +-- | A remote VRPN device. +newtype RemoteDevice = RemoteDevice (ForeignPtr Remote, ForeignPtr Remote -> IO ()) + + +-- | Open a remote VRPN device. +openDevice :: (Enum s, Enum b, Enum d, RealFloat a) + => Device s b d a -- ^ The device. + -> IO RemoteDevice -- ^ An action for opening the device. +openDevice Tracker{..} = + do + positionCallback' <- maybe (return nullFunPtr) (wrapPositionCallback . makePositionCallback ) positionCallback + velocityCallback' <- maybe (return nullFunPtr) (wrapVelocityCallback . makeVelocityCallback ) velocityCallback + accelerationCallback' <- maybe (return nullFunPtr) (wrapAccelerationCallback . makeAccelerationCallback) accelerationCallback + ptr <- + withCString device $ \device' -> + makeTracker device' positionCallback' velocityCallback' accelerationCallback' + ptr' <- + newForeignPtr ptr $ do + deleteTracker ptr + freeHaskellFunPtr positionCallback' + freeHaskellFunPtr velocityCallback' + freeHaskellFunPtr accelerationCallback' + return $ RemoteDevice (ptr', flip withForeignPtr mainloopTracker) +openDevice Button{..} = + do + buttonCallback' <- maybe (return nullFunPtr) (wrapButtonCallback . makeButtonCallback) buttonCallback + ptr <- + withCString device $ \device' -> + makeButton device' buttonCallback' + ptr' <- + newForeignPtr ptr $ do + deleteButton ptr + freeHaskellFunPtr buttonCallback' + return $ RemoteDevice (ptr', flip withForeignPtr mainloopButton) +openDevice Analog{..} = + do + analogCallback' <- maybe (return nullFunPtr) (wrapAnalogCallback . makeAnalogCallback) analogCallback + ptr <- + withCString device $ \device' -> + makeAnalog device' analogCallback' + ptr' <- + newForeignPtr ptr $ do + deleteAnalog ptr + freeHaskellFunPtr analogCallback' + return $ RemoteDevice (ptr', flip withForeignPtr mainloopAnalog) +openDevice Dial{..} = + do + dialCallback' <- maybe (return nullFunPtr) (wrapDialCallback . makeDialCallback) dialCallback + ptr <- + withCString device $ \device' -> + makeDial device' dialCallback' + ptr' <- + newForeignPtr ptr $ do + deleteDial ptr + freeHaskellFunPtr dialCallback' + return $ RemoteDevice (ptr', flip withForeignPtr mainloopDial) + + +-- | Close a remote device. +closeDevice :: RemoteDevice -- ^ The device. + -> IO () -- ^ An action for closing the device. +closeDevice (RemoteDevice (device, _)) = finalizeForeignPtr device + + +-- | Run the main loop of a device *once*. +mainLoop :: RemoteDevice -- ^ The device. + -> IO () -- ^ An action for running the main loop of the device *once*. +mainLoop (RemoteDevice (device, mainloopDevice)) = mainloopDevice device + + +-- | Run the main loops of devices *repeatedly*. +mainLoops :: RealFloat a + => ExitCallback -- ^ Callback for exiting the loop. + -> a -- ^ The number of milliseconds to idle after each device's main loop is run once. + -> [RemoteDevice] -- ^ The devices. + -> IO () -- ^ An action for running the main loops *repeatedly*. +mainLoops exitCallback milliseconds devices = + do + mapM_ mainLoop devices + sleep milliseconds + exit <- exitCallback + unless exit + $ mainLoops exitCallback milliseconds devices diff --git a/src/vrpn.cpp b/src/vrpn.cpp new file mode 100644 --- /dev/null +++ b/src/vrpn.cpp @@ -0,0 +1,208 @@ +#include +#include +#include +#include +#include +#include + + +typedef void (PositionCallback)(long, long, int, double, double, double, double, double, double, double); + + +void VRPN_CALLBACK handle_tracker_pos_quat(void *callback, const vrpn_TRACKERCB tracker) +{ + ((PositionCallback*) callback)( + tracker.msg_time.tv_sec + , tracker.msg_time.tv_usec + , tracker.sensor + , tracker.pos[0] + , tracker.pos[1] + , tracker.pos[2] + , tracker.quat[0] + , tracker.quat[1] + , tracker.quat[2] + , tracker.quat[3] + ); +} + + +typedef void (VelocityCallback)(long, long, int, double, double, double, double, double, double, double, double); + + +void VRPN_CALLBACK handle_tracker_vel(void *callback, const vrpn_TRACKERVELCB tracker) +{ + ((VelocityCallback*) callback)( + tracker.msg_time.tv_sec + , tracker.msg_time.tv_usec + , tracker.sensor + , tracker.vel[0] + , tracker.vel[1] + , tracker.vel[2] + , tracker.vel_quat[0] + , tracker.vel_quat[1] + , tracker.vel_quat[2] + , tracker.vel_quat[3] + , tracker.vel_quat_dt + ); +} + + +typedef void (AccelerationCallback)(long, long, int, double, double, double, double, double, double, double, double); + + +void VRPN_CALLBACK handle_tracker_acc(void *callback, const vrpn_TRACKERACCCB tracker) +{ + ((AccelerationCallback*) callback)( + tracker.msg_time.tv_sec + , tracker.msg_time.tv_usec + , tracker.sensor + , tracker.acc[0] + , tracker.acc[1] + , tracker.acc[2] + , tracker.acc_quat[0] + , tracker.acc_quat[1] + , tracker.acc_quat[2] + , tracker.acc_quat[3] + , tracker.acc_quat_dt + ); +} + + +typedef void (ButtonCallback)(long, long, int, int); + + +void VRPN_CALLBACK handle_button(void *callback, const vrpn_BUTTONCB button) +{ + ((ButtonCallback*) callback)( + button.msg_time.tv_sec + , button.msg_time.tv_usec + , button.button + , button.state + ); +} + + +typedef void (AnalogCallback)(long, long, int, const double*); + + +void VRPN_CALLBACK handle_analog (void *callback, const vrpn_ANALOGCB analog) +{ + ((AnalogCallback*) callback)( + analog.msg_time.tv_sec + , analog.msg_time.tv_usec + , analog.num_channel + , analog.channel + ); +} + + +typedef void (DialCallback)(long, long, int, double); + + +void VRPN_CALLBACK handle_dial(void *callback, const vrpn_DIALCB dial) +{ + ((DialCallback*) callback)( + dial.msg_time.tv_sec + , dial.msg_time.tv_usec + , dial.dial + , dial.change + ); +} + + +extern "C" vrpn_Tracker_Remote* makeTracker(char* device, PositionCallback positionCallback, VelocityCallback velocityCallback, AccelerationCallback accelerationCallback) +{ + vrpn_Tracker_Remote* tracker = new vrpn_Tracker_Remote(device); + if (tracker && positionCallback) + tracker->register_change_handler((void*) positionCallback, handle_tracker_pos_quat); + if (tracker && velocityCallback) + tracker->register_change_handler((void*) velocityCallback, handle_tracker_vel); + if (tracker && accelerationCallback) + tracker->register_change_handler((void*) accelerationCallback, handle_tracker_acc); + return tracker; +} + + +extern "C" void mainloopTracker(vrpn_Tracker_Remote* tracker) +{ + if (tracker) + tracker->mainloop(); +} + + +extern "C" void deleteTracker(vrpn_Tracker_Remote* tracker) +{ + delete tracker; +} + + +extern "C" vrpn_Button_Remote* makeButton(char* device, ButtonCallback buttonCallback) +{ + vrpn_Button_Remote* button = new vrpn_Button_Remote(device); + if (button && buttonCallback) + button->register_change_handler((void*) buttonCallback, handle_button); + return button; +} + + +extern "C" void mainloopButton(vrpn_Button_Remote* button) +{ + if (button) + button->mainloop(); +} + + +extern "C" void deleteButton(vrpn_Button_Remote* button) +{ + delete button; +} + + +extern "C" vrpn_Analog_Remote* makeAnalog(char* device, AnalogCallback analogCallback) +{ + vrpn_Analog_Remote* analog = new vrpn_Analog_Remote(device); + if (analog && analogCallback) + analog->register_change_handler((void*) analogCallback, handle_analog); + return analog; +} + + +extern "C" void mainloopAnalog(vrpn_Analog_Remote* analog) +{ + if (analog) + analog->mainloop(); +} + + +extern "C" void deleteAnalog(vrpn_Analog_Remote* analog) +{ + delete analog; +} + + +extern "C" vrpn_Dial_Remote* makeDial(char* device, DialCallback dialCallback) +{ + vrpn_Dial_Remote* dial = new vrpn_Dial_Remote(device); + if (dial && dialCallback) + dial->register_change_handler((void*) dialCallback, handle_dial); + return dial; +} + + +extern "C" void mainloopDial(vrpn_Dial_Remote* dial) +{ + if (dial) + dial->mainloop(); +} + + +extern "C" void deleteDial(vrpn_Dial_Remote* dial) +{ + delete dial; +} + + +extern "C" void vrpnSleep(long t) +{ + vrpn_SleepMsecs(t); +} diff --git a/vrpn.cabal b/vrpn.cabal new file mode 100644 --- /dev/null +++ b/vrpn.cabal @@ -0,0 +1,43 @@ +name: vrpn +version: 0.2.0.0 +synopsis: Bindings to VRPN. +description: See \<\> for information on VRPN. This has been tested using VRPN 07.30 on Linux. +license: MIT +license-file: LICENSE +author: Brian W Bush +maintainer: Brian W Bush +copyright: (c) 2015 Brian W Bush +category: Network +build-type: Simple +cabal-version: >= 1.10 +homepage: https://bitbucket.org/bwbush/vrpn +bug-reports: https://bwbush.atlassian.net/projects/HVRPN/issues/ +package-url: https://bitbucket.org/bwbush/vrpn/vrp-0.2.0.0.tar.gz + +extra-source-files: ReadMe.md + +source-repository head + type: git + location: https://bwbush@bitbucket.org/bwbush/vrpn.git + +library + exposed-modules: Network.VRPN + build-depends: base >= 4.8.1 && < 5 + hs-source-dirs: src + ghc-options: -Wall + default-language: Haskell2010 + C-sources: src/vrpn.cpp + include-dirs: /usr/local/include + extra-lib-dirs: /usr/local/lib + extra-libraries: vrpn stdc++ + +executable test-vrpn + main-is: Main.hs + build-depends: base + hs-source-dirs: src + ghc-options: -Wall + default-language: Haskell2010 + C-sources: src/vrpn.cpp + include-dirs: /usr/local/include + extra-lib-dirs: /usr/local/lib + extra-libraries: vrpn stdc++