module FRP.Spice.Input ( module Rexport
, Sinks (..)
, Input (..)
, InputContainer (..)
, makeInputContainer
, makeMousePositionCallback
, makeKeyboardCallback
, makeMouseCallback
) where
import Data.Map.Strict hiding (keys, map)
import Graphics.Rendering.OpenGL
import Graphics.UI.GLFW as GLFW
import FRP.Elerea.Param
import qualified FRP.Spice.Input.MousePosition as MousePosition
import qualified FRP.Spice.Input.Keyboard as Keyboard
import qualified FRP.Spice.Input.Mouse as Mouse
import FRP.Spice.Math.Vector
import FRP.Spice.Config
import Data.Map.Strict as Rexport ((!))
import Graphics.UI.GLFW as Rexport (Key (..), SpecialKey (..), MouseButton (..))
data Sinks = Sinks { mousePositionSinks :: Vector Float -> IO ()
, keyboardSinks :: Map Key (Bool -> IO ())
, mouseSinks :: Map MouseButton (Bool -> IO ())
}
data Input = Input { mousePosition :: Vector Float
, keyboard :: Map Key Bool
, mouse :: Map MouseButton Bool
}
data InputContainer = InputContainer { getSinks :: Sinks
, getInput :: Signal Input
}
makeInputContainer :: IO InputContainer
makeInputContainer = do
mousePositionExternals <- MousePosition.externals
keyboardExternals <- Keyboard.externals
mouseExternals <- Mouse.externals
let sinks = Sinks { mousePositionSinks = MousePosition.sinks mousePositionExternals
, keyboardSinks = Keyboard.sinks keyboardExternals
, mouseSinks = Mouse.sinks mouseExternals
}
let input = do mps <- fst mousePositionExternals
kbs <- Keyboard.signals keyboardExternals
ms <- Mouse.signals mouseExternals
return Input { mousePosition = mps
, keyboard = kbs
, mouse = ms
}
return InputContainer { getSinks = sinks
, getInput = input
}
makeMousePositionCallback :: WindowConfig -> InputContainer -> MousePosCallback
makeMousePositionCallback wc ic (Position x y) =
mousePositionSinks (getSinks ic) $
Vector ( fromIntegral x / ((fromIntegral $ getWindowWidth wc) / 2) 1)
((fromIntegral y) / ((fromIntegral $ getWindowHeight wc) / 2) + 1)
makeKeyboardCallback :: InputContainer -> KeyCallback
makeKeyboardCallback ic key state =
keyboardSinks (getSinks ic) ! key $ case state of
Press -> True
Release -> False
makeMouseCallback :: InputContainer -> MouseButtonCallback
makeMouseCallback ic button state =
mouseSinks (getSinks ic) ! button $ case state of
Press -> True
Release -> False