Separate key-getting function from event handler

This commit is contained in:
Kiana Sheibani 2023-01-28 16:07:41 -05:00
parent 9da1dee6bc
commit 0f54f532f0
Signed by: toki
GPG key ID: 6CB106C25E86A9F7

View file

@ -4,9 +4,11 @@
module Game.Engine where module Game.Engine where
import Control.Monad (guard)
import Control.Monad.Trans.MSF.Maybe import Control.Monad.Trans.MSF.Maybe
import Control.Monad.Trans.MSF.Reader import Control.Monad.Trans.MSF.Reader
import Control.Monad.Trans.MSF.Writer import Control.Monad.Trans.MSF.Writer
import Data.Functor (($>))
import Data.Maybe import Data.Maybe
import Data.MonadicStreamFunction import Data.MonadicStreamFunction
import Game.Display import Game.Display
@ -15,22 +17,30 @@ import Game.Utils
import Graphics.Gloss import Graphics.Gloss
import Graphics.Gloss.Interface.IO.Game import Graphics.Gloss.Interface.IO.Game
handleEvents :: Monad m => MSF (DrawerT m) () [Direction] -- * Input handling
handleEvents = mapMaybe getDir <$> liftTransS (constM ask)
getKeys :: Monad m => MSF (DrawerT m) () [Key]
getKeys = mapMaybe getKey <$> liftTransS (constM ask)
where where
getDir :: Event -> Maybe Direction getKey :: Event -> Maybe Key
getDir (EventKey k Down _ _) = case k of getKey (EventKey k Down _ _) = Just k
Char 'w' -> Just U getKey _ = Nothing
Char 's' -> Just D
Char 'a' -> Just L handleEvents :: Monad m => MSF (DrawerT m) () [Direction]
Char 'd' -> Just R handleEvents = mapMaybe getDir <$> getKeys
SpecialKey KeyUp -> Just U where
SpecialKey KeyDown -> Just D getDir :: Key -> Maybe Direction
SpecialKey KeyLeft -> Just L getDir (Char 'w') = Just U
SpecialKey KeyRight -> Just R getDir (Char 's') = Just D
_ -> Nothing getDir (Char 'a') = Just L
getDir (Char 'd') = Just R
getDir (SpecialKey KeyUp) = Just U
getDir (SpecialKey KeyDown) = Just D
getDir (SpecialKey KeyLeft) = Just L
getDir (SpecialKey KeyRight) = Just R
getDir _ = Nothing getDir _ = Nothing
-- * Core game engine
tickState :: Maybe Direction -> GameState -> Maybe GameState tickState :: Maybe Direction -> GameState -> Maybe GameState
tickState dir state = tickState dir state =