kafka-device-vrpn (empty) → 0.1.5.0
raw patch · 6 files changed
+242/−0 lines, 6 filesdep +basedep +kafka-devicedep +milenasetup-changed
Dependencies added: base, kafka-device, milena, vrpn
Files
- LICENSE +20/−0
- ReadMe.md +15/−0
- Setup.hs +2/−0
- kafka-device-vrpn.cabal +42/−0
- src/Main.hs +50/−0
- src/Network/UI/Kafka/VRPN.hs +113/−0
+ LICENSE view
@@ -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.
+ ReadMe.md view
@@ -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/.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ kafka-device-vrpn.cabal view
@@ -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 \<<https://github.com/vrpn/vrpn/wiki>\> events to topics on a Kafka message broker \<<https://kafka.apache.org/>\>. Also see \<<https://hackage.haskell.org/package/kafka-device/>\>.+license: MIT+license-file: LICENSE+author: Brian W Bush <consult@brianwbush.info>+maintainer: Brian W Bush <consult@brianwbush.info>+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
+ src/Main.hs view
@@ -0,0 +1,50 @@+{-|+Module : Main+Copyright : (c) 2016 Brian W Bush+License : MIT+Maintainer : Brian W Bush <consult@brianwbush.info>+Stability : Experimental+Portability : Stable++Simple producer of VRPN \<<https://github.com/vrpn/vrpn/wiki>\> 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"
+ src/Network/UI/Kafka/VRPN.hs view
@@ -0,0 +1,113 @@+{-|+Module : Network.UI.Kafka.VRPN+Copyright : (c) 2016 Brian W Bush+License : MIT+Maintainer : Brian W Bush <consult@brianwbush.info>+Stability : Experimental+Portability : Stable++Produce events on a Kafka topic from VRPN \<<https://github.com/vrpn/vrpn/wiki>\> 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 \<<https://hackage.haskell.org/package/vrpn/docs/Network-VRPN.html>\> 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 \<<https://hackage.haskell.org/package/vrpn/docs/Network-VRPN.html>\>.+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