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,51 @@ +Functions for using SpaceNavigator-compatible 3D Mice with OpenGL +================================================================= + +This Haskell package contains functions for managing input from a SpaceNavigator <>, 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 <> +* spacenavd <>, 0.5 +* Ubuntu 15.04, 64-bit +* GHC 7.6.3 +* OpenGL == 2.8.0.0 +* GLUT == 2.4.0.0 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/opengl-spacenavigator.cabal b/opengl-spacenavigator.cabal new file mode 100644 --- /dev/null +++ b/opengl-spacenavigator.cabal @@ -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 \<\>, 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 +maintainer: Brian W Bush +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 diff --git a/src/Graphics/UI/SpaceNavigator.hs b/src/Graphics/UI/SpaceNavigator.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/UI/SpaceNavigator.hs @@ -0,0 +1,320 @@ +{-| +Module : Graphics.UI.SpaceNavigator +Copyright : (c) 2015 Brian W Bush +License : MIT +Maintainer : Brian W Bush +Stability : Stable +Portability : Portable + +Functions for managing input from a SpaceNavigator \<\>, 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 \<\> + +* spacenavd \<\>, 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 \<\>. + , 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 diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,163 @@ +{-| +Module : Main +Copyright : (c) 2015 Brian W Bush +License : MIT +Maintainer : Brian W Bush +Stability : Stable +Portability : Portable + +Example application illustrating obtaining input from and tracking a SpaceNavigator \<\>, 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