netwire-input-glfw 0.0.4 → 0.0.6

raw patch · 3 files changed

+69/−44 lines, 3 filesdep ~GLFW-bdep ~basedep ~netwire-input-glfwPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: GLFW-b, base, netwire-input-glfw

API changes (from Hackage documentation)

Files

• examples/Cursor.hs +1/−1
• lib/FRP/Netwire/Input/GLFW.hs +62/−37
• netwire-input-glfw.cabal +6/−6

@@ -200,7 +200,7 @@       -- state (for example if the wire debounced any keys). This is what we pass       -- back to GLFW.       --  renderPrg :: IO ((Either e (), Wire s e GameMonad a ()), GLFWInputState)-      let renderPrg = runStateT (stepWire w timeState (Right undefined)) ipt'+      let renderPrg = runGLFWInputT (stepWire w timeState (Right undefined)) ipt'        -- Now run the actual IO program to extract the values from it.       ((result, w'), ipt'') <- renderPrg

@@ -14,13 +14,15 @@  -} +{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ module FRP.Netwire.Input.GLFW (   -- * GLFW Input    -- ** Basic Input Monad-  GLFWInput,+  GLFWInput, runGLFWInput,   -- ** Monad Transformer-  GLFWInputT,+  GLFWInputT, runGLFWInputT,    -- * State Types   GLFWInputControl, GLFWInputState,@@ -33,14 +35,21 @@ import qualified Graphics.UI.GLFW as GLFW import Control.Applicative import Control.Concurrent.STM+import Control.Monad.RWS import Control.Monad.State+import Control.Monad.Except+import Control.Monad.Cont+import Control.Monad.Identity import GHC.Float hiding (clamp)  import FRP.Netwire.Input --------------------------------------------------------------------------------  clamp :: Ord a => a -> a -> a -> a-clamp x a b = if x < a then a else if x > b then b else x+clamp x a b+  | x < a = a+  | x > b = b+  | otherwise = x  newRange :: Floating a => a -> (a, a) -> (a, a) -> a newRange x (omin, omax) (nmin, nmax) =@@ -73,43 +82,60 @@ instance Key GLFW.Key instance MouseButton GLFW.MouseButton --- !FIXME! Perhaps this is better in its own newtype---- | The 'GLFWInput' monad is simply a state monad around the GLFWInputState-type GLFWInput = State GLFWInputState- -- | The 'GLFWInputT' monad transformer is simply a state monad transformer using -- 'GLFWInputState'-type GLFWInputT m = StateT GLFWInputState m+newtype GLFWInputT m a =+  GLFWInputT (StateT GLFWInputState m a)+  deriving ( Functor+           , Applicative+           , Alternative+           , Monad+           , MonadFix+           , MonadIO+           , MonadWriter w+           , MonadReader r+           , MonadError e+           , MonadPlus+           , MonadCont+           , MonadTrans+           ) -instance (Functor m, Monad m) =>-         MonadKeyboard GLFW.Key (StateT GLFWInputState m) where+runGLFWInputT :: GLFWInputT m a -> GLFWInputState -> m (a, GLFWInputState)+runGLFWInputT (GLFWInputT m) = runStateT m -  keyIsPressed :: GLFW.Key -> StateT GLFWInputState m Bool-  keyIsPressed key = get >>= (return . isKeyDown key)+-- | The 'GLFWInput' monad is simply the GLFWInputT transformer around the+-- identity monad.+type GLFWInput = GLFWInputT Identity -  releaseKey :: GLFW.Key -> StateT GLFWInputState m ()-  releaseKey key = get >>= (put . debounceKey key)+runGLFWInput :: GLFWInput a -> GLFWInputState -> (a, GLFWInputState)+runGLFWInput m is = runIdentity (runGLFWInputT m is) -instance (Functor m, Monad m) =>-         MonadMouse GLFW.MouseButton (StateT GLFWInputState m) where+instance Monad m => MonadKeyboard GLFW.Key (GLFWInputT m) where -  mbIsPressed :: GLFW.MouseButton -> StateT GLFWInputState m Bool-  mbIsPressed mb = get >>= (return . isButtonPressed mb)+  keyIsPressed :: GLFW.Key -> GLFWInputT m Bool+  keyIsPressed key = GLFWInputT . liftM (isKeyDown key) $ get -  releaseButton :: GLFW.MouseButton -> StateT GLFWInputState m ()-  releaseButton mb = get >>= (put . debounceButton mb)+  releaseKey :: GLFW.Key -> GLFWInputT m ()+  releaseKey key = GLFWInputT (get >>= (put . debounceKey key)) -  cursor :: StateT GLFWInputState m (Float, Float)-  cursor = get >>= (return . cursorPos)+instance Monad m => MonadMouse GLFW.MouseButton (GLFWInputT m) where -  setCursorMode :: CursorMode -> StateT GLFWInputState m ()+  mbIsPressed :: GLFW.MouseButton -> GLFWInputT m Bool+  mbIsPressed mb = GLFWInputT . liftM (isButtonPressed mb) $ get++  releaseButton :: GLFW.MouseButton -> GLFWInputT m ()+  releaseButton mb = GLFWInputT (get >>= (put . debounceButton mb))++  cursor :: GLFWInputT m (Float, Float)+  cursor = GLFWInputT . liftM cursorPos $ get++  setCursorMode :: CursorMode -> GLFWInputT m ()   setCursorMode mode = do-    ipt <- get-    put (ipt { cmode = mode })+    ipt <- GLFWInputT get+    GLFWInputT $ put (ipt { cmode = mode }) -  scroll :: StateT GLFWInputState m (Double, Double)-  scroll = get >>= (return . scrollAmt)+  scroll :: GLFWInputT m (Double, Double)+  scroll = GLFWInputT . liftM scrollAmt $ get  kEmptyInput :: GLFWInputState kEmptyInput = GLFWInputState { keysPressed = Map.empty,@@ -132,7 +158,7 @@ debounceKey key input = input { keysPressed = Map.delete key (keysPressed input) }  isButtonPressed :: GLFW.MouseButton -> GLFWInputState -> Bool-isButtonPressed mb = (Map.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@@ -150,7 +176,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 ()@@ -159,9 +185,8 @@   -- Do we need to change the cursor mode?   curMode <- GLFW.getCursorInputMode win   let newMode = modeToGLFWMode (cmode ipt)-  if newMode == curMode-    then return ()-    else GLFW.setCursorInputMode win newMode+  unless (newMode == curMode) $+    GLFW.setCursorInputMode win newMode    -- Write the new input   atomically $ writeTVar var (ipt { scrollAmt = (0, 0) })@@ -198,7 +223,7 @@       GLFW.KeyState'Released -> input {         keysPressed = Map.update removeReleased key (keysPressed input),         keysReleased =-          case (Map.lookup key (keysPressed input)) of+          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@@ -242,7 +267,7 @@  -- | Creates and returns an 'STM' variable for the window that holds all of the -- most recent input state information-mkInputControl :: GLFW.Window -> IO (GLFWInputControl)+mkInputControl :: GLFW.Window -> IO GLFWInputControl mkInputControl win = do   ctlvar <- newTVarIO kEmptyInput   let ctl = IptCtl ctlvar win@@ -256,12 +281,12 @@ -- state. The old state must be passed in order to properly reset certain -- properties such as the scroll wheel. The returned input state is identical -- to a subsequent call to 'getInput' right after a call to 'GLFW.pollEvents'-pollGLFW :: GLFWInputState -> GLFWInputControl -> IO (GLFWInputState)+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')

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                netwire-input-glfw-version:             0.0.4+version:             0.0.6 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@@ -14,7 +14,7 @@ license-file:        LICENSE author:              Pavel Krajcevski maintainer:          Krajcevski@gmail.com-copyright:           Pavel Krajcevski, 2015+copyright:           Pavel Krajcevski, 2014-2016 category:            Game build-type:          Simple extra-source-files:  examples/Cursor.hs README.md@@ -35,10 +35,10 @@                        InstanceSigs   exposed-modules:     FRP.Netwire.Input.GLFW   -- other-modules:       -  build-depends:       base >= 4.6 && < 4.10,+  build-depends:       base >= 4.6 && < 6,                        netwire-input,                        containers,-                       GLFW-b >= 1.4.7.2,+                       GLFW-b,                        stm,                        mtl   hs-source-dirs:      lib@@ -59,9 +59,9 @@     build-depends:  base > 4.5,                     netwire >= 5,                     netwire-input,-                    netwire-input-glfw,+                    netwire-input-glfw == 0.0.6,                     OpenGL,-                    GLFW-b >= 1.4.7.2,+                    GLFW-b,                     transformers,                     array,                     bytestring,