Some refactoring

engine-govind
Abhinav Sarkar 2015-07-16 10:25:21 +05:30
parent 7ecb72ff04
commit 359f1b83c8
2 changed files with 40 additions and 45 deletions

View File

@ -24,6 +24,7 @@ executable hastron
unordered-containers >=0.2.5 && <0.3, unordered-containers >=0.2.5 && <0.3,
dlist >= 0.7 && <0.8, dlist >= 0.7 && <0.8,
mtl >= 2.2 && <2.3, mtl >= 2.2 && <2.3,
bifunctors >=5 && <6,
hashable >=1.2 && <1.3 hashable >=1.2 && <1.3
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010

View File

@ -6,8 +6,9 @@ import Control.Applicative (Applicative)
import Control.Monad.Identity (Identity, runIdentity) import Control.Monad.Identity (Identity, runIdentity)
import Control.Monad.Reader (MonadReader, ask) import Control.Monad.Reader (MonadReader, ask)
import Control.Monad.RWS (MonadRWS, RWST, execRWST) import Control.Monad.RWS (MonadRWS, RWST, execRWST)
import Control.Monad.State (MonadState, get, put) import Control.Monad.State (MonadState, get, put, modify)
import Control.Monad.Writer (MonadWriter, tell) import Control.Monad.Writer (MonadWriter, tell)
import Data.Bifunctor (second)
import Data.DList (DList) import Data.DList (DList)
import qualified Data.DList as DList import qualified Data.DList as DList
import qualified Data.HashMap.Strict as Map import qualified Data.HashMap.Strict as Map
@ -16,21 +17,6 @@ import Data.List (foldl')
import Hastron.Game.Types import Hastron.Game.Types
import Prelude hiding (Left, Right) import Prelude hiding (Left, Right)
leftTurn :: Direction -> Direction
leftTurn Left = Down
leftTurn Right = Up
leftTurn Up = Left
leftTurn Down = Right
rightTurn :: Direction -> Direction
rightTurn Left = Up
rightTurn Right = Down
rightTurn Up = Right
rightTurn Down = Left
noTurn :: Direction -> Direction
noTurn = id
newtype GameEngine a = newtype GameEngine a =
GameEngine { _runGameEngine :: RWST GameSettings (DList OutEvent) (GameMap, Player) Identity a } GameEngine { _runGameEngine :: RWST GameSettings (DList OutEvent) (GameMap, Player) Identity a }
deriving ( Functor deriving ( Functor
@ -54,22 +40,22 @@ move timeElapsed = do
settings <- ask settings <- ask
go settings state go settings state
where where
go GameSettings{..} go GameSettings{ .. } (gameMap@GameMap{ .. }, player@Player{ .. })
(gameMap@GameMap{..}, player@Player{playerBoost = playerBoost@PlayerBoost{..}, ..})
| playerState /= PlayerAlive || timeElapsed < 0 = return () | playerState /= PlayerAlive || timeElapsed < 0 = return ()
| not boostActive || boostFuel >= timeElapsed = movePlayer | not boostActive || boostFuel >= timeElapsed = move'
| otherwise = | otherwise =
move boostFuel >> move (timeElapsed - boostFuel) move boostFuel >> move (timeElapsed - boostFuel)
where where
(x, y) = playerPosition (x, y) = playerPosition
(Velocity speed dir) = playerVelocity (Velocity speed dir) = playerVelocity
PlayerBoost{ .. } = playerBoost
dist = dist =
timeElapsed * speed * (if boostActive && boostFuel > 0 then gameBoostFactor else 1) timeElapsed * speed * (if boostActive && boostFuel > 0 then gameBoostFactor else 1)
move' Left = tail [(x', y) | x' <- [x, x - 1 .. x - dist]] makeTrail Left = tail [(x', y) | x' <- [x, x - 1 .. x - dist]]
move' Right = tail [(x', y) | x' <- [x .. x + dist]] makeTrail Right = tail [(x', y) | x' <- [x .. x + dist]]
move' Up = tail [(x, y') | y' <- [y, y - 1 .. y - dist]] makeTrail Up = tail [(x, y') | y' <- [y, y - 1 .. y - dist]]
move' Down = tail [(x, y') | y' <- [y .. y + dist]] makeTrail Down = tail [(x, y') | y' <- [y .. y + dist]]
checkTrail trail = checkTrail trail =
let trail' = takeWhile (not . flip Set.member gameMapBlockedPoints) trail let trail' = takeWhile (not . flip Set.member gameMapBlockedPoints) trail
@ -77,9 +63,9 @@ move timeElapsed = do
then (trail, PlayerAlive) then (trail, PlayerAlive)
else (trail', PlayerDead) else (trail', PlayerDead)
movePlayer = do move' = do
let let
revTrail = move' dir revTrail = makeTrail dir
(checkedTrail, playerState') = checkTrail revTrail (checkedTrail, playerState') = checkTrail revTrail
trail = reverse checkedTrail trail = reverse checkedTrail
pos' = if null trail then playerPosition else head trail pos' = if null trail then playerPosition else head trail
@ -97,32 +83,40 @@ move timeElapsed = do
put (gameMap', player') put (gameMap', player')
tell $ DList.fromList outEvents tell $ DList.fromList outEvents
leftTurn :: Direction -> Direction
leftTurn Left = Down
leftTurn Right = Up
leftTurn Up = Left
leftTurn Down = Right
rightTurn :: Direction -> Direction
rightTurn Left = Up
rightTurn Right = Down
rightTurn Up = Right
rightTurn Down = Left
noTurn :: Direction -> Direction
noTurn = id
turn :: (Direction -> Direction) -> GameEngine () turn :: (Direction -> Direction) -> GameEngine ()
turn turnFn = get >>= go turn turnFn = modify . second $ \player@Player{ playerVelocity = Velocity speed dir } ->
where player { playerVelocity = Velocity speed $ turnFn dir }
go (gameMap, player@Player{playerVelocity = Velocity speed dir}) =
put ( gameMap, player { playerVelocity = Velocity speed $ turnFn dir })
changeBoost :: Bool -> GameEngine () changeBoost :: Bool -> GameEngine ()
changeBoost boostActive = get >>= go changeBoost boostActive = modify . second $ \player@Player{ .. } ->
where player { playerBoost = playerBoost { boostActive = boostActive } }
go (gameMap, player@Player{..}) =
put (gameMap, player { playerBoost = playerBoost { boostActive = boostActive } })
refillBoost :: Int -> GameEngine () refillBoost :: Int -> GameEngine ()
refillBoost timeElapsed = do refillBoost timeElapsed = do
state <- get (gameMap, player@Player{ .. }) <- get
settings <- ask GameSettings{ .. } <- ask
go settings state let boostFuel' = floor (fromIntegral timeElapsed * gameBoostRefillFactor)
where playerBoost' = playerBoost { boostFuel = boostFuel' }
go GameSettings{..} (gameMap, player@Player{..}) = do put (gameMap, player { playerBoost = playerBoost' })
let boostFuel' = floor (fromIntegral timeElapsed * gameBoostRefillFactor) tell $ DList.fromList [OutPlayerBoostChange playerId playerBoost' | playerBoost /= playerBoost']
playerBoost' = playerBoost { boostFuel = boostFuel' }
put (gameMap, player { playerBoost = playerBoost' })
tell $ DList.fromList [OutPlayerBoostChange playerId playerBoost' | playerBoost /= playerBoost']
stepGame :: Game -> Int -> InEvent -> (Game, [OutEvent]) stepGame :: Game -> Int -> InEvent -> (Game, [OutEvent])
stepGame game@Game{gameMap = gameMap@GameMap{..}, ..} time = stepGame' stepGame game@Game{ gameMap = gameMap@GameMap{ .. }, .. } time = stepGame'
where where
stepGame' (InPlayerTurnLeft playerId) = stepEvent playerId $ turn leftTurn stepGame' (InPlayerTurnLeft playerId) = stepEvent playerId $ turn leftTurn
stepGame' (InPlayerTurnRight playerId) = stepEvent playerId $ turn rightTurn stepGame' (InPlayerTurnRight playerId) = stepEvent playerId $ turn rightTurn
@ -130,11 +124,11 @@ stepGame game@Game{gameMap = gameMap@GameMap{..}, ..} time = stepGame'
stepGame' (InPlayerBoostChange playerId boostActive) = stepEvent playerId $ changeBoost boostActive stepGame' (InPlayerBoostChange playerId boostActive) = stepEvent playerId $ changeBoost boostActive
stepEvent pId step = stepEvent pId step =
flip (maybe (game, [])) (Map.lookup pId gamePlayers) $ \player@Player{..} -> flip (maybe (game, [])) (Map.lookup pId gamePlayers) $ \player@Player{ .. } ->
if playerState /= PlayerAlive if playerState /= PlayerAlive
then (game, []) then (game, [])
else let else let
timeElapsed = (time - playerLastEventTime) timeElapsed = time - playerLastEventTime
fullStep = move timeElapsed >> step >> refillBoost timeElapsed fullStep = move timeElapsed >> step >> refillBoost timeElapsed
(gameMap', player'@Player{ playerPosition = pos' (gameMap', player'@Player{ playerPosition = pos'