Fixes boostfuel refill calculation.
parent
359f1b83c8
commit
8631d00bcc
|
@ -34,7 +34,7 @@ stepGameEngine gameSettings gameMap player =
|
||||||
. (\rwst -> execRWST rwst gameSettings (gameMap, player))
|
. (\rwst -> execRWST rwst gameSettings (gameMap, player))
|
||||||
. _runGameEngine
|
. _runGameEngine
|
||||||
|
|
||||||
move :: Int -> GameEngine ()
|
move :: TimeInterval -> GameEngine ()
|
||||||
move timeElapsed = do
|
move timeElapsed = do
|
||||||
state <- get
|
state <- get
|
||||||
settings <- ask
|
settings <- ask
|
||||||
|
@ -48,7 +48,7 @@ move timeElapsed = do
|
||||||
where
|
where
|
||||||
(x, y) = playerPosition
|
(x, y) = playerPosition
|
||||||
(Velocity speed dir) = playerVelocity
|
(Velocity speed dir) = playerVelocity
|
||||||
PlayerBoost{ .. } = playerBoost
|
PlayerBoost{ .. } = playerBoost
|
||||||
dist =
|
dist =
|
||||||
timeElapsed * speed * (if boostActive && boostFuel > 0 then gameBoostFactor else 1)
|
timeElapsed * speed * (if boostActive && boostFuel > 0 then gameBoostFactor else 1)
|
||||||
|
|
||||||
|
@ -95,9 +95,6 @@ rightTurn Right = Down
|
||||||
rightTurn Up = Right
|
rightTurn Up = Right
|
||||||
rightTurn Down = Left
|
rightTurn Down = Left
|
||||||
|
|
||||||
noTurn :: Direction -> Direction
|
|
||||||
noTurn = id
|
|
||||||
|
|
||||||
turn :: (Direction -> Direction) -> GameEngine ()
|
turn :: (Direction -> Direction) -> GameEngine ()
|
||||||
turn turnFn = modify . second $ \player@Player{ playerVelocity = Velocity speed dir } ->
|
turn turnFn = modify . second $ \player@Player{ playerVelocity = Velocity speed dir } ->
|
||||||
player { playerVelocity = Velocity speed $ turnFn dir }
|
player { playerVelocity = Velocity speed $ turnFn dir }
|
||||||
|
@ -106,21 +103,21 @@ changeBoost :: Bool -> GameEngine ()
|
||||||
changeBoost boostActive = modify . second $ \player@Player{ .. } ->
|
changeBoost boostActive = modify . second $ \player@Player{ .. } ->
|
||||||
player { playerBoost = playerBoost { boostActive = boostActive } }
|
player { playerBoost = playerBoost { boostActive = boostActive } }
|
||||||
|
|
||||||
refillBoost :: Int -> GameEngine ()
|
refillBoost :: Timestamp -> GameEngine ()
|
||||||
refillBoost timeElapsed = do
|
refillBoost timeElapsed = do
|
||||||
(gameMap, player@Player{ .. }) <- get
|
(gameMap, player@Player{ .. }) <- get
|
||||||
GameSettings{ .. } <- ask
|
GameSettings{ .. } <- ask
|
||||||
let boostFuel' = floor (fromIntegral timeElapsed * gameBoostRefillFactor)
|
let boostFuel' = floor (fromIntegral timeElapsed * gameBoostRefillFactor)
|
||||||
playerBoost' = playerBoost { boostFuel = boostFuel' }
|
playerBoost' = playerBoost { boostFuel = boostFuel playerBoost + boostFuel' }
|
||||||
put (gameMap, player { playerBoost = playerBoost' })
|
put (gameMap, player { playerBoost = playerBoost' })
|
||||||
tell $ DList.fromList [OutPlayerBoostChange playerId playerBoost' | playerBoost /= playerBoost']
|
tell $ DList.fromList [OutPlayerBoostChange playerId playerBoost' | playerBoost /= playerBoost']
|
||||||
|
|
||||||
stepGame :: Game -> Int -> InEvent -> (Game, [OutEvent])
|
stepGame :: Game -> Timestamp -> 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
|
||||||
stepGame' (InPlayerIdle playerId) = stepEvent playerId $ turn noTurn
|
stepGame' (InPlayerIdle playerId) = stepEvent playerId $ return ()
|
||||||
stepGame' (InPlayerBoostChange playerId boostActive) = stepEvent playerId $ changeBoost boostActive
|
stepGame' (InPlayerBoostChange playerId boostActive) = stepEvent playerId $ changeBoost boostActive
|
||||||
|
|
||||||
stepEvent pId step =
|
stepEvent pId step =
|
||||||
|
@ -144,7 +141,7 @@ stepGame game@Game{ gameMap = gameMap@GameMap{ .. }, .. } time = stepGame'
|
||||||
|
|
||||||
score (x1, y1) (x2, y2) = abs (x1 - x2) + abs (y1 - y2)
|
score (x1, y1) (x2, y2) = abs (x1 - x2) + abs (y1 - y2)
|
||||||
|
|
||||||
runGame :: Game -> [(Int, InEvent)] -> (Game, [OutEvent])
|
runGame :: Game -> [(Timestamp, InEvent)] -> (Game, [OutEvent])
|
||||||
runGame initialGame =
|
runGame initialGame =
|
||||||
foldl (\(game, outEvents) (time, inEvent) ->
|
foldl (\(game, outEvents) (time, inEvent) ->
|
||||||
fmap (outEvents ++) $ stepGame game time inEvent)
|
fmap (outEvents ++) $ stepGame game time inEvent)
|
||||||
|
|
|
@ -7,75 +7,78 @@ import Data.HashSet (HashSet)
|
||||||
import qualified Data.HashSet as Set
|
import qualified Data.HashSet as Set
|
||||||
import Data.Tuple (swap)
|
import Data.Tuple (swap)
|
||||||
|
|
||||||
type Point = (Int, Int)
|
type Point = (Int, Int)
|
||||||
|
|
||||||
data Direction = Left | Right | Up | Down deriving (Show, Eq, Ord, Enum)
|
type Timestamp = Int
|
||||||
|
|
||||||
data Velocity = Velocity Int Direction deriving (Show, Eq, Ord)
|
type TimeInterval = Int
|
||||||
|
|
||||||
type PlayerId = Int
|
data Direction = Left | Right | Up | Down deriving (Show, Eq, Ord, Enum)
|
||||||
|
|
||||||
data PlayerState = PlayerAlive
|
data Velocity = Velocity Int Direction deriving (Show, Eq, Ord)
|
||||||
| PlayerDead
|
|
||||||
| PlayerDisconnected
|
|
||||||
| PlayerLeft
|
|
||||||
deriving (Show, Eq, Ord, Enum)
|
|
||||||
|
|
||||||
type PlayerTrail = [Point]
|
type PlayerId = Int
|
||||||
|
|
||||||
data PlayerBoost = PlayerBoost { boostActive :: Bool
|
data PlayerState = PlayerAlive
|
||||||
, boostFuel :: Int
|
| PlayerDead
|
||||||
} deriving (Show, Eq)
|
| PlayerDisconnected
|
||||||
|
| PlayerLeft
|
||||||
|
deriving (Show, Eq, Ord, Enum)
|
||||||
|
|
||||||
type PlayerScore = Int
|
type PlayerTrail = [Point]
|
||||||
|
|
||||||
data Player = Player { playerId :: PlayerId
|
data PlayerBoost = PlayerBoost { boostActive :: Bool
|
||||||
, playerState :: PlayerState
|
, boostFuel :: Int
|
||||||
, playerPosition :: Point
|
} deriving (Show, Eq)
|
||||||
, playerVelocity :: Velocity
|
|
||||||
, playerTrail :: PlayerTrail
|
type PlayerScore = Int
|
||||||
, playerBoost :: PlayerBoost
|
|
||||||
, playerScore :: PlayerScore
|
data Player = Player { playerId :: PlayerId
|
||||||
, playerLastEventTime :: Int
|
, playerState :: PlayerState
|
||||||
} deriving (Show, Eq)
|
, playerPosition :: Point
|
||||||
|
, playerVelocity :: Velocity
|
||||||
|
, playerTrail :: PlayerTrail
|
||||||
|
, playerBoost :: PlayerBoost
|
||||||
|
, playerScore :: PlayerScore
|
||||||
|
, playerLastEventTime :: Int
|
||||||
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
data PlayerEndState = PlayerWinner | PlayerLoser | PlayerDropped
|
data PlayerEndState = PlayerWinner | PlayerLoser | PlayerDropped
|
||||||
deriving (Show, Eq, Ord, Enum)
|
deriving (Show, Eq, Ord, Enum)
|
||||||
|
|
||||||
data GameState = GameStarted | GameInit | GameFinished
|
data GameState = GameStarted | GameInit | GameFinished
|
||||||
deriving (Show, Eq, Ord, Enum)
|
deriving (Show, Eq, Ord, Enum)
|
||||||
|
|
||||||
data GameMap = GameMap { size :: Int
|
data GameMap = GameMap { size :: Int
|
||||||
, gameMapBlockedPoints :: HashSet Point }
|
, gameMapBlockedPoints :: HashSet Point
|
||||||
deriving (Show, Eq)
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
data GameSettings = GameSettings { gameBoostFactor :: Int
|
data GameSettings = GameSettings { gameBoostFactor :: Int
|
||||||
, gameBoostRefillFactor :: Double
|
, gameBoostRefillFactor :: Double
|
||||||
}
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
|
data Game = Game { gamePlayers :: HashMap PlayerId Player
|
||||||
|
, gameState :: GameState
|
||||||
|
, gameSettings :: GameSettings
|
||||||
|
, gameMap :: GameMap
|
||||||
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
|
type GameResult = HashMap PlayerId (PlayerScore, PlayerEndState)
|
||||||
|
|
||||||
|
data InEvent = InPlayerTurnLeft PlayerId
|
||||||
|
| InPlayerTurnRight PlayerId
|
||||||
|
| InPlayerBoostChange PlayerId Bool
|
||||||
|
| InPlayerStateChange PlayerId PlayerState
|
||||||
|
| InPlayerIdle PlayerId
|
||||||
|
deriving (Show, Eq, Ord)
|
||||||
|
|
||||||
|
data OutEvent = OutPlayerPosition PlayerId Point Direction
|
||||||
|
| OutPlayerStateChange PlayerId PlayerState
|
||||||
|
| OutPlayerBoostChange PlayerId PlayerBoost
|
||||||
|
| OutGameStateChange GameState
|
||||||
|
| OutGameOver GameResult
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
data Game = Game { gamePlayers :: HashMap PlayerId Player
|
|
||||||
, gameState :: GameState
|
|
||||||
, gameSettings :: GameSettings
|
|
||||||
, gameMap :: GameMap
|
|
||||||
} deriving (Show, Eq)
|
|
||||||
|
|
||||||
type GameResult = HashMap PlayerId (PlayerScore, PlayerEndState)
|
|
||||||
|
|
||||||
data InEvent = InPlayerTurnLeft PlayerId
|
|
||||||
| InPlayerTurnRight PlayerId
|
|
||||||
| InPlayerBoostChange PlayerId Bool
|
|
||||||
| InPlayerStateChange PlayerId PlayerState
|
|
||||||
| InPlayerIdle PlayerId
|
|
||||||
deriving (Show, Eq, Ord)
|
|
||||||
|
|
||||||
data OutEvent = OutPlayerPosition PlayerId Point Direction
|
|
||||||
| OutPlayerStateChange PlayerId PlayerState
|
|
||||||
| OutPlayerBoostChange PlayerId PlayerBoost
|
|
||||||
| OutGameStateChange GameState
|
|
||||||
| OutGameOver GameResult
|
|
||||||
deriving (Show, Eq)
|
|
||||||
|
|
||||||
newGameMap :: Int -> GameMap
|
newGameMap :: Int -> GameMap
|
||||||
newGameMap size = GameMap size $ Set.fromList borderPoints
|
newGameMap size = GameMap size $ Set.fromList borderPoints
|
||||||
where
|
where
|
||||||
|
@ -83,18 +86,18 @@ newGameMap size = GameMap size $ Set.fromList borderPoints
|
||||||
in xs ++ map swap xs
|
in xs ++ map swap xs
|
||||||
|
|
||||||
newGame :: Int -> GameSettings -> Game
|
newGame :: Int -> GameSettings -> Game
|
||||||
newGame size gameSettings = Game { gamePlayers = Map.empty
|
newGame size gameSettings = Game { gamePlayers = Map.empty
|
||||||
, gameState = GameInit
|
, gameState = GameInit
|
||||||
, gameSettings = gameSettings
|
, gameSettings = gameSettings
|
||||||
, gameMap = newGameMap size
|
, gameMap = newGameMap size
|
||||||
}
|
}
|
||||||
|
|
||||||
newPlayer :: Int -> Point -> Velocity -> Int -> Player
|
newPlayer :: Int -> Point -> Velocity -> Int -> Player
|
||||||
newPlayer pId pos velocity boost =
|
newPlayer pId pos velocity boost =
|
||||||
Player pId PlayerAlive pos velocity [pos] (PlayerBoost False boost) 0 0
|
Player pId PlayerAlive pos velocity [pos] (PlayerBoost False boost) 0 0
|
||||||
|
|
||||||
addPlayer :: Game -> Player -> Game
|
addPlayer :: Game -> Player -> Game
|
||||||
addPlayer game@Game{gameMap = gameMap@GameMap{..}, ..} player@Player{..} =
|
addPlayer game@Game{ gameMap = gameMap@GameMap{ .. }, .. } player@Player{ .. } =
|
||||||
game { gamePlayers = Map.insert playerId player gamePlayers
|
game { gamePlayers = Map.insert playerId player gamePlayers
|
||||||
, gameMap = gameMap { gameMapBlockedPoints =
|
, gameMap = gameMap { gameMapBlockedPoints =
|
||||||
Set.insert playerPosition gameMapBlockedPoints }}
|
Set.insert playerPosition gameMapBlockedPoints } }
|
||||||
|
|
Loading…
Reference in New Issue