netwire-input-glfw 0.0.2 → 0.0.3
raw patch · 4 files changed
+101/−33 lines, 4 filesdep +OpenGLdep +arraydep +bytestringdep ~basenew-component:exe:glfw-input-examplePVP ok
version bump matches the API change (PVP)
Dependencies added: OpenGL, array, bytestring, directory, filepath, netwire, netwire-input-glfw, transformers
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- README.md +1/−1
- examples/Cursor.hs +5/−4
- lib/FRP/Netwire/Input/GLFW.hs +62/−27
- netwire-input-glfw.cabal +33/−1
README.md view
@@ -1,4 +1,4 @@-netwire-input-glfw+netwire-input-glfw [](https://travis-ci.org/Mokosha/netwire-input-glfw) ============ This library contains the necessary typeclasses to interface with
examples/Cursor.hs view
@@ -134,13 +134,13 @@ -- the red and green channels of the circle pulsate colorWire :: (HasTime t s, Monoid e) => Wire s e GameMonad a (GL.Color3 Float) colorWire =+ -- Key debounced means that it will only flash blue for one frame+ (keyDebounced GLFW.Key'B >>> (pure $ GL.Color3 0 0 1)) <|>+ -- Key pressed means that it will remain this color (keyPressed GLFW.Key'R >>> (pure $ GL.Color3 1 0 0)) <|> (keyPressed GLFW.Key'G >>> (pure $ GL.Color3 0 1 0)) <|> - -- Key debounced means that it will only flash blue for one frame- (keyDebounced GLFW.Key'B >>> (pure $ GL.Color3 0 0 1)) <|>- -- Otherwise, pulsate based on the amount of time passed (timeF >>> (arr (cos &&& sin)) >>> (arr $ \(x, y) -> GL.Color3 x y 1)) @@ -177,6 +177,7 @@ -- run the game loop runGame ipt (countSession_ 0.02) (gameWire $ renderFn circle)+ where -- The game loop takes the current input state, the time session and@@ -228,4 +229,4 @@ GL.viewport GL.$= (GL.Position 0 0, GL.Size (fromIntegral szx) (fromIntegral szy)) -- Run the scene- run m =<< (mkInputControl m)+ mkInputControl m >>= run m
lib/FRP/Netwire/Input/GLFW.hs view
@@ -28,6 +28,7 @@ ) where --------------------------------------------------------------------------------+import qualified Data.Map as Map import qualified Data.Set as Set import qualified Graphics.UI.GLFW as GLFW import Control.Applicative@@ -60,8 +61,10 @@ -- appropriate callbacks are fired in order of the events received, and this record -- is updated to reflect the most recent input state. data GLFWInputState = GLFWInputState {- keysPressed :: Set.Set GLFW.Key,- mbPressed :: Set.Set GLFW.MouseButton,+ keysPressed :: Map.Map GLFW.Key Int,+ keysReleased :: Set.Set GLFW.Key,+ mbPressed :: Map.Map GLFW.MouseButton Int,+ mbReleased :: Set.Set GLFW.MouseButton, cursorPos :: (Float, Float), cmode :: CursorMode, scrollAmt :: (Double, Double)@@ -109,29 +112,31 @@ scroll = get >>= (return . scrollAmt) kEmptyInput :: GLFWInputState-kEmptyInput = GLFWInputState { keysPressed = Set.empty,- mbPressed = Set.empty,+kEmptyInput = GLFWInputState { keysPressed = Map.empty,+ keysReleased = Set.empty,+ mbPressed = Map.empty,+ mbReleased = Set.empty, cursorPos = (0, 0), cmode = CursorMode'Enabled, scrollAmt = (0, 0) } isKeyPressed :: GLFW.Key -> GLFWInputState -> Bool-isKeyPressed key = (Set.member key) . keysPressed+isKeyPressed key = (Map.member key) . keysPressed withPressedKey :: GLFWInputState -> GLFW.Key -> (a -> a) -> a -> a withPressedKey input key fn = if isKeyPressed key input then fn else id debounceKey :: GLFW.Key -> GLFWInputState -> GLFWInputState-debounceKey key = (\input -> input { keysPressed = Set.delete key (keysPressed input) })+debounceKey key input = input { keysPressed = Map.delete key (keysPressed input) } isButtonPressed :: GLFW.MouseButton -> GLFWInputState -> Bool-isButtonPressed mb = (Set.member mb) . mbPressed+isButtonPressed mb = (Map.member mb) . mbPressed withPressedButton :: GLFWInputState -> GLFW.MouseButton -> (a -> a) -> a -> a withPressedButton input mb fn = if isButtonPressed mb input then fn else id debounceButton :: GLFW.MouseButton -> GLFWInputState -> GLFWInputState-debounceButton mb = (\input -> input { mbPressed = Set.delete mb (mbPressed input) })+debounceButton mb input = input { mbPressed = Map.delete mb (mbPressed input) } -- | This is an 'STM' variable that holds the current input state. It cannot be -- manipulated directly, but it is updated by GLFW each time 'pollGLFW' is called.@@ -143,7 +148,7 @@ GLFW.setCursorPos win (fromIntegral w / 2.0) (fromIntegral h / 2.0) -- | Returns a current snapshot of the input-getInput :: GLFWInputControl -> IO(GLFWInputState)+getInput :: GLFWInputControl -> IO (GLFWInputState) getInput (IptCtl var _) = readTVarIO var setInput :: GLFWInputControl -> GLFWInputState -> IO ()@@ -160,8 +165,18 @@ atomically $ writeTVar var (ipt { scrollAmt = (0, 0) }) resetCursorPos :: GLFWInputState -> GLFWInputState-resetCursorPos = (\input -> input { cursorPos = (0, 0) })+resetCursorPos input = input { cursorPos = (0, 0) } +resolveReleased :: GLFWInputState -> GLFWInputState+resolveReleased input = input {+ keysPressed = Map.map (+1) $+ foldl (flip Map.delete) (keysPressed input) (Set.elems $ keysReleased input),+ keysReleased = Set.empty,+ mbPressed = Map.map (+1) $+ foldl (flip Map.delete) (mbPressed input) (Set.elems $ mbReleased input),+ mbReleased = Set.empty+ }+ -------------------------- scrollCallback :: GLFWInputControl -> GLFW.Window -> Double -> Double -> IO ()@@ -174,30 +189,48 @@ GLFW.Key -> Int -> GLFW.KeyState -> GLFW.ModifierKeys -> IO () keyCallback (IptCtl ctl _) _ key _ keystate _ = atomically $ modifyTVar' ctl modifyKeys where- updateKeys :: (Set.Set GLFW.Key -> Set.Set GLFW.Key) -> GLFWInputState -> GLFWInputState- updateKeys fn = (\input -> input { keysPressed = fn (keysPressed input) })- modifyKeys :: GLFWInputState -> GLFWInputState- modifyKeys = case keystate of- GLFW.KeyState'Pressed -> updateKeys $ Set.insert key- GLFW.KeyState'Released -> updateKeys $ Set.delete key- _ -> id+ modifyKeys input = case keystate of+ GLFW.KeyState'Pressed -> input {+ keysPressed = Map.union (keysPressed input) (Map.singleton key 0) }+ GLFW.KeyState'Released -> input {+ keysPressed = Map.update removeReleased key (keysPressed input),+ keysReleased =+ case (Map.lookup key (keysPressed input)) of+ -- If the key was just added... queue it up+ Just 0 -> Set.insert key (keysReleased input)+ -- If the key isn't pressed then it must have been debounced... do nothing+ -- If the key wasn't just added we're removing it above... do nothing...+ _ -> keysReleased input+ }+ _ -> input + removeReleased :: Int -> Maybe Int+ removeReleased 0 = Just 0+ removeReleased _ = Nothing+ mouseButtonCallback :: GLFWInputControl -> GLFW.Window -> GLFW.MouseButton -> GLFW.MouseButtonState -> GLFW.ModifierKeys -> IO () mouseButtonCallback (IptCtl ctl _) _ button state _ = atomically $ modifyTVar' ctl modify where- update :: (Set.Set GLFW.MouseButton -> Set.Set GLFW.MouseButton) ->- GLFWInputState -> GLFWInputState- update fn = (\ipt -> ipt { mbPressed = fn (mbPressed ipt) })- modify :: GLFWInputState -> GLFWInputState- modify = case state of- GLFW.MouseButtonState'Pressed -> update $ Set.insert button- GLFW.MouseButtonState'Released -> update $ Set.delete button+ modify input = case state of+ GLFW.MouseButtonState'Pressed -> input {+ mbPressed = Map.union (mbPressed input) (Map.singleton button 0) }+ GLFW.MouseButtonState'Released -> input {+ mbPressed = Map.update removeReleased button (mbPressed input),+ mbReleased =+ case Map.lookup button (mbPressed input) of+ Just 0 -> Set.insert button (mbReleased input)+ _ -> mbReleased input+ } + removeReleased :: Int -> Maybe Int+ removeReleased 0 = Just 0+ removeReleased _ = Nothing+ cursorPosCallback :: GLFWInputControl -> GLFW.Window -> Double -> Double -> IO () cursorPosCallback (IptCtl ctl _) win x y = do (w, h) <- GLFW.getWindowSize win@@ -223,12 +256,14 @@ -- to a subsequent call to 'getInput' right after a call to 'GLFW.pollEvents' pollGLFW :: GLFWInputState -> GLFWInputControl -> IO (GLFWInputState) pollGLFW ipt iptctl@(IptCtl _ win) = do+ let ipt' = resolveReleased ipt+ -- Do we need to reset the cursor?- if (cmode ipt) == CursorMode'Reset+ if (cmode ipt') == CursorMode'Reset then do setCursorToWindowCenter win- setInput iptctl (resetCursorPos ipt)- else setInput iptctl ipt+ setInput iptctl (resetCursorPos ipt')+ else setInput iptctl ipt' GLFW.pollEvents getInput iptctl
netwire-input-glfw.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: netwire-input-glfw-version: 0.0.2+version: 0.0.3 synopsis: GLFW instance of netwire-input description: This package contains the necessary glue to allow the use of wires from the netwire-input package. In general, the types@@ -20,6 +20,10 @@ extra-source-files: examples/Cursor.hs README.md cabal-version: >=1.10 +flag examples+ description: Build examples+ default: False+ source-repository head type: git location: https://github.com/Mokosha/netwire-input-glfw@@ -39,3 +43,31 @@ mtl hs-source-dirs: lib default-language: Haskell2010++--------------------------------------------------------------------------------+--+-- Examples+--+--------------------------------------------------------------------------------++executable glfw-input-example+ main-is: Cursor.hs+ hs-source-dirs: examples+ ghc-options: -Wall -rtsopts -O3++ if flag(examples)+ build-depends: base > 4.5,+ netwire >= 5,+ netwire-input,+ netwire-input-glfw,+ OpenGL,+ GLFW-b,+ transformers,+ array,+ bytestring,+ mtl,+ containers,+ directory,+ filepath+ else+ buildable: False