Some refactoring
parent
7ecb72ff04
commit
359f1b83c8
|
@ -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
|
||||||
|
|
|
@ -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'
|
||||||
|
|
Loading…
Reference in New Issue