Separate pure game logic from tick function

This commit is contained in:
Kiana Sheibani 2023-01-28 16:07:19 -05:00
parent c449d1e892
commit 9da1dee6bc
Signed by: toki
GPG key ID: 6CB106C25E86A9F7
3 changed files with 34 additions and 16 deletions

View file

@ -4,6 +4,7 @@
module Game.Engine where module Game.Engine where
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.Maybe import Data.Maybe
@ -30,27 +31,40 @@ handleEvents = mapMaybe getDir <$> liftTransS (constM ask)
_ -> Nothing _ -> Nothing
getDir _ = Nothing getDir _ = Nothing
tick :: Monad m => MSF (DrawerT m) (Maybe Direction) GameState
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) () () tickState :: Maybe Direction -> GameState -> Maybe GameState
tickState dir state =
let moveDir = setDir state.moveDir dir
newBlock = movePos moveDir $ head state.snakePos
hitBerry = newBlock == state.berryPos
snakePos =
newBlock
: if hitBerry
then state.snakePos
else init state.snakePos
isHit = head snakePos `notElem` tail snakePos
berryPos =
if hitBerry
then
( (fst state.berryPos * 80 `div` 3) `mod` 15,
(snd state.berryPos * 75 `div` 6) `mod` 15
)
else state.berryPos
in guard isHit $> GameState {..}
tick :: Monad m => MSF (MaybeT (DrawerT m)) (Maybe Direction) GameState
tick = feedback initialState $ proc (dir, state) -> do
newstate <- maybeExit -< tickState dir state
returnA -< (newstate, newstate)
mainSF :: Monad m => MSF (MaybeT (DrawerT m)) () ()
mainSF = proc () -> do mainSF = proc () -> do
-- A "tick" is each frame that the snake advances -- A "tick" is each frame that the snake advances
n <- count -< () n <- count -< ()
let isTick = n `mod` 8 == 1 let isTick = n `mod` 8 == 1
-- Handle inputs (buffer) -- Handle inputs (buffer)
dirs <- handleEvents -< () dirs <- liftTransS handleEvents -< ()
dir <- fifoGate -< (dirs, isTick) dir <- fifoGate -< (dirs, isTick)
state' <- state' <-
@ -61,4 +75,4 @@ mainSF = proc () -> do
state <- hold undefined -< state' state <- hold undefined -< state'
-- Display the current state -- Display the current state
displayState -< state liftTransS displayState -< state

View file

@ -26,4 +26,4 @@ data GameState = GameState
} }
initialState :: GameState initialState :: GameState
initialState = GameState [(4, 4)] R (3, 3) initialState = GameState [(4, 5), (4, 4), (5, 4)] R (3, 3)

View file

@ -1,5 +1,6 @@
module Game.Utils where module Game.Utils where
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.IORef import Data.IORef
@ -71,3 +72,6 @@ fifoGate =
where where
safeSnoc [] = (Nothing, []) safeSnoc [] = (Nothing, [])
safeSnoc (x : xs) = (Just x, xs) safeSnoc (x : xs) = (Just x, xs)
loopMaybe :: Monad m => MSF (MaybeT m) a b -> MSF m a b
loopMaybe msf = msf `catchMaybe` loopMaybe msf