prepare for keyboard input events

src/Classes/Scene.hs

@@ -4,11 +4,10 @@ import Affection
 
 import Control.Concurrent.STM
 
-import qualified SDL
-
 -- internal imports
 
 import Types.Util
+import Types.Subsystems
 
 class Scene a where
 
@@ -25,7 +24,7 @@ class Scene a where
   update :: a -> Double -> Affection ()
 
   -- | Handle input events
-  onEvents :: a -> [SDL.EventPayload] -> Affection ()
+  onEvents :: a -> TranslatorMessage -> Affection ()
 
   -- | perform the drawing
   render :: a -> Affection ()

src/Main.hs

@@ -57,7 +57,22 @@ main = do
   withAffection config
 
 preLoad :: GameData -> Affection ()
-preLoad _ = return ()
+preLoad gd = do
+  void $ generalSubscribe
+    ((\(SubKeyboard t) -> t) $ subKeyboard $ gameSubsystems gd)
+    (\(MsgKeyboardEvent when win motion False keysym) -> do
+      translator <- liftIO $ atomically $ readTVar (gameActionTranslation gd)
+      case
+        ((SDL.keysymScancode keysym, SDL.keysymModifier keysym) `M.lookup`
+          translator)
+        of
+          Just action ->
+            partEmit
+              (subTranslator $ gameSubsystems gd)
+              (TranslatorMessage action when motion)
+          Nothing ->
+            return ()
+      )
 
 handle :: GameData -> [SDL.EventPayload] -> Affection ()
 handle gd evs = do

src/Types/Subsystems.hs

@@ -4,6 +4,8 @@ module Types.Subsystems where
 
 import Affection
 
+import qualified SDL
+
 import Control.Concurrent.STM
 
 data Subsystems = Subsystems
@@ -23,16 +25,19 @@ newtype SubTranslator =
   SubTranslator (TVar [(UUID, TranslatorMessage -> Affection ())])
 
 data TranslatorMessage = TranslatorMessage
-  { tmAction :: Action
-  , tmTime   :: Double
+  { tmAction     :: Action
+  , tmTime       :: Double
+  , tmKeyMotiuon :: SDL.InputMotion
   }
   deriving (Eq, Show)
 
 instance Message TranslatorMessage where
-  msgTime (TranslatorMessage _ t) = t
+  msgTime (TranslatorMessage _ t _) = t
 
 data Action
-  = MoveLeft
+  = MoveUp
+  | MoveDown
+  | MoveLeft
   | MoveRight
   | Jump
   | JumpDown

src/Types/Util.hs

@@ -5,6 +5,8 @@ import qualified Data.Text as T
 import qualified Data.Map.Strict as M
 
 import qualified SDL
+import qualified SDL.Internal.Numbered as SDL (fromNumber)
+import qualified SDL.Raw.Enum as SDLRaw
 
 -- internal imports
 
@@ -12,4 +14,20 @@ import Types.Subsystems
 
 type Progress = (Float, T.Text)
 
-type ActionTranslation = M.Map SDL.Keycode Action
+type ActionTranslation = M.Map (SDL.Scancode, SDL.KeyModifier) Action
+
+defaultTranslation :: ActionTranslation
+defaultTranslation = M.fromList
+  [ ((SDL.ScancodeW, SDL.fromNumber SDLRaw.KMOD_NONE), MoveUp)
+  , ((SDL.ScancodeS, SDL.fromNumber SDLRaw.KMOD_NONE), MoveDown)
+  , ((SDL.ScancodeA, SDL.fromNumber SDLRaw.KMOD_NONE), MoveLeft)
+  , ((SDL.ScancodeD, SDL.fromNumber SDLRaw.KMOD_NONE), MoveRight)
+  , ((SDL.ScancodeSpace, SDL.fromNumber SDLRaw.KMOD_NONE), Jump)
+  , ((SDL.ScancodeSpace, SDL.fromNumber SDLRaw.KMOD_LSHIFT), JumpDown)
+  , ((SDL.ScancodeF, SDL.fromNumber SDLRaw.KMOD_NONE), Activate)
+  , ((SDL.Scancode1, SDL.fromNumber SDLRaw.KMOD_NONE), ReleasePowerup1)
+  , ((SDL.Scancode2, SDL.fromNumber SDLRaw.KMOD_NONE), ReleasePowerup2)
+  , ((SDL.Scancode3, SDL.fromNumber SDLRaw.KMOD_NONE), ReleasePowerup3)
+  , ((SDL.ScancodeLCtrl, SDL.fromNumber SDLRaw.KMOD_NONE), Spit)
+  , ((SDL.ScancodePause, SDL.fromNumber SDLRaw.KMOD_NONE), Pause)
+  ]