prepare for keyboard input events
This commit is contained in:
parent
5ec8901dd7
commit
24a04ecb36
|
@ -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 ()
|
||||||
|
|
17
src/Main.hs
17
src/Main.hs
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
]
|
||||||
|
|
Loading…
Reference in New Issue