Browse Source

prepare for keyboard input events

master
nek0 9 months ago
parent
commit
24a04ecb36
  1. 5
      src/Classes/Scene.hs
  2. 17
      src/Main.hs
  3. 13
      src/Types/Subsystems.hs
  4. 20
      src/Types/Util.hs

5
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 ()

17
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

13
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

20
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)
]

Loading…
Cancel
Save