diff --git a/src/Game/Engine.hs b/src/Game/Engine.hs index 8181d96..f466650 100644 --- a/src/Game/Engine.hs +++ b/src/Game/Engine.hs @@ -1,14 +1,34 @@ {-# LANGUAGE Arrows #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE RecordWildCards #-} module Game.Engine where +import Control.Monad.Trans.MSF.Reader +import Control.Monad.Trans.MSF.Writer +import Data.Maybe import Data.MonadicStreamFunction +import Game.Display import Game.State import Game.Utils +import Graphics.Gloss +import Graphics.Gloss.Interface.IO.Game handleEvents :: Monad m => MSF (DrawerT m) () [Direction] -handleEvents = proc () -> do - returnA -< [] +handleEvents = mapMaybe getDir <$> liftTransS (constM ask) + 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 = next initialState $ feedback initialState $ proc (dir, state) -> do