prepare for keyboard input events

This commit is contained in:
nek0 2021-01-11 12:01:07 +01:00
parent 5ec8901dd7
commit 24a04ecb36
4 changed files with 46 additions and 9 deletions

View File

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

View File

@ -57,7 +57,22 @@ main = do
withAffection config withAffection config
preLoad :: GameData -> Affection () 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 :: GameData -> [SDL.EventPayload] -> Affection ()
handle gd evs = do handle gd evs = do

View File

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

View File

@ -5,6 +5,8 @@ import qualified Data.Text as T
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified SDL import qualified SDL
import qualified SDL.Internal.Numbered as SDL (fromNumber)
import qualified SDL.Raw.Enum as SDLRaw
-- internal imports -- internal imports
@ -12,4 +14,20 @@ import Types.Subsystems
type Progress = (Float, T.Text) 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)
]