Implement event handler
This commit is contained in:
parent
90afdcd7bb
commit
338305e32c
|
@ -1,14 +1,34 @@
|
||||||
{-# LANGUAGE Arrows #-}
|
{-# LANGUAGE Arrows #-}
|
||||||
|
{-# LANGUAGE OverloadedRecordDot #-}
|
||||||
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
|
|
||||||
module Game.Engine where
|
module Game.Engine where
|
||||||
|
|
||||||
|
import Control.Monad.Trans.MSF.Reader
|
||||||
|
import Control.Monad.Trans.MSF.Writer
|
||||||
|
import Data.Maybe
|
||||||
import Data.MonadicStreamFunction
|
import Data.MonadicStreamFunction
|
||||||
|
import Game.Display
|
||||||
import Game.State
|
import Game.State
|
||||||
import Game.Utils
|
import Game.Utils
|
||||||
|
import Graphics.Gloss
|
||||||
|
import Graphics.Gloss.Interface.IO.Game
|
||||||
|
|
||||||
handleEvents :: Monad m => MSF (DrawerT m) () [Direction]
|
handleEvents :: Monad m => MSF (DrawerT m) () [Direction]
|
||||||
handleEvents = proc () -> do
|
handleEvents = mapMaybe getDir <$> liftTransS (constM ask)
|
||||||
returnA -< []
|
where
|
||||||
|
getDir :: Event -> Maybe Direction
|
||||||
|
getDir (EventKey k Down _ _) = case k of
|
||||||
|
Char 'w' -> Just U
|
||||||
|
Char 's' -> Just D
|
||||||
|
Char 'a' -> Just L
|
||||||
|
Char 'd' -> Just R
|
||||||
|
SpecialKey KeyUp -> Just U
|
||||||
|
SpecialKey KeyDown -> Just D
|
||||||
|
SpecialKey KeyLeft -> Just L
|
||||||
|
SpecialKey KeyRight -> Just R
|
||||||
|
_ -> Nothing
|
||||||
|
getDir _ = Nothing
|
||||||
|
|
||||||
tick :: Monad m => MSF (DrawerT m) (Maybe Direction) GameState
|
tick :: Monad m => MSF (DrawerT m) (Maybe Direction) GameState
|
||||||
tick = next initialState $ feedback initialState $ proc (dir, state) -> do
|
tick = next initialState $ feedback initialState $ proc (dir, state) -> do
|
||||||
|
|
Loading…
Reference in a new issue