{-| The backend to be used with the input. -} module FRP.Spice.Input.Backend where -------------------- -- Global Imports -- import Graphics.Rendering.OpenGL import Graphics.UI.GLFW as GLFW import FRP.Elerea.Param import Data.Map.Strict import Data.IORef ------------------- -- Local Imports -- 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.Config import FRP.Spice.Input import FRP.Spice.Math ---------- -- Code -- {-| A wrapper around the sinks for the mouse position, the key states, and the mouse button states. -} data Sinks = Sinks { mousePositionSinks :: Vector Float -> IO () , keyboardSinks :: Map Key (Bool -> IO ()) , mouseSinks :: Map MouseButton (Bool -> IO ()) } {-| A container around @'Sinks'@ and @'Signal'@ @'Input'@ so that one needn't pass around a tuple. -} data InputContainer = InputContainer { getSinks :: Sinks , getInput :: Signal Input } {-| Making an @'InputContainer'@ filled with all necessary externals. -} 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 } {-| Creating a callback to update the mouse position's state. -} makeMousePositionCallback :: InputContainer -> IORef (Vector Int) -> MousePosCallback makeMousePositionCallback ic wSizeRef (Position x y) = do (Vector w h) <- readIORef wSizeRef mousePositionSinks (getSinks ic) $ Vector ( fromIntegral x / ((fromIntegral $ w) / 2) - 1) ((-fromIntegral y) / ((fromIntegral $ h) / 2) + 1) {-| Creating a callback to update the keyboard's states. -} makeKeyboardCallback :: InputContainer -> KeyCallback makeKeyboardCallback ic key state = keyboardSinks (getSinks ic) ! key $ case state of Press -> True Release -> False {-| Creating a callback to update the mouse buttons' states. -} makeMouseCallback :: InputContainer -> MouseButtonCallback makeMouseCallback ic button state = mouseSinks (getSinks ic) ! button $ case state of Press -> True Release -> False