kafka-device-glut (empty) → 0.1.3.0
raw patch · 6 files changed
+369/−0 lines, 6 filesdep +GLUTdep +OpenGLdep +basesetup-changed
Dependencies added: GLUT, OpenGL, base, kafka-device, milena
Files
- LICENSE +20/−0
- ReadMe.md +10/−0
- Setup.hs +2/−0
- kafka-device-glut.cabal +44/−0
- src/Main.hs +56/−0
- src/Network/UI/Kafka/GLUT.hs +237/−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,10 @@+GLUT events via a Kafka message broker+======================================++This package contains functions for passing [GLUT events](https://hackage.haskell.org/package/GLUT-2.7.0.10/docs/Graphics-UI-GLUT-Callbacks-Window.html) to topics on a [Kafka message broker](https://kafka.apache.org/).+++Clients+-------++Also see https://hackage.haskell.org/package/kafka-device/.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ kafka-device-glut.cabal view
@@ -0,0 +1,44 @@+name: kafka-device-glut+version: 0.1.3.0+synopsis: GLUT events via a Kafka message broker+description: This package contains functions for passing GLUT 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: Hardware+build-type: Simple+cabal-version: >= 1.10+stability: Experimental+homepage: https://bitbucket.org/functionally/kafka-device-glut+bug-reports: https://bwbush.atlassian.net/projects/HKAFDEV/issues/+package-url: https://bitbucket.org/functionally/kafka-device-glut/downloads/kafka-device-glut-0.1.3.0.tar.gz++extra-source-files: ReadMe.md++source-repository head+ type: git+ location: https://bitbucket.org/functionally/kafka-device-glut+ +library+ exposed-modules: Network.UI.Kafka.GLUT+ build-depends: base >= 4.8 && < 5+ , GLUT+ , kafka-device+ , milena+ , OpenGL+ hs-source-dirs: src+ ghc-options: -Wall+ default-language: Haskell2010++executable kafka-device-glut+ main-is: Main.hs+ build-depends: base+ , GLUT+ , kafka-device+ , milena+ , OpenGL+ hs-source-dirs: src+ ghc-options: -Wall -threaded+ default-language: Haskell2010
+ src/Main.hs view
@@ -0,0 +1,56 @@+{-|+Module : Main+Copyright : (c) 2016 Brian W Bush+License : MIT+Maintainer : Brian W Bush <consult@brianwbush.info>+Stability : Experimental+Portability : Stable++Simple producer that transfers GLUT events \<<https://hackage.haskell.org/package/GLUT-2.7.0.10/docs/Graphics-UI-GLUT-Callbacks-Window.html>\> on a Kafka topcis.+-}+++module Main (+-- * Main entry.+ main+) where+++import Control.Concurrent (forkIO)+import Control.Monad (void)+import Data.String (IsString(fromString))+import Graphics.Rendering.OpenGL (ClearBuffer(..), ($=!), clear)+import Graphics.UI.GLUT (createWindow, displayCallback, getArgsAndInitialize, mainLoop, swapBuffers)+import Network.UI.Kafka.GLUT (glutLoop)+++-- | The main action.+main :: IO ()+main =+ do+ (_, args) <- getArgsAndInitialize+ case args of+ [client, host, port, topic, sensor] ->+ do+ let+ callbacks = [minBound..maxBound]+ putStrLn $ "Kafka client: " ++ client+ putStrLn $ "Kafka address: (" ++ host ++ "," ++ port ++ ")"+ putStrLn $ "Kafka topic: " ++ topic+ putStrLn $ "Sensor name: " ++ sensor+ putStrLn $ "GLUT callbacks: " ++ show callbacks+ void $ createWindow "GLUT Events for Kafka"+ (_, loop) <-+ glutLoop+ (fromString client)+ (fromString host, toEnum $ read port)+ (fromString topic)+ sensor+ callbacks+ void . forkIO $ void loop+ displayCallback $=!+ do+ clear [ColorBuffer]+ swapBuffers+ mainLoop+ _ -> putStrLn "USAGE: kafka-device-glut client host port topic senosr"
+ src/Network/UI/Kafka/GLUT.hs view
@@ -0,0 +1,237 @@+{-|+Module : Network.UI.Kafka.GLUT+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 GLUT callbacks \<<https://hackage.haskell.org/package/GLUT-2.7.0.10/docs/Graphics-UI-GLUT-Callbacks-Window.html>\>.+-}+++{-# LANGUAGE RecordWildCards #-}+++module Network.UI.Kafka.GLUT (+-- * Event handling.+ GlutCallback(..)+, glutLoop+) where+++import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)+import Control.Monad (when)+import Graphics.Rendering.OpenGL (($=!))+import Graphics.UI.GLUT as G (Key(..), KeyState(..), JoystickButtons(..), JoystickPosition(..), Modifiers(..), MouseButton(..), Position(..), SpaceballInput(..), SpecialKey(..), joystickCallback, keyboardMouseCallback, motionCallback, passiveMotionCallback, spaceballCallback)+import Network.Kafka (KafkaAddress, KafkaClientId)+import Network.Kafka.Protocol (TopicName)+import Network.UI.Kafka as K (ExitAction, LoopAction, Sensor, producerLoop)+import Network.UI.Kafka.Types as K (Event(..), Modifiers(..), Button(..), SpecialKey(..))+++-- | Types of GLUT callbacks. See \<<https://hackage.haskell.org/package/GLUT-2.7.0.10/docs/Graphics-UI-GLUT-Callbacks-Window.html>\> for more details.+data GlutCallback =+ -- | Key presses and mouse button clicks.+ KeyboardMouse+ -- | Mouse motion while a button is depressed.+ | Motion+ -- | Mouse motion.+ | PassiveMotion+ -- | Spaceball tracking and button clicks.+ | Spaceball+ -- | Joystick tracking and button clicks.+ | Joystick+ deriving (Bounded, Enum, Eq, Ord, Read, Show)+++-- | Produce events for a Kafka topic from GLUT callbacks \<<https://hackage.haskell.org/package/GLUT-2.7.0.10/docs/Graphics-UI-GLUT-Callbacks-Window.html>\>.+glutLoop :: KafkaClientId -- ^ A Kafka client identifier for the producer.+ -> KafkaAddress -- ^ The address of the Kakfa broker.+ -> TopicName -- ^ The Kafka topic name.+ -> Sensor -- ^ The name of the sensor producing events.+ -> [GlutCallback] -- ^ Which callbacks to enable.+ -> IO (ExitAction, LoopAction) -- ^ Action to create the exit and loop actions.+glutLoop clientId address topic sensor callbacks =+ do+ nextEvent <- newEmptyMVar+ mapM_+ (uncurry (when . (`elem` callbacks)))+ [+ (KeyboardMouse, keyboardMouseCallback $=! Just ((((putMVar nextEvent .) .) .) . interpretKeyboardMouse ))+ , (Motion , motionCallback $=! Just ( putMVar nextEvent . interpretMotion ))+ , (PassiveMotion, passiveMotionCallback $=! Just ( putMVar nextEvent . interpretMotion ))+ , (Spaceball , spaceballCallback $=! Just ( putMVar nextEvent . interpretSpaceball ))+ , (Joystick , joystickCallback $=! Just ( (putMVar nextEvent .) . interpretJoystick , 0))+ ]+ (exit, loop) <-+ producerLoop clientId address topic sensor+ $ (: [])+ <$> takeMVar nextEvent+ return+ (+ exit+ , do+ result <- loop+ mapM_+ (uncurry (when . (`elem` callbacks)))+ [+ (KeyboardMouse, keyboardMouseCallback $=! Nothing)+ , (Motion , motionCallback $=! Nothing)+ , (PassiveMotion, passiveMotionCallback $=! Nothing)+ , (Spaceball , spaceballCallback $=! Nothing)+ , (Joystick , joystickCallback $=! Nothing)+ ]+ return result+ )+++-- | Interpret key presses and mouse clickes.+interpretKeyboardMouse :: Key -- ^ The key.+ -> KeyState -- ^ The state of the key.+ -> G.Modifiers -- ^ The modifier keys.+ -> Position -- ^ The mouse position.+ -> Event -- ^ The corresponding event.+interpretKeyboardMouse key' state modifiers' position =+ let+ toggle = Just $ translateKeyState state+ modifiers = Just $ translateModifiers modifiers'+ mousePosition = Just $ translatePosition position+ in+ case key' of+ Char key -> KeyEvent{..}+ G.SpecialKey key -> let+ specialKey = translateSpecialKey key+ in+ SpecialKeyEvent{..}+ MouseButton button' -> let+ button = (translateMouseButton button', translateKeyState state)+ in+ MouseEvent{..}+++-- | Interpret mouse motion.+interpretMotion :: Position -- ^ The mouse position.+ -> Event -- ^ The corresponding event.+interpretMotion position =+ let+ mousePosition = Just $ translatePosition position+ in+ PositionEvent{..}+++-- | Interpret a spaceball event.+interpretSpaceball :: SpaceballInput -- ^ The the spaceball input.+ -> Event -- ^ The corresponding event.+interpretSpaceball (SpaceballMotion rightward upward backward) =+ let+ motionRightward = fromIntegral rightward / 1000+ motionUpward = fromIntegral upward / 1000+ motionBackward = fromIntegral backward / 1000+ in+ MotionEvent{..}+interpretSpaceball (SpaceballRotation forward clockwise rightward) =+ let+ rotationForward = fromIntegral forward / 1800+ rotationClockwise = fromIntegral clockwise / 1800+ rotationRightward = fromIntegral rightward / 1800+ in+ RotationEvent{..}+interpretSpaceball (SpaceballButton button' state) =+ let+ button = (IndexButton button', translateKeyState state)+ in+ ButtonEvent{..}+++-- | Interpret a joystick event.+interpretJoystick :: JoystickButtons -- ^ The state of joystick buttons.+ -> JoystickPosition -- ^ The joystick position.+ -> Event -- ^ The corresponding event.+interpretJoystick JoystickButtons{..} (JoystickPosition rightward forward upward) =+ let+ joystickRightward = fromIntegral rightward / 1000+ joystickForward = fromIntegral forward / 1000+ joystickUpward = fromIntegral upward / 1000+ buttons =+ [+ (LetterButton 'A', translateKeyState joystickButtonA)+ , (LetterButton 'B', translateKeyState joystickButtonB)+ , (LetterButton 'C', translateKeyState joystickButtonC)+ , (LetterButton 'D', translateKeyState joystickButtonD)+ ]+ in+ JoystickEvent{..}+++-- | Translate the state of a key.+translateKeyState :: Enum a+ => KeyState -- ^ The GLUT state.+ -> a -- ^ The corresponding enumeration.+translateKeyState G.Down = toEnum 0+translateKeyState G.Up = toEnum 1+++-- | Translate a special key.+translateSpecialKey :: G.SpecialKey -- ^ The GLUT special key.+ -> K.SpecialKey -- ^ The corresponding special key.+translateSpecialKey G.KeyF1 = K.KeyF1+translateSpecialKey G.KeyF2 = K.KeyF2+translateSpecialKey G.KeyF3 = K.KeyF3+translateSpecialKey G.KeyF4 = K.KeyF4+translateSpecialKey G.KeyF5 = K.KeyF5+translateSpecialKey G.KeyF6 = K.KeyF6+translateSpecialKey G.KeyF7 = K.KeyF7+translateSpecialKey G.KeyF8 = K.KeyF8+translateSpecialKey G.KeyF9 = K.KeyF9+translateSpecialKey G.KeyF10 = K.KeyF10+translateSpecialKey G.KeyF11 = K.KeyF11+translateSpecialKey G.KeyF12 = K.KeyF12+translateSpecialKey G.KeyLeft = K.KeyLeft+translateSpecialKey G.KeyUp = K.KeyUp+translateSpecialKey G.KeyRight = K.KeyRight+translateSpecialKey G.KeyDown = K.KeyDown+translateSpecialKey G.KeyPageUp = K.KeyPageUp+translateSpecialKey G.KeyPageDown = K.KeyPageDown+translateSpecialKey G.KeyHome = K.KeyHome+translateSpecialKey G.KeyEnd = K.KeyEnd+translateSpecialKey G.KeyInsert = K.KeyInsert+translateSpecialKey G.KeyNumLock = K.KeyNumLock+translateSpecialKey G.KeyBegin = K.KeyBegin+translateSpecialKey G.KeyDelete = K.KeyDelete+translateSpecialKey G.KeyShiftL = K.KeyShiftL+translateSpecialKey G.KeyShiftR = K.KeyShiftR+translateSpecialKey G.KeyCtrlL = K.KeyCtrlL+translateSpecialKey G.KeyCtrlR = K.KeyCtrlR+translateSpecialKey G.KeyAltL = K.KeyAltL+translateSpecialKey G.KeyAltR = K.KeyAltR+translateSpecialKey (G.KeyUnknown x) = K.KeyUnknown x+++-- | Translate key modifiers.+translateModifiers :: G.Modifiers -- ^ The GLUT key modifiers.+ -> K.Modifiers -- ^ The corresponding key modifiers.+translateModifiers G.Modifiers{..} =+ let+ shiftModifier = not $ translateKeyState shift+ ctrlModifier = not $ translateKeyState ctrl+ altModifier = not $ translateKeyState alt+ in+ K.Modifiers{..}+++-- | Translate a position.+translatePosition :: Position -- ^ The position.+ -> (Double, Double) -- ^ The corresponding position.+translatePosition (Position x y) = (fromIntegral x, fromIntegral y)+++-- | Translate a mouse button.+translateMouseButton :: G.MouseButton -- ^ The GLUT button.+ -> K.Button -- ^ The corresponding button.+translateMouseButton G.LeftButton = K.LeftButton +translateMouseButton G.MiddleButton = K.MiddleButton +translateMouseButton G.RightButton = K.RightButton +translateMouseButton G.WheelUp = K.WheelUp +translateMouseButton G.WheelDown = K.WheelDown +translateMouseButton (G.AdditionalButton x) = K.IndexButton x