diff --git a/src/Classes/Scene.hs b/src/Classes/Scene.hs index a8e1763..bdba4b4 100644 --- a/src/Classes/Scene.hs +++ b/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 () diff --git a/src/Main.hs b/src/Main.hs index 9a89720..4a1e3ed 100644 --- a/src/Main.hs +++ b/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 diff --git a/src/Types/Subsystems.hs b/src/Types/Subsystems.hs index f677a4b..80df311 100644 --- a/src/Types/Subsystems.hs +++ b/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 diff --git a/src/Types/Util.hs b/src/Types/Util.hs index 7d44d82..e8a778c 100644 --- a/src/Types/Util.hs +++ b/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) + ]