opengl-spacenavigator (empty) → 0.1.2.0
raw patch · 6 files changed
+596/−0 lines, 6 filesdep +GLUTdep +OpenGLdep +basesetup-changed
Dependencies added: GLUT, OpenGL, base, data-default
Files
- LICENSE +20/−0
- ReadMe.md +51/−0
- Setup.hs +2/−0
- opengl-spacenavigator.cabal +40/−0
- src/Graphics/UI/SpaceNavigator.hs +320/−0
- src/Main.hs +163/−0
+ LICENSE view
@@ -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.
+ ReadMe.md view
@@ -0,0 +1,51 @@+Functions for using SpaceNavigator-compatible 3D Mice with OpenGL+=================================================================++This Haskell package contains functions for managing input from a SpaceNavigator <<http://www.3dconnexion.com/products/spacemouse/spacenavigator.html>>, or a 3D mouse compatible with its protocols. OpenGL callbacks are provided, along with utilities for quantizing the input from the mouse or tracking its six degrees of freedom.+++Skeletal example illustrating the use of a SpaceNavigator with OpenGL+---------------------------------------------------------------------++```haskell+main :: IO ()+main = do+ _ <- getArgsAndInitialize+ initialDisplayMode $= [WithDepthBuffer, DoubleBuffered]+ _ <- createWindow "SpaceNavigator OpenGL Example"+ depthFunc $= Just Less + -- Create the tracker.+ tracking <- newIORef $ def {spaceNavigatorPosition = Vector3 0 0 0}+ -- Register a callback which quantizes and tracks the 3D mouse input.+ spaceNavigatorCallback $=! Just ( quantizeSpaceNavigator defaultQuantization $ trackSpaceNavigator defaultTracking tracking)+ -- The display callback needs the tracker.+ displayCallback $= display tracking+ idleCallback $= Just (postRedisplay Nothing)+ mainLoop++display :: IORef SpaceNavigatorTrack -> DisplayCallback+display tracking =+ do+ clear [ColorBuffer, DepthBuffer]+ loadIdentity+ -- Get the tracking state.+ tracking' <- get tracking+ -- Update the matrix based on the tracking+ doTracking tracking'+ -- All of the rendering actions go here.+ renderPrimitive . . . + swapBuffers+```+++Notes on hardware and software+------------------------------++This code has been validated with the following configuration of hardware and software:++* SpaceNavigator <<http://www.3dconnexion.com/products/spacemouse/spacenavigator.html>>+* spacenavd <<http://spacenav.sourceforge.net/>>, 0.5+* Ubuntu 15.04, 64-bit+* GHC 7.6.3+* OpenGL == 2.8.0.0+* GLUT == 2.4.0.0
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
@@ -0,0 +1,40 @@+name: opengl-spacenavigator+version: 0.1.2.0+synopsis: Library and example for using a SpaceNavigator-compatible 3-D mouse with OpenGL+description: This package contains functions for managing input from a SpaceNavigator \<<http://www.3dconnexion.com/products/spacemouse/spacenavigator.html>\>, or a 3D mouse compatible with its protocols. OpenGL callbacks are provided, along with utilities for quantizing the input from the mouse or tracking its six degrees of freedom.+license: MIT+license-file: LICENSE+author: Brian W Bush <consult@brianwbush.info>+maintainer: Brian W Bush <consult@brianwbush.info>+copyright: (c) 2015 Brian W Bush+category: Graphics+build-type: Simple+cabal-version: >=1.10+stability: Stable+homepage: https://bitbucket.org/bwbush/opengl-spacenavigator+bug-reports: https://bwbush.atlassian.net/projects/HOGLSPNV/issues/+package-url: https://bitbucket.org/bwbush/opengl-spacenavigator/downloads/opengl-spacenavigator-0.1.2.0.tar.gz++extra-source-files: ReadMe.md++source-repository head+ type: git+ location: https://bwbush@bitbucket.org/bwbush/opengl-spacenavigator+ +library+ exposed-modules: Graphics.UI.SpaceNavigator+ build-depends: base >= 4.6 && < 5+ , data-default+ , GLUT >= 2.4+ , OpenGL >= 2.8+ hs-source-dirs: src+ default-language: Haskell2010++executable opengl-spacenavigator+ main-is: Main.hs+ build-depends: base >= 4.6 && < 5+ , data-default+ , GLUT >= 2.4+ , OpenGL >= 2.8+ hs-source-dirs: src+ default-language: Haskell2010
@@ -0,0 +1,320 @@+{-|+Module : Graphics.UI.SpaceNavigator+Copyright : (c) 2015 Brian W Bush+License : MIT+Maintainer : Brian W Bush <consult@brianwbush.info>+Stability : Stable+Portability : Portable++Functions for managing input from a SpaceNavigator \<<http://www.3dconnexion.com/products/spacemouse/spacenavigator.html>\>, or a 3D mouse compatible with its protocols. OpenGL callbacks are provided, along with utilities for quantizing the input from the mouse or tracking its six degrees of freedom.++Here is a simple example illustating the use of this module:++@+main :: IO ()+main = do+ _ <- getArgsAndInitialize+ initialDisplayMode $= [WithDepthBuffer, DoubleBuffered]+ _ <- createWindow \"SpaceNavigator OpenGL Example\"+ depthFunc $= Just Less + -- Create the tracker.+ tracking <- newIORef $ def {spaceNavigatorPosition = Vector3 0 0 0}+ -- Register a callback which quantizes and tracks the 3D mouse input.+ spaceNavigatorCallback $=! Just ( quantizeSpaceNavigator defaultQuantization $ trackSpaceNavigator defaultTracking tracking)+ -- The display callback needs the tracker.+ displayCallback $= display tracking+ idleCallback $= Just (postRedisplay Nothing)+ mainLoop++display :: IORef SpaceNavigatorTrack -> DisplayCallback+display tracking =+ do+ clear [ColorBuffer, DepthBuffer]+ loadIdentity+ -- Get the tracking state.+ tracking' <- get tracking+ -- Update the matrix based on the tracking+ doTracking tracking'+ -- All of the rendering actions go here.+ renderPrimitive . . . + swapBuffers+@++This code has been validated with the following configuration of hardware and software:++* SpaceNavigator \<<http://www.3dconnexion.com/products/spacemouse/spacenavigator.html>\>++* spacenavd \<<http://spacenav.sourceforge.net/>\>, 0.5++* Ubuntu 15.04, 64-bit++* GHC 7.6.3++* OpenGL == 2.8.0.0++* GLUT == 2.4.0.0+-}+++{-# LANGUAGE RecordWildCards #-}+++module Graphics.UI.SpaceNavigator (+-- * Input+ SpaceNavigatorInput(..)+, Button(..)+, ButtonAction(..)+, SpaceNavigatorCallback+, spaceNavigatorCallback+-- * Quantization+, quantize+, defaultQuantization+-- * Tracking+, Track(..)+, TrackMode(..)+, defaultTracking+, track+, doTracking+) where+++import Control.Applicative ((<*>), (<$>))+import Control.Monad (when)+import Data.Default (Default(..))+import Data.IORef (IORef)+import Graphics.Rendering.OpenGL (GLfloat, Vector3(..), rotate, translate)+import Graphics.UI.GLUT (KeyState(..), SettableStateVar, SpaceballInput(..), ($=!), ($~!), makeSettableStateVar, spaceballCallback)+++-- | Input received from a SpaceNavigator 3D mouse.+data SpaceNavigatorInput =+ -- | The mouse has been pushed.+ Push+ {+ pushRightward :: GLfloat -- ^ The amount of rightward push, from -1 to +1.+ , pushUpward :: GLfloat -- ^ The amount of upward push, from -1 to +1.+ , pushBackward :: GLfloat -- ^ The amount of backward push, from -1 to +1.+ }+ -- | The mouse has been tilted.+ | Tilt+ {+ tiltForward :: GLfloat -- ^ The amount of forward tilt, from -1 to +1.+ , tiltClockwise :: GLfloat -- ^ The amount of clockwise twist, from -1 to +1.+ , tiltRightward :: GLfloat -- ^ The amount of rightward tilt, from -1 to +1.+ }+ -- | A mouse button has been pressed.+ | Button+ {+ buttonPress :: Button -- ^ Which button has been pressed.+ , buttonAction :: ButtonAction -- ^ Whether the button has been pressed or released.+ }+ deriving (Eq, Read, Show)+++-- | Buttons on a SpaceNavigator 3D mouse.+data Button =+ ButtonLeft -- ^ The left button.+ | ButtonRight -- ^ The right button.+ | ButtonOther Int -- ^ Neither the left nor the right button.+ deriving (Eq, Read, Show)+++-- | Pressing and releasing actions on a SpaceNavigator 3D mouse.+data ButtonAction =+ ButtonPress -- ^ The button has been pressed.+ | ButtonRelease -- ^ The button has been released.+ deriving (Eq, Read, Show)+++-- | Interpret SpaceBall input as SpaceNavigator input.+interpretSpaceball :: SpaceballInput -- ^ The SpaceBall input.+ -> SpaceNavigatorInput -- ^ The corresponding SpaceNavigator input.+interpretSpaceball (SpaceballMotion rightward upward forward) =+ Push+ {+ pushRightward = fromIntegral rightward / 1000+ , pushUpward = fromIntegral upward / 1000+ , pushBackward = - fromIntegral forward / 1000+ }+interpretSpaceball (SpaceballRotation backward counterClockwise rightward) =+ Tilt+ {+ tiltForward = - fromIntegral backward / 1800+ , tiltClockwise = - fromIntegral counterClockwise / 1800+ , tiltRightward = fromIntegral rightward / 1800+ }+interpretSpaceball (SpaceballButton button keyState) =+ Button+ {+ buttonPress = case button of+ 0 -> ButtonLeft+ 1 -> ButtonRight+ i -> ButtonOther i+ , buttonAction = case keyState of+ Down -> ButtonPress+ Up -> ButtonRelease+ }+++-- | A callback for input from the SpaceNavigator 3D mouse.+type SpaceNavigatorCallback = SpaceNavigatorInput -> IO ()+++-- | Register the callback for input from the SpaceNavigator 3D mouse.+spaceNavigatorCallback :: SettableStateVar (Maybe SpaceNavigatorCallback)+spaceNavigatorCallback =+ makeSettableStateVar setSpaceNavigatorCallback+ where+ setSpaceNavigatorCallback :: Maybe SpaceNavigatorCallback -> IO ()+ setSpaceNavigatorCallback Nothing = spaceballCallback $=! Nothing+ setSpaceNavigatorCallback (Just callback) = spaceballCallback $=! Just (callback . interpretSpaceball)+++-- | Quantize the input from a SpaceNavigator 3D mouse according to whether the input exceeds a threshold. The quantized input is -1, +1, or 0, depending on whether a threshold is exceeded.+quantize:: (GLfloat, GLfloat) -- ^ The thresholds for pushing and titling, respectively, between 0 and +1.+ -> SpaceNavigatorCallback -- ^ The callback for the mouse.+ -> SpaceNavigatorCallback -- ^ A callback that receives quantized input {-1, 0, +1}.+quantize (pushThreshold, tiltThreshold) callback input =+ do+ let+ quantize' threshold v+ | v > threshold' = 1+ | v < - threshold' = -1+ | otherwise = 0+ where threshold' = abs threshold+ input' =+ case input of+ Push x y z -> Push (quantize' pushThreshold x) (quantize' pushThreshold y) (quantize' pushThreshold z)+ Tilt x y z -> Tilt (quantize' tiltThreshold x) (quantize' tiltThreshold y) (quantize' tiltThreshold z)+ b -> b+ report =+ case input' of+ Push x y z -> any (/= 0) [x, y, z]+ Tilt x y z -> any (/= 0) [x, y, z]+ _ -> True+ when report+ $ callback input'+++-- | A default quantization for the SpaceNavigator 3D mouse.+defaultQuantization :: (GLfloat, GLfloat)+defaultQuantization = (0.2, 0.1)+++-- | Tracking information for a SpaceNavigator 3D mouse.+data Track =+ Track+ {+ trackMode :: TrackMode -- ^ The tracking mode.+ , trackPosition :: Vector3 GLfloat -- ^ The coordinates for the position.+ , trackOrientation :: Vector3 GLfloat -- ^ The Euler angles for the orientation: yaw\/heading, pitch\/elevation, and roll\/bank, relative an initial orientation where the /-z/ axis is forward: see \<<https://en.wikipedia.org/wiki/Euler_angles#Alternative_names>\>.+ , trackLeftPress :: Bool -- ^ Whether the left button is pressed.+ , trackRightPress :: Bool -- ^ Whether the right button is pressed.+ }+ deriving (Eq, Read, Show)++instance Default Track where+ def = Track def (Vector3 0 0 0) (Vector3 0 0 0) False False+++-- | The mode for tracking a SpaceNavigator 3D mouse.+--+-- /Currently only one mode is available, but other modes, such as flying and examining, will be implemented in the future./+data TrackMode =+ -- | Track the mouse as a \"platform\" in 3D space:+ --+ -- [push rightward] increment /x/ position+ --+ -- [push leftward] decrement /x/ position+ --+ -- [pull upward] increment /z/ position+ --+ -- [push downward] decrement /z/ position+ --+ -- [pull backward] increment /z/ position+ --+ -- [push forward] decrement /z/ position+ --+ -- [tilt leftward] increment first Euler angle, yaw\/heading+ --+ -- [tilt rightward] decrement first Euler angle, yaw\/heading+ --+ -- [twist counterclockwise] increment second Euler angle, pitch\/elevation+ --+ -- [twist clockwise] decrement second Euler angle, pitch\/elevation+ --+ -- [tilt backward] increment third Euler angle, roll\/bank+ --+ -- [tilt forward] decrement third Euler angle, roll\/bank+ TrackPlatform+ deriving (Eq, Read, Show)++instance Default TrackMode where+ def = TrackPlatform+++-- | Track the movement of a SpaceNavigator 3D mouse.+track :: (Vector3 GLfloat, Vector3 GLfloat) -- ^ The rates at which to push or tilt, respectively, based on the mouse input.+ -> IORef Track -- ^ A reference to the tracking information.+ -> SpaceNavigatorCallback -- ^ A callback for doing the tracking.+track (pushRates, _) tracking Push{..} =+ tracking $~!+ \t@Track{..} ->+ t {+ trackPosition = (pushRates `scale3` Vector3 pushRightward pushUpward pushBackward) `translate3` trackPosition+ }+track (_, tiltRates) tracking Tilt{..} =+ tracking $~!+ \t@Track{..} ->+ t {+ trackOrientation = (tiltRates `scale3` Vector3 (-tiltRightward) (-tiltClockwise) (-tiltForward)) `translate3` trackOrientation+ }+track _ tracking (Button ButtonLeft action) =+ tracking $~!+ \t ->+ t {+ trackLeftPress = action == ButtonPress+ }+track _ tracking (Button ButtonRight action) =+ tracking $~!+ \t ->+ t {+ trackRightPress = action == ButtonPress+ }+track _ _ (Button (ButtonOther _) _) = return ()+++-- | Translate a 3-vector.+translate3 :: Num a+ => Vector3 a -- ^ The first vector.+ -> Vector3 a -- ^ The second vector.+ -> Vector3 a -- ^ The vector sum.+translate3 dv v = (+) <$> v <*> dv+++-- | Scale a 3-vector.+scale3 :: Num a+ => Vector3 a -- ^ The first vector.+ -> Vector3 a -- ^ The second vector.+ -> Vector3 a -- ^ The vector with the production of the corresponding components.+scale3 s v = (*) <$> v <*> s+++-- | Default tracking rates for the SpaceNavigator 3D mouse.+defaultTracking :: (Vector3 GLfloat, Vector3 GLfloat)+defaultTracking = (Vector3 0.01 0.01 0.01, Vector3 1 1 1)+++-- | Return an action to track a SpaceNavigator 3D mouse via OpenGL matrices.+--+-- This simply calls @glTranslate@ on the position, followed by calls to @glRotate@ for the third Euler angle (roll\/bank) around the /x/-axis, the second (pitch\/elevation) around the /y/-axis, and then the first (yaw\/heading) around the /z/-axis, relative to an initial orientation where the /-z/ axis is forward.+doTracking :: Track -- ^ The tracking information.+ -> IO () -- ^ An action to track the mouse.+doTracking Track{..} =+ do+ let+ Vector3 alpha beta gamma = trackOrientation+ translate trackPosition+ rotate gamma $ Vector3 1 0 0+ rotate beta $ Vector3 0 1 0+ rotate alpha $ Vector3 0 0 1
+ src/Main.hs view
@@ -0,0 +1,163 @@+{-|+Module : Main+Copyright : (c) 2015 Brian W Bush+License : MIT+Maintainer : Brian W Bush <consult@brianwbush.info>+Stability : Stable+Portability : Portable++Example application illustrating obtaining input from and tracking a SpaceNavigator \<<http://www.3dconnexion.com/products/spacemouse/spacenavigator.html>\>, or a 3D mouse compatible with its protocols.+-}+++module Main (+ -- * Entry Point+ main+) where+++import Data.Default (def)+import Data.IORef (IORef, newIORef)+import Graphics.Rendering.OpenGL (ClearBuffer(..), Color3(..), ComparisonFunction(Less), GLfloat, MatrixMode(Modelview, Projection), Position(..), PrimitiveMode(..), Size(..), Vector3(..), Vertex3(..), ($=), ($=!), clear, color, depthFunc, flush, frustum, get, loadIdentity, matrixMode, preservingMatrix, renderPrimitive, rotate, translate, vertex, viewport)+import Graphics.UI.GLUT (DisplayCallback, DisplayMode(..), ReshapeCallback, createWindow, displayCallback, getArgsAndInitialize, idleCallback, initialDisplayMode, mainLoop, postRedisplay, reshapeCallback, swapBuffers)+import Graphics.UI.SpaceNavigator (Track(..), defaultQuantization, defaultTracking, doTracking, quantize, spaceNavigatorCallback, track)+++-- | The main action.+main :: IO ()+main =+ do+ (_, arguments) <- getArgsAndInitialize+ initialDisplayMode $= [WithDepthBuffer, DoubleBuffered]+ _ <- createWindow "SpaceNavigator "+ depthFunc $= Just Less + reshapeCallback $= Just reshape+ dispatch arguments+++-- | Respond to the window being created or reshaped.+reshape :: ReshapeCallback+reshape (Size w h) = + do+ viewport $= (Position 0 0, Size (minimum [w, h]) (minimum[w, h]))+ matrixMode $=! Projection+ loadIdentity+ frustum (-0.4) 0.4 (-0.4) 0.4 1 6+ matrixMode $=! Modelview 0+++-- | Respond to command-line arguments.+dispatch :: [String] -> IO ()++dispatch ["raw"] =+ do + spaceNavigatorCallback $=! Just print+ displayCallback $=! display Nothing+ mainLoop++dispatch ["quantized"] =+ let+ (pushThreshold, tiltThreshold) = defaultQuantization+ in+ dispatch ["quantized", show pushThreshold, show tiltThreshold]++dispatch ["quantized", pushThreshold, tiltThreshold] =+ do+ spaceNavigatorCallback $=! Just (quantize (read pushThreshold, read tiltThreshold) print)+ displayCallback $=! display Nothing+ mainLoop++dispatch ["track"] =+ let+ (pushThreshold, tiltThreshold) = defaultQuantization+ in+ dispatch ["track", show pushThreshold, show tiltThreshold]++dispatch ["track", pushThreshold, tiltThreshold] =+ do+ tracking <- newIORef $ def {trackPosition = Vector3 0 0 0}+ spaceNavigatorCallback $=! Just+ (+ quantize (read pushThreshold, read tiltThreshold)+ $ \input ->+ do+ track defaultTracking tracking input+ tracking' <- get tracking+ print tracking'+ )+ displayCallback $=! display (Just tracking)+ idleCallback $=! Just (postRedisplay Nothing)+ mainLoop++dispatch _ =+ do+ putStrLn "Usage:"+ putStrLn " opengl-spacenavigator raw : prints raw data from SpaceNavigator"+ putStrLn " opengl-spacenavigator quantized [pushThreshold tiltThreshold] : prints quantized data from SpaceNavigator"+ putStrLn " opengl-spacenavigator track [pushThreshold tiltThreshold] : prints 6D tracking based on data from SpaceNavigator"+++-- | The display callback.+display :: Maybe (IORef Track) -> DisplayCallback+display (Just tracking) =+ do+ let+ (u, v, w) = (0.03, 0.06, -0.18) :: (GLfloat, GLfloat, GLfloat)+ p0 = ( 0, 0, w)+ p1 = (-u, -u, 0)+ p2 = ( u, -u, 0)+ p3 = ( 0, v, 0)+ tracking' <- get tracking+ clear [ColorBuffer, DepthBuffer]+ loadIdentity+ rotate 10 $ Vector3 1 2 (0 :: GLfloat)+ translate $ Vector3 0.5 (-0.2) (-3.5 :: GLfloat)+ preservingMatrix $ do+ doTracking tracking'+ color $ Color3 1.0 0.4 (0.5 :: GLfloat)+ renderPrimitive Triangles+ $ mapM_ vertex3f+ [+ p1, p2, p3+ , p1, p2, p0+ , p1, p0, p3+ , p0, p2, p3+ ]+ color $ Color3 1 1 (1 :: GLfloat)+ renderPrimitive Lines+ $ mapM_ vertex3f+ [+ p1, p2+ , p2, p3+ , p3, p1+ , p1, p0+ , p2, p0+ , p3, p0+ ]+ color $ Color3 0.5 1.0 (0.4 :: GLfloat)+ preservingMatrix $+ renderPrimitive Lines+ $ mapM_ vertex3f+ $ concat+ [+ [+ (2 * u' - 1, 2 * v' - 1, -0.8), (2 * u' - 1, 2 * v' - 1, 0.8)+ , (2 * u' - 1, -0.8, 2 * v' - 1), (2 * u' - 1, 0.8, 2 * v' - 1)+ , ( -0.8, 2 * u' - 1, 2 * v' - 1), ( 0.8, 2 * u' - 1, 2 * v' - 1)+ ]+ |+ u' <- [0.1,0.2..0.9]+ , v' <- [0.1,0.2..0.9]+ ]+ flush+ swapBuffers++display Nothing =+ do+ clear [ColorBuffer, DepthBuffer]+ swapBuffers+++-- | Make coordinates into a vertex.+vertex3f :: (GLfloat, GLfloat, GLfloat) -> IO ()+vertex3f (x, y, z) = vertex $ Vertex3 x y z