Add a subscription to SDL.Event.TextInputEvent

src/Helm/Engine.hs

@@ -16,6 +16,7 @@ module Helm.Engine (
 ) where
 
 import Control.Monad.Trans.State (StateT)
+import Data.Text
 
 import FRP.Elerea.Param (SignalGen, Signal)
 import Linear.V2 (V2)
@@ -68,6 +69,9 @@ class Engine e where
   -- | The keyboard press signal, with events provided by the engine.
   keyboardPressSignal :: e -> SignalGen e (Signal [Key])
 
+  -- | The keyboard typing signal, with events provided by the engine
+  keyboardTypingSignal :: e -> SignalGen e (Signal [Text])
+
   -- | The window resize signal, with events provided by the engine.
   windowResizeSignal :: e -> SignalGen e (Signal [V2 Int])
 

src/Helm/Engine/SDL/Engine.hs

@@ -36,6 +36,7 @@ import qualified SDL.Time as Time
 import qualified SDL.Video as Video
 import           SDL.Video (WindowConfig(..))
 import qualified SDL.Video.Renderer as Renderer
+import qualified SDL.Raw.Types as Raw
 
 import           Helm.Asset (Image)
 import           Helm.Color (Color(..), Gradient(..))
@@ -79,6 +80,8 @@ data SDLEngine = SDLEngine
   , keyboardUpEventSink :: Key -> IO ()                                            -- ^ The keyboard up event sink.
   , keyboardPressEventSignal :: SignalGen SDLEngine (Signal [Key])                 -- ^ The keyboard press event signal.
   , keyboardPressEventSink :: Key -> IO ()                                         -- ^ The keyboard press event sink.
+  , keyboardTypingEventSignal :: SignalGen SDLEngine (Signal [T.Text])
+  , keyboardTypingEventSink :: T.Text -> IO ()
 
   , windowResizeEventSignal :: SignalGen SDLEngine (Signal [V2 Int])               -- ^ The window resize event signal.
   , windowResizeEventSink :: V2 Int -> IO ()                                       -- ^ The window resize event sink.
@@ -119,6 +122,7 @@ instance Engine SDLEngine where
   -- | Cleanup the engine assets and quit using SDL's init library.
   cleanup SDLEngine { window, renderer, texture } = do
     Renderer.destroyTexture texture
+    SDL.stopTextInput
     Video.destroyWindow window
     Video.destroyRenderer renderer
     Init.quit
@@ -162,6 +166,9 @@ instance Engine SDLEngine where
   -- | The SDL-specific keyboard press signal.
   keyboardPressSignal = keyboardPressEventSignal
 
+  -- | The SDL-specific text input signal.
+  keyboardTypingSignal = keyboardTypingEventSignal
+
   -- | The SDL-specific window resize signal.
   windowResizeSignal = windowResizeEventSignal
 
@@ -209,6 +216,11 @@ startupWith config@SDLEngineConfig { .. } = do
   renderer <- Video.createRenderer window (-1) rendererConfig
   texture <- prepTexture windowDimensions renderer
 
+  -- By default the SDL window isn't shown
+  Video.showWindow window
+
+  SDL.startTextInput $ Raw.Rect 0 0 1 1
+
   -- Initialize all of the sinks and signals that SDL events will be sunk into.
   mouseMoveEvent <- externalMulti
   mouseDownEvent <- externalMulti
@@ -217,11 +229,9 @@ startupWith config@SDLEngineConfig { .. } = do
   keyboardDownEvent <- externalMulti
   keyboardUpEvent <- externalMulti
   keyboardPressEvent <- externalMulti
+  keyboardTypingEvent <- externalMulti
   windowResizeEvent <- externalMulti
 
-  -- By default the SDL window isn't shown
-  Video.showWindow window
-
   return SDLEngine
     { window = window
     , renderer = renderer
@@ -243,7 +253,9 @@ startupWith config@SDLEngineConfig { .. } = do
     , keyboardUpEventSignal = fst keyboardUpEvent
     , keyboardUpEventSink = snd keyboardUpEvent
     , keyboardPressEventSignal = fst keyboardPressEvent
-    , keyboardPressEventSink = snd keyboardPressEvent
+        , keyboardPressEventSink = snd keyboardPressEvent
+    , keyboardTypingEventSignal = fst keyboardTypingEvent
+    , keyboardTypingEventSink = snd keyboardTypingEvent
 
     , windowResizeEventSignal = fst windowResizeEvent
     , windowResizeEventSink = snd windowResizeEvent
@@ -282,6 +294,7 @@ render2d SDLEngine { window, renderer, texture } coll = do
   Renderer.copy renderer texture Nothing Nothing
   Renderer.present renderer
 
+
 -- | Render a collage (a group of forms with context).
 renderCollage
   :: Graphics2D.Collage SDLEngine  -- ^ The collage to render.
@@ -542,6 +555,10 @@ sinkEvent engine (Event.KeyboardEvent Event.KeyboardEventData { .. }) =
     Keysym { .. } = keyboardEventKeysym
     key = mapKey keysymKeycode
 
+-- Sink text input events into the relevant Elerea sinks.
+sinkEvent engine (Event.TextInputEvent Event.TextInputEventData {..}) = do
+    keyboardTypingEventSink engine textInputEventText >> return engine
+
 -- Sink mouse events into the relevant Elerea sinks.
 sinkEvent engine (Event.MouseButtonEvent Event.MouseButtonEventData { .. }) =
   case mouseButtonEventMotion of
@@ -580,5 +597,6 @@ sinkEvent engine (Event.MouseButtonEvent Event.MouseButtonEventData { .. }) =
     dubPos = fromIntegral <$> pos
     tup = (mapMouseButton mouseButtonEventButton, fromIntegral <$> pos)
 
+
 -- Don't sink other events.
 sinkEvent engine _ = return engine

src/Helm/Keyboard.hs

@@ -7,10 +7,13 @@ module Helm.Keyboard
   , presses
   , downs
   , ups
+  , typing
   ) where
 
 import FRP.Elerea.Param (input, snapshot)
 
+import Data.Text
+
 import Helm.Engine (Engine(..), Sub(..), Key(..))
 
 -- | Subscribe to keyboard press events and map to a game action.
@@ -44,3 +47,18 @@ ups f = Sub $ do
   engine <- input >>= snapshot
 
   fmap (fmap f) <$> keyboardUpSignal engine
+
+
+-- | Subscribe to keyboard typing events and map to a game action.
+-- While downs and ups report back keys pressed on the keyboard they fail to
+-- report ASCII letters (e.g. Shift+x will be reported as x rather than X).
+-- Hence the need for typing which will report back the character resulting from
+-- the various key combinations.
+typing
+    :: Engine e
+    => (Text -> a)  -- ^ The function to map the character typed to an action.
+    -> Sub e a      -- ^ The mapped subscription.
+typing f = Sub $ do
+    engine <- input >>= snapshot
+
+    fmap (fmap f) <$> keyboardTypingSignal engine