diff --git a/src/Helm/Engine.hs b/src/Helm/Engine.hs index 1e2dc84..7f5f103 100644 --- a/src/Helm/Engine.hs +++ b/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]) diff --git a/src/Helm/Engine/SDL/Engine.hs b/src/Helm/Engine/SDL/Engine.hs index 61758ef..6ef0787 100644 --- a/src/Helm/Engine/SDL/Engine.hs +++ b/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 diff --git a/src/Helm/Keyboard.hs b/src/Helm/Keyboard.hs index d435eb2..cc67c46 100644 --- a/src/Helm/Keyboard.hs +++ b/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