Implement game engine
This commit is contained in:
parent
338305e32c
commit
3780e967cd
|
@ -31,8 +31,17 @@ handleEvents = mapMaybe getDir <$> liftTransS (constM ask)
|
|||
getDir _ = Nothing
|
||||
|
||||
tick :: Monad m => MSF (DrawerT m) (Maybe Direction) GameState
|
||||
tick = next initialState $ feedback initialState $ proc (dir, state) -> do
|
||||
returnA -< (state, state)
|
||||
tick =
|
||||
next initialState $
|
||||
mealy
|
||||
( \input state ->
|
||||
let moveDir = setDir state.moveDir input
|
||||
snakePos = movePos moveDir <$> state.snakePos
|
||||
berryPos = state.berryPos
|
||||
newstate = GameState {..}
|
||||
in (newstate, newstate)
|
||||
)
|
||||
initialState
|
||||
|
||||
mainSF :: Monad m => MSF (DrawerT m) () ()
|
||||
mainSF = proc () -> do
|
||||
|
|
|
@ -1,7 +1,6 @@
|
|||
module Game.State where
|
||||
|
||||
data Direction = U | D | L | R
|
||||
deriving (Show, Eq)
|
||||
|
||||
movePos :: Direction -> (Int, Int) -> (Int, Int)
|
||||
movePos U (x, y) = (x, y - 1)
|
||||
|
@ -9,6 +8,17 @@ movePos D (x, y) = (x, y + 1)
|
|||
movePos L (x, y) = (x - 1, y)
|
||||
movePos R (x, y) = (x + 1, y)
|
||||
|
||||
opposite :: Direction -> Direction -> Bool
|
||||
opposite U D = True
|
||||
opposite D U = True
|
||||
opposite L R = True
|
||||
opposite R L = True
|
||||
opposite _ _ = False
|
||||
|
||||
setDir :: Direction -> Maybe Direction -> Direction
|
||||
setDir d Nothing = d
|
||||
setDir d (Just d') = if opposite d d' then d else d'
|
||||
|
||||
data GameState = GameState
|
||||
{ snakePos :: [(Int, Int)],
|
||||
moveDir :: Direction,
|
||||
|
|
Loading…
Reference in a new issue