{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
module FRP.Netwire.Input.GLFW (
GLFWInput, runGLFWInput,
GLFWInputT, runGLFWInputT,
MonadGLFWInput(..),
GLFWInputControl, GLFWInputState,
emptyGLFWState,
getInput, mkInputControl, pollGLFW
) where
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Graphics.UI.GLFW as GLFW
import Control.Applicative
import Control.Concurrent.STM
import Control.DeepSeq
import Control.Monad
import Control.Monad.Fix
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 GHC.Generics
import FRP.Netwire.Input
clamp :: Ord a => a -> a -> a -> a
clamp :: forall a. Ord a => a -> a -> a -> a
clamp a
x a
a a
b
| a
x forall a. Ord a => a -> a -> Bool
< a
a = a
a
| a
x forall a. Ord a => a -> a -> Bool
> a
b = a
b
| Bool
otherwise = a
x
newRange :: Floating a => a -> (a, a) -> (a, a) -> a
newRange :: forall a. Floating a => a -> (a, a) -> (a, a) -> a
newRange a
x (a
omin, a
omax) (a
nmin, a
nmax) =
a
nmin forall a. Num a => a -> a -> a
+ (a
nmax forall a. Num a => a -> a -> a
- a
nmin) forall a. Num a => a -> a -> a
* ((a
x forall a. Num a => a -> a -> a
- a
omin) forall a. Fractional a => a -> a -> a
/ (a
omax forall a. Num a => a -> a -> a
- a
omin))
newRangeC :: (Ord a, Floating a) => a -> (a, a) -> (a, a) -> a
newRangeC :: forall a. (Ord a, Floating a) => a -> (a, a) -> (a, a) -> a
newRangeC a
x (a, a)
o n :: (a, a)
n@(a
nmin, a
nmax) = forall a. Ord a => a -> a -> a -> a
clamp (forall a. Floating a => a -> (a, a) -> (a, a) -> a
newRange a
x (a, a)
o (a, a)
n) a
nmin a
nmax
modeToGLFWMode :: CursorMode -> GLFW.CursorInputMode
modeToGLFWMode :: CursorMode -> CursorInputMode
modeToGLFWMode CursorMode
CursorMode'Reset = CursorInputMode
GLFW.CursorInputMode'Disabled
modeToGLFWMode CursorMode
CursorMode'Disabled = CursorInputMode
GLFW.CursorInputMode'Disabled
modeToGLFWMode CursorMode
CursorMode'Hidden = CursorInputMode
GLFW.CursorInputMode'Hidden
modeToGLFWMode CursorMode
CursorMode'Enabled = CursorInputMode
GLFW.CursorInputMode'Normal
data GLFWInputState = GLFWInputState {
GLFWInputState -> Map Key Int
keysPressed :: Map.Map GLFW.Key Int,
GLFWInputState -> Set Key
keysReleased :: Set.Set GLFW.Key,
GLFWInputState -> Map MouseButton Int
mbPressed :: Map.Map GLFW.MouseButton Int,
GLFWInputState -> Set MouseButton
mbReleased :: Set.Set GLFW.MouseButton,
GLFWInputState -> (Float, Float)
cursorPos :: (Float, Float),
GLFWInputState -> CursorMode
cmode :: CursorMode,
GLFWInputState -> (Double, Double)
scrollAmt :: (Double, Double)
} deriving(Int -> GLFWInputState -> ShowS
[GLFWInputState] -> ShowS
GLFWInputState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GLFWInputState] -> ShowS
$cshowList :: [GLFWInputState] -> ShowS
show :: GLFWInputState -> String
$cshow :: GLFWInputState -> String
showsPrec :: Int -> GLFWInputState -> ShowS
$cshowsPrec :: Int -> GLFWInputState -> ShowS
Show, forall x. Rep GLFWInputState x -> GLFWInputState
forall x. GLFWInputState -> Rep GLFWInputState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GLFWInputState x -> GLFWInputState
$cfrom :: forall x. GLFWInputState -> Rep GLFWInputState x
Generic)
instance NFData GLFWInputState
instance Key GLFW.Key
instance MouseButton GLFW.MouseButton
newtype GLFWInputT m a =
GLFWInputT (StateT GLFWInputState m a)
deriving ( forall a b. a -> GLFWInputT m b -> GLFWInputT m a
forall a b. (a -> b) -> GLFWInputT m a -> GLFWInputT m b
forall (m :: * -> *) a b.
Functor m =>
a -> GLFWInputT m b -> GLFWInputT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> GLFWInputT m a -> GLFWInputT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> GLFWInputT m b -> GLFWInputT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> GLFWInputT m b -> GLFWInputT m a
fmap :: forall a b. (a -> b) -> GLFWInputT m a -> GLFWInputT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> GLFWInputT m a -> GLFWInputT m b
Functor
, forall a. a -> GLFWInputT m a
forall a b. GLFWInputT m a -> GLFWInputT m b -> GLFWInputT m a
forall a b. GLFWInputT m a -> GLFWInputT m b -> GLFWInputT m b
forall a b.
GLFWInputT m (a -> b) -> GLFWInputT m a -> GLFWInputT m b
forall a b c.
(a -> b -> c) -> GLFWInputT m a -> GLFWInputT m b -> GLFWInputT m c
forall {m :: * -> *}. Monad m => Functor (GLFWInputT m)
forall (m :: * -> *) a. Monad m => a -> GLFWInputT m a
forall (m :: * -> *) a b.
Monad m =>
GLFWInputT m a -> GLFWInputT m b -> GLFWInputT m a
forall (m :: * -> *) a b.
Monad m =>
GLFWInputT m a -> GLFWInputT m b -> GLFWInputT m b
forall (m :: * -> *) a b.
Monad m =>
GLFWInputT m (a -> b) -> GLFWInputT m a -> GLFWInputT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> GLFWInputT m a -> GLFWInputT m b -> GLFWInputT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. GLFWInputT m a -> GLFWInputT m b -> GLFWInputT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
GLFWInputT m a -> GLFWInputT m b -> GLFWInputT m a
*> :: forall a b. GLFWInputT m a -> GLFWInputT m b -> GLFWInputT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
GLFWInputT m a -> GLFWInputT m b -> GLFWInputT m b
liftA2 :: forall a b c.
(a -> b -> c) -> GLFWInputT m a -> GLFWInputT m b -> GLFWInputT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> GLFWInputT m a -> GLFWInputT m b -> GLFWInputT m c
<*> :: forall a b.
GLFWInputT m (a -> b) -> GLFWInputT m a -> GLFWInputT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
GLFWInputT m (a -> b) -> GLFWInputT m a -> GLFWInputT m b
pure :: forall a. a -> GLFWInputT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> GLFWInputT m a
Applicative
, forall a. GLFWInputT m a
forall a. GLFWInputT m a -> GLFWInputT m [a]
forall a. GLFWInputT m a -> GLFWInputT m a -> GLFWInputT m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall {m :: * -> *}. MonadPlus m => Applicative (GLFWInputT m)
forall (m :: * -> *) a. MonadPlus m => GLFWInputT m a
forall (m :: * -> *) a.
MonadPlus m =>
GLFWInputT m a -> GLFWInputT m [a]
forall (m :: * -> *) a.
MonadPlus m =>
GLFWInputT m a -> GLFWInputT m a -> GLFWInputT m a
many :: forall a. GLFWInputT m a -> GLFWInputT m [a]
$cmany :: forall (m :: * -> *) a.
MonadPlus m =>
GLFWInputT m a -> GLFWInputT m [a]
some :: forall a. GLFWInputT m a -> GLFWInputT m [a]
$csome :: forall (m :: * -> *) a.
MonadPlus m =>
GLFWInputT m a -> GLFWInputT m [a]
<|> :: forall a. GLFWInputT m a -> GLFWInputT m a -> GLFWInputT m a
$c<|> :: forall (m :: * -> *) a.
MonadPlus m =>
GLFWInputT m a -> GLFWInputT m a -> GLFWInputT m a
empty :: forall a. GLFWInputT m a
$cempty :: forall (m :: * -> *) a. MonadPlus m => GLFWInputT m a
Alternative
, forall a. a -> GLFWInputT m a
forall a b. GLFWInputT m a -> GLFWInputT m b -> GLFWInputT m b
forall a b.
GLFWInputT m a -> (a -> GLFWInputT m b) -> GLFWInputT m b
forall (m :: * -> *). Monad m => Applicative (GLFWInputT m)
forall (m :: * -> *) a. Monad m => a -> GLFWInputT m a
forall (m :: * -> *) a b.
Monad m =>
GLFWInputT m a -> GLFWInputT m b -> GLFWInputT m b
forall (m :: * -> *) a b.
Monad m =>
GLFWInputT m a -> (a -> GLFWInputT m b) -> GLFWInputT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> GLFWInputT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> GLFWInputT m a
>> :: forall a b. GLFWInputT m a -> GLFWInputT m b -> GLFWInputT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
GLFWInputT m a -> GLFWInputT m b -> GLFWInputT m b
>>= :: forall a b.
GLFWInputT m a -> (a -> GLFWInputT m b) -> GLFWInputT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
GLFWInputT m a -> (a -> GLFWInputT m b) -> GLFWInputT m b
Monad
, forall a. (a -> GLFWInputT m a) -> GLFWInputT m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
forall {m :: * -> *}. MonadFix m => Monad (GLFWInputT m)
forall (m :: * -> *) a.
MonadFix m =>
(a -> GLFWInputT m a) -> GLFWInputT m a
mfix :: forall a. (a -> GLFWInputT m a) -> GLFWInputT m a
$cmfix :: forall (m :: * -> *) a.
MonadFix m =>
(a -> GLFWInputT m a) -> GLFWInputT m a
MonadFix
, forall a. IO a -> GLFWInputT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (GLFWInputT m)
forall (m :: * -> *) a. MonadIO m => IO a -> GLFWInputT m a
liftIO :: forall a. IO a -> GLFWInputT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> GLFWInputT m a
MonadIO
, MonadWriter w
, MonadReader r
, MonadError e
, forall a. GLFWInputT m a
forall a. GLFWInputT m a -> GLFWInputT m a -> GLFWInputT m a
forall {m :: * -> *}. MonadPlus m => Monad (GLFWInputT m)
forall (m :: * -> *). MonadPlus m => Alternative (GLFWInputT m)
forall (m :: * -> *) a. MonadPlus m => GLFWInputT m a
forall (m :: * -> *) a.
MonadPlus m =>
GLFWInputT m a -> GLFWInputT m a -> GLFWInputT m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: forall a. GLFWInputT m a -> GLFWInputT m a -> GLFWInputT m a
$cmplus :: forall (m :: * -> *) a.
MonadPlus m =>
GLFWInputT m a -> GLFWInputT m a -> GLFWInputT m a
mzero :: forall a. GLFWInputT m a
$cmzero :: forall (m :: * -> *) a. MonadPlus m => GLFWInputT m a
MonadPlus
, forall a b.
((a -> GLFWInputT m b) -> GLFWInputT m a) -> GLFWInputT m a
forall (m :: * -> *).
Monad m -> (forall a b. ((a -> m b) -> m a) -> m a) -> MonadCont m
forall {m :: * -> *}. MonadCont m => Monad (GLFWInputT m)
forall (m :: * -> *) a b.
MonadCont m =>
((a -> GLFWInputT m b) -> GLFWInputT m a) -> GLFWInputT m a
callCC :: forall a b.
((a -> GLFWInputT m b) -> GLFWInputT m a) -> GLFWInputT m a
$ccallCC :: forall (m :: * -> *) a b.
MonadCont m =>
((a -> GLFWInputT m b) -> GLFWInputT m a) -> GLFWInputT m a
MonadCont
, forall (m :: * -> *) a. Monad m => m a -> GLFWInputT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: forall (m :: * -> *) a. Monad m => m a -> GLFWInputT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> GLFWInputT m a
MonadTrans
)
instance MonadState s m => MonadState s (GLFWInputT m) where
get :: GLFWInputT m s
get = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *). MonadState s m => m s
get
put :: s -> GLFWInputT m ()
put = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => s -> m ()
put
state :: forall a. (s -> (a, s)) -> GLFWInputT m a
state = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state
class Monad m => MonadGLFWInput m where
getGLFWInput :: m GLFWInputState
putGLFWInput :: GLFWInputState -> m ()
instance Monad m => MonadGLFWInput (GLFWInputT m) where
getGLFWInput :: GLFWInputT m GLFWInputState
getGLFWInput :: GLFWInputT m GLFWInputState
getGLFWInput = forall (m :: * -> *) a. StateT GLFWInputState m a -> GLFWInputT m a
GLFWInputT forall s (m :: * -> *). MonadState s m => m s
get
putGLFWInput :: GLFWInputState -> GLFWInputT m ()
putGLFWInput :: GLFWInputState -> GLFWInputT m ()
putGLFWInput = forall (m :: * -> *) a. StateT GLFWInputState m a -> GLFWInputT m a
GLFWInputT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => s -> m ()
put
runGLFWInputT :: GLFWInputT m a -> GLFWInputState -> m (a, GLFWInputState)
runGLFWInputT :: forall (m :: * -> *) a.
GLFWInputT m a -> GLFWInputState -> m (a, GLFWInputState)
runGLFWInputT (GLFWInputT StateT GLFWInputState m a
m) = forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT GLFWInputState m a
m
type GLFWInput = GLFWInputT Identity
runGLFWInput :: GLFWInput a -> GLFWInputState -> (a, GLFWInputState)
runGLFWInput :: forall a. GLFWInput a -> GLFWInputState -> (a, GLFWInputState)
runGLFWInput GLFWInput a
m = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
GLFWInputT m a -> GLFWInputState -> m (a, GLFWInputState)
runGLFWInputT GLFWInput a
m
instance MonadGLFWInput m => MonadKeyboard GLFW.Key m where
keyIsPressed :: GLFW.Key -> m Bool
keyIsPressed :: Key -> m Bool
keyIsPressed Key
key = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Key -> GLFWInputState -> Bool
isKeyDown Key
key) forall (m :: * -> *). MonadGLFWInput m => m GLFWInputState
getGLFWInput
releaseKey :: GLFW.Key -> m ()
releaseKey :: Key -> m ()
releaseKey Key
key = forall (m :: * -> *). MonadGLFWInput m => m GLFWInputState
getGLFWInput forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (m :: * -> *). MonadGLFWInput m => GLFWInputState -> m ()
putGLFWInput forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> GLFWInputState -> GLFWInputState
debounceKey Key
key)
instance MonadGLFWInput m => MonadMouse GLFW.MouseButton m where
mbIsPressed :: GLFW.MouseButton -> m Bool
mbIsPressed :: MouseButton -> m Bool
mbIsPressed MouseButton
mb = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (MouseButton -> GLFWInputState -> Bool
isButtonPressed MouseButton
mb) forall (m :: * -> *). MonadGLFWInput m => m GLFWInputState
getGLFWInput
releaseButton :: GLFW.MouseButton -> m ()
releaseButton :: MouseButton -> m ()
releaseButton MouseButton
mb = forall (m :: * -> *). MonadGLFWInput m => m GLFWInputState
getGLFWInput forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (m :: * -> *). MonadGLFWInput m => GLFWInputState -> m ()
putGLFWInput forall b c a. (b -> c) -> (a -> b) -> a -> c
. MouseButton -> GLFWInputState -> GLFWInputState
debounceButton MouseButton
mb)
cursor :: m (Float, Float)
cursor :: m (Float, Float)
cursor = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM GLFWInputState -> (Float, Float)
cursorPos forall (m :: * -> *). MonadGLFWInput m => m GLFWInputState
getGLFWInput
setCursorMode :: CursorMode -> m ()
setCursorMode :: CursorMode -> m ()
setCursorMode CursorMode
mode = do
GLFWInputState
ipt <- forall (m :: * -> *). MonadGLFWInput m => m GLFWInputState
getGLFWInput
forall (m :: * -> *). MonadGLFWInput m => GLFWInputState -> m ()
putGLFWInput (GLFWInputState
ipt { cmode :: CursorMode
cmode = CursorMode
mode })
scroll :: m (Double, Double)
scroll :: m (Double, Double)
scroll = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM GLFWInputState -> (Double, Double)
scrollAmt forall (m :: * -> *). MonadGLFWInput m => m GLFWInputState
getGLFWInput
isKeyDown :: GLFW.Key -> GLFWInputState -> Bool
isKeyDown :: Key -> GLFWInputState -> Bool
isKeyDown Key
key = (forall k a. Ord k => k -> Map k a -> Bool
Map.member Key
key) forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLFWInputState -> Map Key Int
keysPressed
withPressedKey :: GLFWInputState -> GLFW.Key -> (a -> a) -> a -> a
withPressedKey :: forall a. GLFWInputState -> Key -> (a -> a) -> a -> a
withPressedKey GLFWInputState
input Key
key a -> a
fn
| Key -> GLFWInputState -> Bool
isKeyDown Key
key GLFWInputState
input = a -> a
fn
| Bool
otherwise = forall a. a -> a
id
debounceKey :: GLFW.Key -> GLFWInputState -> GLFWInputState
debounceKey :: Key -> GLFWInputState -> GLFWInputState
debounceKey Key
key GLFWInputState
input = GLFWInputState
input { keysPressed :: Map Key Int
keysPressed = forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Key
key (GLFWInputState -> Map Key Int
keysPressed GLFWInputState
input) }
isButtonPressed :: GLFW.MouseButton -> GLFWInputState -> Bool
isButtonPressed :: MouseButton -> GLFWInputState -> Bool
isButtonPressed MouseButton
mb = forall k a. Ord k => k -> Map k a -> Bool
Map.member MouseButton
mb forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLFWInputState -> Map MouseButton Int
mbPressed
withPressedButton :: GLFWInputState -> GLFW.MouseButton -> (a -> a) -> a -> a
withPressedButton :: forall a. GLFWInputState -> MouseButton -> (a -> a) -> a -> a
withPressedButton GLFWInputState
input MouseButton
mb a -> a
fn = if MouseButton -> GLFWInputState -> Bool
isButtonPressed MouseButton
mb GLFWInputState
input then a -> a
fn else forall a. a -> a
id
debounceButton :: GLFW.MouseButton -> GLFWInputState -> GLFWInputState
debounceButton :: MouseButton -> GLFWInputState -> GLFWInputState
debounceButton MouseButton
mb GLFWInputState
input = GLFWInputState
input { mbPressed :: Map MouseButton Int
mbPressed = forall k a. Ord k => k -> Map k a -> Map k a
Map.delete MouseButton
mb (GLFWInputState -> Map MouseButton Int
mbPressed GLFWInputState
input) }
data GLFWInputControl = IptCtl (TVar GLFWInputState) GLFW.Window
setCursorToWindowCenter :: GLFW.Window -> IO ()
setCursorToWindowCenter :: Window -> IO ()
setCursorToWindowCenter Window
win = do
(Int
w, Int
h) <- Window -> IO (Int, Int)
GLFW.getWindowSize Window
win
Window -> Double -> Double -> IO ()
GLFW.setCursorPos Window
win (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w forall a. Fractional a => a -> a -> a
/ Double
2.0) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h forall a. Fractional a => a -> a -> a
/ Double
2.0)
getInput :: GLFWInputControl -> IO GLFWInputState
getInput :: GLFWInputControl -> IO GLFWInputState
getInput (IptCtl TVar GLFWInputState
var Window
_) = forall a. TVar a -> IO a
readTVarIO TVar GLFWInputState
var
setInput :: GLFWInputControl -> GLFWInputState -> IO ()
setInput :: GLFWInputControl -> GLFWInputState -> IO ()
setInput (IptCtl TVar GLFWInputState
var Window
win) GLFWInputState
ipt = do
CursorInputMode
curMode <- Window -> IO CursorInputMode
GLFW.getCursorInputMode Window
win
let newMode :: CursorInputMode
newMode = CursorMode -> CursorInputMode
modeToGLFWMode (GLFWInputState -> CursorMode
cmode GLFWInputState
ipt)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CursorInputMode
newMode forall a. Eq a => a -> a -> Bool
== CursorInputMode
curMode) forall a b. (a -> b) -> a -> b
$
Window -> CursorInputMode -> IO ()
GLFW.setCursorInputMode Window
win CursorInputMode
newMode
forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> a -> STM ()
writeTVar TVar GLFWInputState
var forall a b. NFData a => (a -> b) -> a -> b
$!! (GLFWInputState
ipt { scrollAmt :: (Double, Double)
scrollAmt = (Double
0, Double
0) })
resetCursorPos :: GLFWInputState -> GLFWInputState
resetCursorPos :: GLFWInputState -> GLFWInputState
resetCursorPos GLFWInputState
input = GLFWInputState
input { cursorPos :: (Float, Float)
cursorPos = (Float
0, Float
0) }
resolveReleased :: GLFWInputState -> GLFWInputState
resolveReleased :: GLFWInputState -> GLFWInputState
resolveReleased GLFWInputState
input = GLFWInputState
input {
keysPressed :: Map Key Int
keysPressed =
(forall a. Num a => a -> a -> a
+Int
1) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Map k a
Map.delete) (GLFWInputState -> Map Key Int
keysPressed GLFWInputState
input) (forall a. Set a -> [a]
Set.elems forall a b. (a -> b) -> a -> b
$ GLFWInputState -> Set Key
keysReleased GLFWInputState
input),
keysReleased :: Set Key
keysReleased = forall a. Set a
Set.empty,
mbPressed :: Map MouseButton Int
mbPressed =
(forall a. Num a => a -> a -> a
+Int
1) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Map k a
Map.delete) (GLFWInputState -> Map MouseButton Int
mbPressed GLFWInputState
input) (forall a. Set a -> [a]
Set.elems forall a b. (a -> b) -> a -> b
$ GLFWInputState -> Set MouseButton
mbReleased GLFWInputState
input),
mbReleased :: Set MouseButton
mbReleased = forall a. Set a
Set.empty
}
scrollCallback :: GLFWInputControl -> GLFW.Window -> Double -> Double -> IO ()
scrollCallback :: GLFWInputControl -> Window -> Double -> Double -> IO ()
scrollCallback (IptCtl TVar GLFWInputState
ctl Window
_) Window
_ Double
xoff Double
yoff =
forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar GLFWInputState
ctl GLFWInputState -> GLFWInputState
updateScroll
where
updateScroll :: GLFWInputState -> GLFWInputState
updateScroll :: GLFWInputState -> GLFWInputState
updateScroll = (\GLFWInputState
input -> GLFWInputState
input { scrollAmt :: (Double, Double)
scrollAmt = (Double
xoff, Double
yoff) })
keyCallback :: GLFWInputControl -> GLFW.Window ->
GLFW.Key -> Int -> GLFW.KeyState -> GLFW.ModifierKeys -> IO ()
keyCallback :: GLFWInputControl
-> Window -> Key -> Int -> KeyState -> ModifierKeys -> IO ()
keyCallback (IptCtl TVar GLFWInputState
ctl Window
_) Window
_ Key
key Int
_ KeyState
keystate ModifierKeys
_ =
forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar GLFWInputState
ctl GLFWInputState -> GLFWInputState
modifyKeys
where
modifyKeys :: GLFWInputState -> GLFWInputState
modifyKeys :: GLFWInputState -> GLFWInputState
modifyKeys GLFWInputState
input = case KeyState
keystate of
KeyState
GLFW.KeyState'Pressed -> GLFWInputState
input {
keysPressed :: Map Key Int
keysPressed = forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (GLFWInputState -> Map Key Int
keysPressed GLFWInputState
input) (forall k a. k -> a -> Map k a
Map.singleton Key
key Int
0) }
KeyState
GLFW.KeyState'Released -> GLFWInputState
input {
keysPressed :: Map Key Int
keysPressed = forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update Int -> Maybe Int
removeReleased Key
key (GLFWInputState -> Map Key Int
keysPressed GLFWInputState
input),
keysReleased :: Set Key
keysReleased =
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Key
key (GLFWInputState -> Map Key Int
keysPressed GLFWInputState
input) of
Just Int
0 -> forall a. Ord a => a -> Set a -> Set a
Set.insert Key
key (GLFWInputState -> Set Key
keysReleased GLFWInputState
input)
Maybe Int
_ -> GLFWInputState -> Set Key
keysReleased GLFWInputState
input
}
KeyState
_ -> GLFWInputState
input
removeReleased :: Int -> Maybe Int
removeReleased :: Int -> Maybe Int
removeReleased Int
0 = forall a. a -> Maybe a
Just Int
0
removeReleased Int
_ = forall a. Maybe a
Nothing
mouseButtonCallback :: GLFWInputControl -> GLFW.Window ->
GLFW.MouseButton -> GLFW.MouseButtonState ->
GLFW.ModifierKeys -> IO ()
mouseButtonCallback :: GLFWInputControl
-> Window
-> MouseButton
-> MouseButtonState
-> ModifierKeys
-> IO ()
mouseButtonCallback (IptCtl TVar GLFWInputState
ctl Window
_) Window
_ MouseButton
button MouseButtonState
state ModifierKeys
_ =
forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar GLFWInputState
ctl GLFWInputState -> GLFWInputState
modify
where
modify :: GLFWInputState -> GLFWInputState
modify :: GLFWInputState -> GLFWInputState
modify GLFWInputState
input = case MouseButtonState
state of
MouseButtonState
GLFW.MouseButtonState'Pressed -> GLFWInputState
input {
mbPressed :: Map MouseButton Int
mbPressed = forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (GLFWInputState -> Map MouseButton Int
mbPressed GLFWInputState
input) (forall k a. k -> a -> Map k a
Map.singleton MouseButton
button Int
0) }
MouseButtonState
GLFW.MouseButtonState'Released -> GLFWInputState
input {
mbPressed :: Map MouseButton Int
mbPressed = forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update Int -> Maybe Int
removeReleased MouseButton
button (GLFWInputState -> Map MouseButton Int
mbPressed GLFWInputState
input),
mbReleased :: Set MouseButton
mbReleased =
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup MouseButton
button (GLFWInputState -> Map MouseButton Int
mbPressed GLFWInputState
input) of
Just Int
0 -> forall a. Ord a => a -> Set a -> Set a
Set.insert MouseButton
button (GLFWInputState -> Set MouseButton
mbReleased GLFWInputState
input)
Maybe Int
_ -> GLFWInputState -> Set MouseButton
mbReleased GLFWInputState
input
}
removeReleased :: Int -> Maybe Int
removeReleased :: Int -> Maybe Int
removeReleased Int
0 = forall a. a -> Maybe a
Just Int
0
removeReleased Int
_ = forall a. Maybe a
Nothing
cursorPosCallback :: GLFWInputControl -> GLFW.Window -> Double -> Double -> IO ()
cursorPosCallback :: GLFWInputControl -> Window -> Double -> Double -> IO ()
cursorPosCallback (IptCtl TVar GLFWInputState
ctl Window
_) Window
win Double
x Double
y = do
(Int
w, Int
h) <- Window -> IO (Int, Int)
GLFW.getWindowSize Window
win
let xf :: Float
xf = forall a. (Ord a, Floating a) => a -> (a, a) -> (a, a) -> a
newRangeC (Double -> Float
double2Float Double
x) (Float
0, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (-Float
1, Float
1)
yf :: Float
yf = forall a. (Ord a, Floating a) => a -> (a, a) -> (a, a) -> a
newRangeC (Double -> Float
double2Float Double
y) (Float
0, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h) (-Float
1, Float
1)
forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar GLFWInputState
ctl (\GLFWInputState
ipt -> GLFWInputState
ipt { cursorPos :: (Float, Float)
cursorPos = (Float
xf, Float
yf)})
emptyGLFWState :: GLFWInputState
emptyGLFWState :: GLFWInputState
emptyGLFWState = GLFWInputState
{ keysPressed :: Map Key Int
keysPressed = forall k a. Map k a
Map.empty
, keysReleased :: Set Key
keysReleased = forall a. Set a
Set.empty
, mbPressed :: Map MouseButton Int
mbPressed = forall k a. Map k a
Map.empty
, mbReleased :: Set MouseButton
mbReleased = forall a. Set a
Set.empty
, cursorPos :: (Float, Float)
cursorPos = (Float
0, Float
0)
, cmode :: CursorMode
cmode = CursorMode
CursorMode'Disabled
, scrollAmt :: (Double, Double)
scrollAmt = (Double
0, Double
0)
}
mkInputControl :: GLFW.Window -> IO GLFWInputControl
mkInputControl :: Window -> IO GLFWInputControl
mkInputControl Window
win = do
TVar GLFWInputState
ctlvar <- forall a. a -> IO (TVar a)
newTVarIO (GLFWInputState
emptyGLFWState { cmode :: CursorMode
cmode = CursorMode
CursorMode'Enabled })
let ctl :: GLFWInputControl
ctl = TVar GLFWInputState -> Window -> GLFWInputControl
IptCtl TVar GLFWInputState
ctlvar Window
win
Window -> Maybe (Window -> Double -> Double -> IO ()) -> IO ()
GLFW.setScrollCallback Window
win (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ GLFWInputControl -> Window -> Double -> Double -> IO ()
scrollCallback GLFWInputControl
ctl)
Window
-> Maybe
(Window -> Key -> Int -> KeyState -> ModifierKeys -> IO ())
-> IO ()
GLFW.setKeyCallback Window
win (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ GLFWInputControl
-> Window -> Key -> Int -> KeyState -> ModifierKeys -> IO ()
keyCallback GLFWInputControl
ctl)
Window -> Maybe (Window -> Double -> Double -> IO ()) -> IO ()
GLFW.setCursorPosCallback Window
win (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ GLFWInputControl -> Window -> Double -> Double -> IO ()
cursorPosCallback GLFWInputControl
ctl)
Window
-> Maybe
(Window
-> MouseButton -> MouseButtonState -> ModifierKeys -> IO ())
-> IO ()
GLFW.setMouseButtonCallback Window
win (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ GLFWInputControl
-> Window
-> MouseButton
-> MouseButtonState
-> ModifierKeys
-> IO ()
mouseButtonCallback GLFWInputControl
ctl)
forall (m :: * -> *) a. Monad m => a -> m a
return GLFWInputControl
ctl
pollGLFW :: GLFWInputState -> GLFWInputControl -> IO GLFWInputState
pollGLFW :: GLFWInputState -> GLFWInputControl -> IO GLFWInputState
pollGLFW GLFWInputState
ipt iptctl :: GLFWInputControl
iptctl@(IptCtl TVar GLFWInputState
_ Window
win) = do
let ipt' :: GLFWInputState
ipt' = GLFWInputState -> GLFWInputState
resolveReleased GLFWInputState
ipt
if GLFWInputState -> CursorMode
cmode GLFWInputState
ipt' forall a. Eq a => a -> a -> Bool
== CursorMode
CursorMode'Reset
then do
Window -> IO ()
setCursorToWindowCenter Window
win
GLFWInputControl -> GLFWInputState -> IO ()
setInput GLFWInputControl
iptctl (GLFWInputState -> GLFWInputState
resetCursorPos GLFWInputState
ipt')
else GLFWInputControl -> GLFWInputState -> IO ()
setInput GLFWInputControl
iptctl GLFWInputState
ipt'
IO ()
GLFW.pollEvents
GLFWInputControl -> IO GLFWInputState
getInput GLFWInputControl
iptctl