Adds basic game step logic

arun
Abhinav Sarkar 2015-07-10 00:56:37 +05:30
parent e530f3aa68
commit 8b4f606469
3 changed files with 111 additions and 9 deletions

View File

@ -1,8 +1,81 @@
{-# LANGUAGE RecordWildCards #-}
module Hastron.Game.Engine where
import Hastron.Game.Types
import qualified Data.HashMap.Strict as Map
import qualified Data.HashSet as Set
import Data.List (foldl')
import Hastron.Game.Types
import Prelude hiding (Left, Right)
type GameStep = Game -> InEvent -> (Game, [OutEvent])
leftTurn :: Direction -> Direction
leftTurn Left = Down
leftTurn Right = Up
leftTurn Up = Left
leftTurn Down = Right
stepGame :: GameStep
stepGame game inEvent = undefined
rightTurn :: Direction -> Direction
rightTurn Left = Up
rightTurn Right = Down
rightTurn Up = Right
rightTurn Down = Left
noTurn :: Direction -> Direction
noTurn = id
move :: Point -> Velocity -> PlayerTrail
move (x, y) (Velocity speed Left) = tail [(x', y) | x' <- [x, x - 1 .. x - speed]]
move (x, y) (Velocity speed Right) = tail [(x', y) | x' <- [x .. x + speed]]
move (x, y) (Velocity speed Up) = tail [(x, y') | y' <- [y, y - 1 .. y - speed]]
move (x, y) (Velocity speed Down) = tail [(x, y') | y' <- [y .. y + speed]]
moveAfterTurn :: (Direction -> Direction) -> Point -> Velocity -> (PlayerTrail, Velocity)
moveAfterTurn turn point (Velocity speed dir) =
let vel' = Velocity speed $ turn dir
in (move point vel', vel')
checkTrail :: GameMap -> PlayerTrail -> (PlayerTrail, PlayerState)
checkTrail GameMap{..} trail =
let trail' = takeWhile (not . flip Set.member gameMapBlockedPoints) trail
in if trail' == trail
then (trail, PlayerAlive)
else (trail', PlayerDead)
stepGame :: Game -> InEvent -> (Game, [OutEvent])
stepGame game@Game{gameMap = gameMap@GameMap{..}, ..} inEvent = stepGame' inEvent
where
stepGame' (InPlayerTurnLeft playerId) = stepTurnEvent playerId $ moveAfterTurn leftTurn
stepGame' (InPlayerTurnRight playerId) = stepTurnEvent playerId $ moveAfterTurn rightTurn
stepGame' (InPlayerIdle playerId) = stepTurnEvent playerId $ moveAfterTurn noTurn
stepTurnEvent pId moveFn =
flip (maybe (game, [])) (Map.lookup pId gamePlayers) $ \player@Player{..} ->
if playerState /= PlayerAlive
then (game, [])
else let
(revTrail, vel'@(Velocity _ dir')) = moveFn playerPosition playerVelocity
(checkedTrail, playerState') = checkTrail gameMap revTrail
trail = reverse checkedTrail
pos' = if null trail then playerPosition else head trail
player' = player { playerState = playerState'
, playerPosition = pos'
, playerVelocity = vel'
, playerTrail = trail ++ playerTrail
, playerScore = playerScore + score playerPosition pos'
}
gameMap' = gameMap { gameMapBlockedPoints =
foldl' (flip Set.insert) gameMapBlockedPoints trail }
game' = game { gamePlayers = Map.insert playerId player' gamePlayers
, gameMap = gameMap' }
outEvents = [OutPlayerPosition playerId pos' dir'] ++
(if playerState /= playerState'
then [OutPlayerStateChange playerId playerState']
else [])
in (game', outEvents)
score (x1, y1) (x2, y2) = abs (x1 - x2) + abs (y1 - y2)
runGame :: Game -> [InEvent] -> (Game, [OutEvent])
runGame initialGame =
foldl (\(game, outEvents) inEvent -> let (game', outEvents') = stepGame game inEvent
in (game', outEvents ++ outEvents'))
(initialGame, [])

View File

@ -1,12 +1,17 @@
{-# LANGUAGE RecordWildCards #-}
module Hastron.Game.Types where
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as Map
import Data.HashSet (HashSet)
import qualified Data.HashSet as Set
import Data.Tuple (swap)
type Point = (Int, Int)
data Direction = Left | Right | Up | Down deriving (Show, Eq, Ord, Enum)
data Velocity = Velocity Double Direction deriving (Show, Eq, Ord)
data Velocity = Velocity Int Direction deriving (Show, Eq, Ord)
type PlayerId = Int
@ -39,19 +44,42 @@ data PlayerEndState = PlayerWinner | PlayerLoser | PlayerDropped
data GameState = GameStarted | GameInit | GameFinished
deriving (Show, Eq, Ord, Enum)
data Game = Game { gamePlayers :: [Player]
data GameMap = GameMap { size :: Int
, gameMapBlockedPoints :: HashSet Point }
deriving (Show, Eq)
data Game = Game { gamePlayers :: HashMap PlayerId Player
, gameState :: GameState
, gameMap :: GameMap
} deriving (Show, Eq)
type GameResult = HashMap PlayerId (PlayerScore, PlayerEndState)
data InEvent = InPlayerTurnLeft PlayerId
| InPlayerTurnRight PlayerId
| InPlayerBoostActivate PlayerId
| InPlayerBoostDeactivate PlayerId
| InPlayerStateChange PlayerId PlayerState
| InPlayerIdle PlayerId
deriving (Show, Eq, Ord)
data OutEvent = OutPlayerPosition PlayerId Point Direction
| OutPlayerStateChange PlayerId PlayerState Point
| OutPlayerStateChange PlayerId PlayerState
| OutGameStateChange GameState
| OutGameOver (HashMap PlayerId (PlayerScore, PlayerEndState))
| OutGameOver GameResult
deriving (Show, Eq)
emptyGameMap :: Int -> GameMap
emptyGameMap size = GameMap size $ Set.fromList borderPoints
where
borderPoints = let xs = [(x, y) | x <- [-1, size], y <- [0 .. size - 1]]
in xs ++ map swap xs
emptyGame :: Int -> Game
emptyGame size = Game Map.empty GameInit $ emptyGameMap size
addPlayer :: Game -> Player -> Game
addPlayer game@Game{gameMap = gameMap@GameMap{..}, ..} player@Player{..} =
game { gamePlayers = Map.insert playerId player gamePlayers
, gameMap = gameMap { gameMapBlockedPoints =
Set.insert playerPosition gameMapBlockedPoints }}

View File

@ -1,6 +1,7 @@
module Main where
import Hastron.Server.Types
import Hastron.Game.Engine
main :: IO()
main = putStrLn "Hello World"