diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2016 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,15 @@ +VRPN events via a Kafka message broker +============================================= + +This package contains functions for passing [VRPN](https://github.com/vrpn/vrpn/wiki) events to topics on a [Kafka message broker](https://kafka.apache.org/). + + +Clients +------- + +The simple Kafka client that produces events from VRPN can be run, for example, as follows: + + cabal run kafka-device-vrpn -- device@localhost vrpn-client localhost 9092 events vrpn + + +Also see https://hackage.haskell.org/package/kafka-device/. 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/kafka-device-vrpn.cabal b/kafka-device-vrpn.cabal new file mode 100644 --- /dev/null +++ b/kafka-device-vrpn.cabal @@ -0,0 +1,42 @@ +name: kafka-device-vrpn +version: 0.1.5.0 +synopsis: VRPN events via a Kafka message broker +description: This package contains functions for passing VRPN \<\> events to topics on a Kafka message broker \<\>. Also see \<\>. +license: MIT +license-file: LICENSE +author: Brian W Bush +maintainer: Brian W Bush +copyright: (c) 2016 Brian W Bush +category: Network +build-type: Simple +cabal-version: >= 1.10 +stability: Experimental +homepage: https://bitbucket.org/functionally/kafka-device-vrpn +bug-reports: https://bwbush.atlassian.net/projects/HKAFDEV/issues/ +package-url: https://bitbucket.org/functionally/kafka-device-vrpn/downloads/kafka-device-vrpn-0.1.5.0.tar.gz + +extra-source-files: ReadMe.md + +source-repository head + type: git + location: https://bitbucket.org/functionally/kafka-device-vrpn + +library + exposed-modules: Network.UI.Kafka.VRPN + build-depends: base >= 4.8 && < 5 + , kafka-device + , milena + , vrpn + hs-source-dirs: src + ghc-options: -Wall + default-language: Haskell2010 + +executable kafka-device-vrpn + main-is: Main.hs + build-depends: base + , kafka-device + , milena + , vrpn + hs-source-dirs: src + ghc-options: -Wall + default-language: Haskell2010 diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,50 @@ +{-| +Module : Main +Copyright : (c) 2016 Brian W Bush +License : MIT +Maintainer : Brian W Bush +Stability : Experimental +Portability : Stable + +Simple producer of VRPN \<\> events to a Kafka topic. +-} + + +module Main ( +-- * Main entry + main +) where + + +import Data.String (fromString) +import Network.UI.Kafka.VRPN (vrpnLoop) +import System.Environment (getArgs) + + +-- | The main action. +main :: IO () +main = + do + args <- getArgs + case args of + [device, client, host, port, topic, sensor] -> + do + let + callbacks = [minBound..maxBound] + putStrLn $ "VRPN device: " ++ device + putStrLn $ "Kafka client: " ++ client + putStrLn $ "Kafka address: (" ++ host ++ "," ++ port ++ ")" + putStrLn $ "Kafka topic: " ++ topic + putStrLn $ "Sensor name: " ++ sensor + putStrLn $ "GLUT callbacks: " ++ show callbacks + (_, loop) <- + vrpnLoop + device + (fromString client) + (fromString host, toEnum $ read port) + (fromString topic) + sensor + callbacks + result <- loop + either print return result + _ -> putStrLn "USAGE: kafka-device-vrpn device client host port topic senosr" diff --git a/src/Network/UI/Kafka/VRPN.hs b/src/Network/UI/Kafka/VRPN.hs new file mode 100644 --- /dev/null +++ b/src/Network/UI/Kafka/VRPN.hs @@ -0,0 +1,113 @@ +{-| +Module : Network.UI.Kafka.VRPN +Copyright : (c) 2016 Brian W Bush +License : MIT +Maintainer : Brian W Bush +Stability : Experimental +Portability : Stable + +Produce events on a Kafka topic from VRPN \<\> events. +-} + + +module Network.UI.Kafka.VRPN ( +-- * Event loop + vrpnLoop +) where + + +import Control.Concurrent (MVar, forkIO, isEmptyMVar, newEmptyMVar, putMVar, takeMVar) +import Control.Monad (void, zipWithM_) +import Network.Kafka (KafkaAddress, KafkaClientId) +import Network.Kafka.Protocol (TopicName) +import Network.UI.Kafka (ExitAction, LoopAction, Sensor, producerLoop) +import Network.UI.Kafka.Types (Button(..), Event(..)) + +import qualified Network.VRPN as V + + +-- | Types of VRPN callbacks. See \<\> for more details. +data VrpnCallback = + -- | Change in tracker state. + Tracker + | -- | Change in button state. + Button + | -- | Change in analog axis state. + Analog + | -- | Change in dial state. + Dial + deriving (Bounded, Enum, Eq, Ord, Read, Show) + + +-- | Produce events for a Kafka topic from VRPN callbacks \<\>. +vrpnLoop :: String -- ^ The VRPN host, e.g. spacenav0@localhost. + -> KafkaClientId -- ^ A Kafka client identifier for the producer. + -> KafkaAddress -- ^ The address of the Kafka broker. + -> TopicName -- ^ The Kafka topic name. + -> Sensor -- ^ The name of the sensor producing events. + -> [VrpnCallback] -- ^ Which callbacks to enable. + -> IO (ExitAction, LoopAction) -- ^ Action to create the exit and loop actions. +vrpnLoop device clientId address topic sensor callbacks = + do + exitNow <- newEmptyMVar + nextEvent <- newEmptyMVar + devices <- + mapM (V.openDevice . snd) + $ filter ((`elem` callbacks) . fst) + [ + (Tracker, V.Tracker device (Just $ positionCallback nextEvent) Nothing Nothing) + , (Button , V.Button device (Just $ buttonCallback nextEvent) ) + , (Analog , V.Analog device (Just $ analogCallback nextEvent) ) + , (Dial , V.Dial device (Just $ dialCallback nextEvent) ) + ] + (exit, loop) <- + producerLoop clientId address topic sensor + $ (: []) + <$> takeMVar nextEvent + return + ( + do + putMVar exitNow () + exit + , do + void + . forkIO + $ V.mainLoops (not <$> isEmptyMVar exitNow) (1 :: Double) devices + loop + ) + + +-- | Translate VRPN position state change to events. +positionCallback :: MVar Event -- ^ Reference to the next event. + -> V.PositionCallback Int Double -- ^ The VRPN callback. +positionCallback nextEvent _ _ p o = + do + putMVar nextEvent + $ LocationEvent p + putMVar nextEvent + $ OrientationEvent o + + +-- | Translate VRPN button state change to events. +buttonCallback :: MVar Event -- ^ Reference to the next event. + -> V.ButtonCallback Int -- ^ The VRPN callback. +buttonCallback nextEvent _ i x = + putMVar nextEvent + $ ButtonEvent (IndexButton i, toEnum $ fromEnum $ not x) + + +-- | Translate VRPN analog state change to events. +analogCallback :: MVar Event -- ^ Reference to the next event. + -> V.AnalogCallback Double -- ^ The VRPN callback. +analogCallback nextEvent _ = + zipWithM_ + ((putMVar nextEvent .) . AnalogEvent) + [0..] + + +-- | Translate VRPN dial state change to events. +dialCallback :: MVar Event -- ^ Reference to the next event. + -> V.DialCallback Int Double -- ^ The VRPN callback. +dialCallback nextEvent _ i x = + putMVar nextEvent + $ DialEvent i x