Implement keyboard and mouse subscriptions

src/Helm/Engine/SDL.hs

@@ -21,12 +21,13 @@ import           Data.Word (Word32)
 import           FRP.Elerea.Param
 import           Linear.Affine (Point(P))
 import           Linear.V2 (V2(V2))
-import           SDL.Video (WindowConfig(..))
 import qualified SDL
 import qualified SDL.Event as Event
 import qualified SDL.Init as Init
+import           SDL.Input.Keyboard (Keysym(..))
 import qualified SDL.Time as Time
 import qualified SDL.Video as Video
+import           SDL.Video (WindowConfig(..))
 import qualified SDL.Video.Renderer as Renderer
 
 import           Helm.Asset
@@ -161,7 +162,7 @@ startupWith config@SDLEngineConfig{..} = do
     , windowResizeEventSink = snd windowResizeEvent
     }
   where
-    (w,h) = windowDimensions
+    (w, h) = windowDimensions
     rendererConfig = Video.RendererConfig Video.AcceleratedVSyncRenderer False
     windowConfig = Video.defaultWindow
       { windowInitialSize = V2 (fromIntegral w) (fromIntegral h)
@@ -255,6 +256,25 @@ sinkEvent engine game (Event.MouseMotionEvent Event.MouseMotionEventData { .. })
 
   return game
 
+sinkEvent engine game (Event.KeyboardEvent Event.KeyboardEventData { .. }) = do
+  case keyboardEventKeyMotion of
+    Event.Pressed -> do
+      keyboardDownEventSink engine key
+
+      if keyboardEventRepeat
+      then keyboardPressEventSink engine key >> return game
+      else return game
+
+    Event.Released -> do
+      keyboardUpEventSink engine key
+      keyboardPressEventSink engine key
+
+      return game
+
+  where
+    Keysym { .. } = keyboardEventKeysym
+    key = mapKey keysymKeycode
+
 sinkEvent engine game (Event.MouseButtonEvent Event.MouseButtonEventData { .. }) = do
   case mouseButtonEventMotion of
     Event.Pressed -> do

src/Helm/Keyboard.hs

@@ -14,13 +14,19 @@ import FRP.Elerea.Param (input, snapshot)
 import Helm.Engine (Engine(..), Sub(..), Key(..))
 
 presses :: Engine e => (Key -> a) -> Sub e a
-presses f = Sub $  do
+presses f = Sub $ do
   engine <- input >>= snapshot
 
   fmap (fmap f) <$> keyboardPressSignal engine
 
 downs :: Engine e => (Key -> a) -> Sub e a
-downs _ = Sub $ return $ return []
+downs f = Sub $ do
+  engine <- input >>= snapshot
+
+  fmap (fmap f) <$> keyboardDownSignal engine
 
 ups :: Engine e => (Key -> a) -> Sub e a
-ups _ = Sub $ return $ return []
+ups f = Sub $ do
+  engine <- input >>= snapshot
+
+  fmap (fmap f) <$> keyboardUpSignal engine

src/Helm/Mouse.hs

@@ -8,9 +8,6 @@ module Helm.Mouse
   , clicks
   , downs
   , ups
-  , buttonClicks
-  , buttonDowns
-  , buttonUps
   ) where
 
 import FRP.Elerea.Param (input, snapshot)
@@ -24,20 +21,20 @@ moves f = Sub $ do
 
   fmap (fmap f) <$> mouseMoveSignal engine
 
-buttonClicks :: Engine e => MouseButton -> (V2 Int -> a) -> Sub e a
-buttonClicks _ _ = Sub $ return $ return []
+clicks :: Engine e => (MouseButton -> V2 Int -> a) -> Sub e a
+clicks _ = Sub $ do
+  engine <- input >>= snapshot
 
-buttonDowns :: Engine e => MouseButton -> (V2 Int -> a) -> Sub e a
-buttonDowns _ _ = Sub $ return $ return []
+  fmap (fmap (\(b, p) -> f b p)) <$> mouseClickSignal engine
 
-buttonUps :: Engine e => MouseButton -> (V2 Int -> a) -> Sub e a
-buttonUps _ _ = Sub $ return $ return []
+downs :: Engine e => (MouseButton -> V2 Int -> a) -> Sub e a
+downs _ = Sub $ do
+  engine <- input >>= snapshot
 
-clicks :: Engine e => (V2 Int -> a) -> Sub e a
-clicks = buttonClicks LeftButton
+  fmap (fmap (\(b, p) -> f b p)) <$> mouseDownSignal engine
 
-downs :: Engine e => (V2 Int -> a) -> Sub e a
-downs = buttonDowns LeftButton
+ups :: Engine e => (MouseButton -> V2 Int -> a) -> Sub e a
+ups f = Sub $ do
+  engine <- input >>= snapshot
 
-ups :: Engine e => (V2 Int -> a) -> Sub e a
-ups = buttonUps LeftButton
+  fmap (fmap (\(b, p) -> f b p)) <$> mouseUpSignal engine

src/Helm/Window.hs

@@ -42,4 +42,4 @@ resizes :: Engine e => (V2 Int -> a) -> Sub e a
 resizes f = Sub $ do
   engine <- input >>= snapshot
 
-  fmap (fmap f) <$> windowResizeSignal engine
+  fmap (map f) <$> windowResizeSignal engine