Add true randomness

Previously, randomness was faked via bad pseudo-randomness code, so
let's refactor some of this to add true randomness support.
This commit is contained in:
Kiana Sheibani 2024-04-21 03:39:41 -04:00
parent 7c61ddb24f
commit a6a70e5dca
Signed by: toki
GPG key ID: 6CB106C25E86A9F7
4 changed files with 48 additions and 23 deletions

View file

@ -12,5 +12,7 @@ executable snake
default-language: GHC2021 default-language: GHC2021
default-extensions: Arrows default-extensions: Arrows
build-depends: base, build-depends: base,
mtl,
random,
dunai, dunai,
gloss gloss

View file

@ -1,10 +1,10 @@
{-# LANGUAGE Arrows #-} {-# LANGUAGE Arrows #-}
{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE RecordWildCards #-}
module Game.Engine where module Game.Engine where
import Control.Monad (guard) import Control.Monad (guard)
import Control.Monad.Trans
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
@ -43,7 +43,7 @@ handleEvents = mapMaybe getDir <$> getKeys
-- * Core game engine -- * Core game engine
tickState :: Maybe Direction -> GameState -> Maybe GameState tickState :: Maybe Direction -> GameState -> MaybeT IO GameState
tickState dir state = tickState dir state =
let moveDir = setDir state.moveDir dir let moveDir = setDir state.moveDir dir
newBlock = movePos moveDir $ head state.snakePos newBlock = movePos moveDir $ head state.snakePos
@ -56,19 +56,16 @@ tickState dir state =
isHit = head snakePos `notElem` tail snakePos isHit = head snakePos `notElem` tail snakePos
berryPos = berryPos =
if hitBerry if hitBerry
then then randomPos
( (fst state.berryPos * 80 `div` 3) `mod` 15, else pure state.berryPos
(snd state.berryPos * 75 `div` 6) `mod` 15 in MaybeT $ (guard isHit $>) <$> (GameState snakePos moveDir <$> berryPos)
)
else state.berryPos
in guard isHit $> GameState {..}
tick :: Monad m => MSF (MaybeT (DrawerT m)) (Maybe Direction) GameState tick :: MonadIO m => MSF (MaybeT (DrawerT m)) (Maybe Direction) GameState
tick = feedback initialState $ proc (dir, state) -> do tick = feedbackM (liftIO randomState) $ proc (dir, state) -> do
newstate <- maybeExit -< tickState dir state newstate <- arrM (mapMaybeT (lift . lift . liftIO) . uncurry tickState) -< (dir, state)
returnA -< (newstate, newstate) returnA -< (newstate, newstate)
gameSF :: Monad m => MSF (MaybeT (DrawerT m)) () GameState gameSF :: MonadIO m => MSF (MaybeT (DrawerT m)) () GameState
gameSF = proc () -> do gameSF = proc () -> do
-- A "tick" is each frame that the snake advances -- A "tick" is each frame that the snake advances
n <- count -< () n <- count -< ()
@ -81,7 +78,7 @@ gameSF = proc () -> do
-- only run `tick` whenever there's a tick -- only run `tick` whenever there's a tick
pauseMSF undefined tick -< (dir, isTick) pauseMSF undefined tick -< (dir, isTick)
mainSF :: Monad m => MSF (DrawerT m) () () mainSF :: MonadIO m => MSF (DrawerT m) () ()
mainSF = proc () -> do mainSF = proc () -> do
keys <- getKeys -< () keys <- getKeys -< ()
let esc = SpecialKey KeyEsc `elem` keys let esc = SpecialKey KeyEsc `elem` keys

View file

@ -1,6 +1,11 @@
{-# LANGUAGE LambdaCase #-}
module Game.State where module Game.State where
data Direction = U | D | L | R import System.Random
import Control.Monad
data Direction = U | D | L | R deriving (Eq)
movePos :: Direction -> (Int, Int) -> (Int, Int) movePos :: Direction -> (Int, Int) -> (Int, Int)
movePos U (x, y) = (x, y + 1) movePos U (x, y) = (x, y + 1)
@ -8,16 +13,15 @@ movePos D (x, y) = (x, y - 1)
movePos L (x, y) = (x - 1, y) movePos L (x, y) = (x - 1, y)
movePos R (x, y) = (x + 1, y) movePos R (x, y) = (x + 1, y)
opposite :: Direction -> Direction -> Bool opposite :: Direction -> Direction
opposite U D = True opposite U = D
opposite D U = True opposite D = U
opposite L R = True opposite L = R
opposite R L = True opposite R = L
opposite _ _ = False
setDir :: Direction -> Maybe Direction -> Direction setDir :: Direction -> Maybe Direction -> Direction
setDir d Nothing = d setDir d Nothing = d
setDir d (Just d') = if opposite d d' then d else d' setDir d (Just d') = if opposite d == d' then d else d'
data GameState = GameState data GameState = GameState
{ snakePos :: [(Int, Int)], { snakePos :: [(Int, Int)],
@ -25,5 +29,21 @@ data GameState = GameState
berryPos :: (Int, Int) berryPos :: (Int, Int)
} }
initialState :: GameState initialLength :: Int
initialState = GameState [(4, 5), (4, 4), (5, 4)] R (3, 3) initialLength = 3
randomPos :: IO (Int, Int)
randomPos = (,) <$> randomRIO (-10, 10) <*> randomRIO (-10, 10)
randomState :: IO GameState
randomState = do
let randomDirection =
(\case
1 -> U
2 -> D
3 -> L
4 -> R) <$> randomRIO @Int (1,4)
dirs <- replicateM (initialLength - 1) randomDirection
hd <- randomPos
let snake = scanr movePos hd dirs
GameState snake <$> randomDirection <*> randomPos

View file

@ -52,6 +52,12 @@ draw = arrM tell
-- * MSF convenience functions -- * MSF convenience functions
feedbackM :: Monad m => m c -> MSF m (a, c) (b, c) -> MSF m a b
feedbackM init msf = feedback Nothing $ proc (x, state) -> do
state' <- arrM (maybe init pure) -< state
(y, newstate) <- msf -< (x, state')
returnA -< (y, Just newstate)
hold :: Monad m => a -> MSF m (Maybe a) a hold :: Monad m => a -> MSF m (Maybe a) a
hold = hold =
mealy mealy