Fixes boostfuel refill calculation.

.gitignore

@@ -15,11 +15,3 @@ cabal.sandbox.config
 *.prof
 *.aux
 *.hp
-
-# Vim
-[._]*.s[a-w][a-z]
-[._]s[a-w][a-z]
-*.un~
-Session.vim
-.netrwhist
-*~

Main.hs

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

Setup.hs

@@ -1,2 +1,2 @@
-import           Distribution.Simple
+import Distribution.Simple
 main = defaultMain

hastron.cabal

@@ -1,50 +1,31 @@
+-- Initial hastron.cabal generated by cabal init.  For further
+-- documentation, see http://haskell.org/cabal/users-guide/
+
 name:                hastron
 version:             0.1.0.0
+-- synopsis:
+-- description:
 license:             MIT
 license-file:        LICENSE
 author:              Abhinav Sarkar
 maintainer:          abhinav@abhinavsarkar.net
+-- copyright:
 category:            Game
 build-type:          Simple
 extra-source-files:  README.md
 cabal-version:       >=1.10
 
-library
-  default-language:   Haskell2010
-  ghc-options:        -Wall
-  hs-source-dirs:     src
-  exposed-modules: 
-    Hastron.Server.Types
-    Hastron.Utils
-    Hastron.Game.Player
-    Hastron.Game.Types
-    Hastron.Game.Engine
-  build-depends:    
-    base >=4.7 && <4.9,
-    text >=1.2 && <1.3,
-    unordered-containers >=0.2.5 && <0.3,
-    hashable >=1.2 && <1.3
-
-
 executable hastron
   main-is:             Main.hs
-  ghc-options:         -Wall
-  build-depends:       
-    base >=4.7 && <4.9,
-    hastron
+  other-modules:       Hastron.Server.Types
+  -- other-extensions:
+  build-depends:       base >=4.7 && <4.9,
+                       text >=1.2 && <1.3,
+                       unordered-containers >=0.2.5 && <0.3,
+                       dlist >= 0.7 && <0.8,
+                       mtl >= 2.2 && <2.3,
+                       bifunctors >=5 && <6,
+                       hashable >=1.2 && <1.3
+  hs-source-dirs:      src
   default-language:    Haskell2010
-
-test-suite test
-  type:               exitcode-stdio-1.0
-  ghc-options:        -Wall
-  default-language:   Haskell2010
-  hs-source-dirs:     tests
-  main-is:            TestMain.hs
-  build-depends:      
-    base >=4.7 && <4.9,
-    hastron, 
-    tasty >=0.10 && <0.11,
-    tasty-hunit >=0.9 && <0.10,
-    tasty-quickcheck >=0.8 && <0.9,
-    QuickCheck >=2.8 && <2.9
-
+  ghc-options:         -Wall

src/Hastron/Game/Engine.hs

@@ -34,7 +34,7 @@ stepGameEngine gameSettings gameMap player =
   . (\rwst -> execRWST rwst gameSettings (gameMap, player))
   . _runGameEngine
 
-move :: Int -> GameEngine ()
+move :: TimeInterval -> GameEngine ()
 move timeElapsed = do
   state    <- get
   settings <- ask
@@ -48,7 +48,7 @@ move timeElapsed = do
       where
         (x, y)               = playerPosition
         (Velocity speed dir) = playerVelocity
-        PlayerBoost{ .. }      = playerBoost
+        PlayerBoost{ .. }    = playerBoost
         dist                 =
           timeElapsed * speed * (if boostActive && boostFuel > 0 then gameBoostFactor else 1)
 
@@ -95,9 +95,6 @@ rightTurn Right = Down
 rightTurn Up    = Right
 rightTurn Down  = Left
 
-noTurn :: Direction -> Direction
-noTurn = id
-
 turn :: (Direction -> Direction) -> GameEngine ()
 turn turnFn = modify . second $ \player@Player{ playerVelocity = Velocity speed dir } ->
   player { playerVelocity = Velocity speed $ turnFn dir }
@@ -106,21 +103,21 @@ changeBoost :: Bool -> GameEngine ()
 changeBoost boostActive = modify . second $ \player@Player{ .. } ->
   player { playerBoost = playerBoost { boostActive = boostActive } }
 
-refillBoost :: Int -> GameEngine ()
+refillBoost :: Timestamp -> GameEngine ()
 refillBoost timeElapsed = do
   (gameMap, player@Player{ .. }) <- get
   GameSettings{ .. }             <- ask
   let boostFuel'   = floor (fromIntegral timeElapsed * gameBoostRefillFactor)
-      playerBoost' = playerBoost { boostFuel = boostFuel' }
+      playerBoost' = playerBoost { boostFuel = boostFuel playerBoost + boostFuel' }
   put (gameMap, player { 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'
   where
     stepGame' (InPlayerTurnLeft playerId)                = stepEvent playerId $ turn leftTurn
     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
 
     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)
 
-runGame :: Game -> [(Int, InEvent)] -> (Game, [OutEvent])
+runGame :: Game -> [(Timestamp, InEvent)] -> (Game, [OutEvent])
 runGame initialGame =
   foldl (\(game, outEvents) (time, inEvent) ->
             fmap (outEvents ++) $ stepGame game time inEvent)

src/Hastron/Game/Player.hs

@@ -1,26 +0,0 @@
-module Hastron.Game.Player where
-
-import           Hastron.Game.Types
-import qualified Hastron.Utils      as Utils
-
-turn :: Direction -> Player -> Player
-turn dir player = player { playerVelocity = changeDirection (playerVelocity player) dir }
-  where changeDirection (Velocity v _) d = Velocity v d
-
-turnRight :: Player -> Player
-turnRight player = turn (Utils.nextEnum (direction player)) player
-
-turnLeft :: Player -> Player
-turnLeft player = turn (Utils.prevEnum (direction player)) player
-
-direction :: Player -> Direction
-direction Player {playerVelocity=(Velocity _ dir)} = dir
-
-toggleBoost :: PlayerBoost -> PlayerBoost
-toggleBoost boost@(PlayerBoost { boostActive = curr }) = boost { boostActive = not curr }
-
-updateBoostValue :: (Double -> Double) -> PlayerBoost -> PlayerBoost
-updateBoostValue func boost@(PlayerBoost {boostFuel = fuel}) = boost { boostFuel = func fuel }
-
-changeState :: PlayerState -> Player -> Player
-changeState new player = player { playerState = new }

src/Hastron/Game/Types.hs

@@ -7,79 +7,78 @@ import           Data.HashSet        (HashSet)
 import qualified Data.HashSet        as Set
 import           Data.Tuple          (swap)
 
-type Point = (Int, Int)
+type Point          = (Int, Int)
 
-data Direction = Left
-               | Up
-               | Right
-               | Down
-               deriving (Show, Eq, Ord, Enum, Bounded)
+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
-                 | PlayerDead
-                 | PlayerDisconnected
-                 | PlayerLeft
-                 deriving (Show, Eq, Ord, Enum, Bounded)
+data Velocity       = Velocity Int Direction deriving (Show, Eq, Ord)
 
-type PlayerTrail = [Point]
+type PlayerId       = Int
 
-data PlayerBoost = PlayerBoost { boostActive :: Bool
-                               , boostFuel   :: Int
-                               } deriving (Show, Eq)
+data PlayerState    = PlayerAlive
+                    | PlayerDead
+                    | PlayerDisconnected
+                    | PlayerLeft
+                    deriving (Show, Eq, Ord, Enum)
 
-type PlayerScore = Int
+type PlayerTrail    = [Point]
 
-data Player = Player { playerId            :: PlayerId
-                     , playerState         :: PlayerState
-                     , playerPosition      :: Point
-                     , playerVelocity      :: Velocity
-                     , playerTrail         :: PlayerTrail
-                     , playerBoost         :: PlayerBoost
-                     , playerScore         :: PlayerScore
-                     , playerLastEventTime :: Int
-                     } deriving (Show, Eq)
+data PlayerBoost    = PlayerBoost { boostActive :: Bool
+                                  , boostFuel   :: Int
+                                  } deriving (Show, Eq)
+
+type PlayerScore    = Int
+
+data Player         = Player { playerId            :: PlayerId
+                             , playerState         :: PlayerState
+                             , playerPosition      :: Point
+                             , playerVelocity      :: Velocity
+                             , playerTrail         :: PlayerTrail
+                             , playerBoost         :: PlayerBoost
+                             , playerScore         :: PlayerScore
+                             , playerLastEventTime :: Int
+                             } deriving (Show, Eq)
 
 data PlayerEndState = PlayerWinner | PlayerLoser | PlayerDropped
-                      deriving (Show, Eq, Ord, Enum, Bounded)
+                      deriving (Show, Eq, Ord, Enum)
 
-data GameState = GameStarted | GameInit | GameFinished
-                 deriving (Show, Eq, Ord, Enum)
+data GameState      = GameStarted | GameInit | GameFinished
+                      deriving (Show, Eq, Ord, Enum)
 
-data GameMap = GameMap { size                 :: Int
-                       , gameMapBlockedPoints :: HashSet Point }
-               deriving (Show, Eq)
+data GameMap        = GameMap { size                 :: Int
+                              , gameMapBlockedPoints :: HashSet Point
+                              } deriving (Show, Eq)
 
-data GameSettings = GameSettings { gameBoostFactor       :: Int
-                                 , gameBoostRefillFactor :: Double
-                                 }
+data GameSettings   = GameSettings { gameBoostFactor       :: Int
+                                   , 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)
 
-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 size = GameMap size $ Set.fromList borderPoints
   where
@@ -87,18 +86,18 @@ newGameMap size = GameMap size $ Set.fromList borderPoints
                    in xs ++ map swap xs
 
 newGame :: Int -> GameSettings -> Game
-newGame size gameSettings = Game { gamePlayers   = Map.empty
-                                  , gameState    = GameInit
-                                  , gameSettings = gameSettings
-                                  , gameMap      = newGameMap size
-                                  }
+newGame size gameSettings = Game { gamePlayers  = Map.empty
+                                 , gameState    = GameInit
+                                 , gameSettings = gameSettings
+                                 , gameMap      = newGameMap size
+                                 }
 
 newPlayer :: Int -> Point -> Velocity -> Int -> Player
 newPlayer pId pos velocity boost =
   Player pId PlayerAlive pos velocity [pos] (PlayerBoost False boost) 0 0
 
 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
        , gameMap     = gameMap { gameMapBlockedPoints =
-                                   Set.insert playerPosition gameMapBlockedPoints }}
+                                   Set.insert playerPosition gameMapBlockedPoints } }

src/Hastron/Utils.hs

@@ -1,11 +0,0 @@
-module Hastron.Utils where
-
-nextEnum :: (Enum a, Bounded a) => a -> a
-nextEnum = turnEnum 1
-
-prevEnum :: (Enum a, Bounded a) => a -> a
-prevEnum = turnEnum (-1)
-
-turnEnum :: (Enum a, Bounded a) => Int -> a -> a
-turnEnum n e = toEnum $ mod (sum [fromEnum e, n]) enumLength
-  where enumLength = succ (fromEnum (maxBound `asTypeOf` e))

src/Main.hs

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

tests/Hastron/Game/TestPlayer.hs

@@ -1,63 +0,0 @@
-module Hastron.Game.TestPlayer where
-
-import qualified Test.QuickCheck.Arbitrary as Arbit
-import qualified Test.Tasty                as Test
-import qualified Test.Tasty.QuickCheck     as QC
-
-import qualified Hastron.Game.Player       as Player
-import qualified Hastron.Game.Types        as Types
-import qualified Hastron.Utils             as Utils
-
-properties :: Test.TestTree
-properties = Test.testGroup "Player Properties"
-  [ QC.testProperty "Turn player right" prop_turn_player_right
-  , QC.testProperty "Turn player left" prop_turn_player_left
-  ]
-
--- | Arbitrary instance declarations
-instance Arbit.Arbitrary Types.Direction where
-  arbitrary = Arbit.arbitraryBoundedEnum
-
-instance Arbit.Arbitrary Types.Velocity where
-  arbitrary = do
-    vel <- Arbit.arbitrary
-    dir <- Arbit.arbitrary
-    return $ Types.Velocity vel dir
-
-instance Arbit.Arbitrary Types.PlayerState where
-  arbitrary = Arbit.arbitraryBoundedEnum
-
-instance Arbit.Arbitrary Types.PlayerBoost where
-  arbitrary = do
-    active <- Arbit.arbitrary
-    fuel <- Arbit.arbitrary
-    return Types.PlayerBoost { Types.boostActive = active, Types.boostFuel = fuel }
-
-instance Arbit.Arbitrary Types.Player where
-  arbitrary = do
-    id <- Arbit.arbitrary
-    state <- Arbit.arbitrary
-    position <- Arbit.arbitrary
-    velocity <- Arbit.arbitrary
-    trail <- Arbit.arbitrary
-    boost <- Arbit.arbitrary
-    score <- Arbit.arbitrary
-    return Types.Player { Types.playerId = id
-                        , Types.playerState = state
-                        , Types.playerPosition = position
-                        , Types.playerVelocity = velocity
-                        , Types.playerTrail = trail
-                        , Types.playerBoost = boost
-                        , Types.playerScore = score
-                        }
-
-
-instance Arbit.Arbitrary Types.PlayerEndState where
-  arbitrary = Arbit.arbitraryBoundedEnum
-
--- | Properties 
-prop_turn_player_right :: Types.Player -> Bool
-prop_turn_player_right player = (Player.direction . Player.turnRight) player == (Utils.nextEnum . Player.direction) player
-
-prop_turn_player_left :: Types.Player -> Bool
-prop_turn_player_left player = (Player.direction . Player.turnLeft) player == (Utils.prevEnum . Player.direction) player

tests/Hastron/TestUtils.hs

@@ -1,24 +0,0 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
-module Hastron.TestUtils (properties) where
-
-import qualified Test.QuickCheck.Arbitrary as Arbit
-import qualified Test.Tasty                as Test
-import qualified Test.Tasty.QuickCheck     as QC
-
-import qualified Hastron.Utils             as Utils
-
-newtype Enum' a = Enum' a
-  deriving (Eq, Bounded, Enum, Show)
-
-instance (Enum a, Bounded a) => Arbit.Arbitrary (Enum' a) where
-  arbitrary = Arbit.arbitraryBoundedEnum
-
-properties :: Test.TestTree
-properties = Test.testGroup "Utils Properties"
-  [ QC.testProperty "Additive inverse for turning" $
-      \n e -> prop_additive_turning_inverse (n :: Int) (e :: Enum' Char)
-  ]
-
-prop_additive_turning_inverse :: (Eq a, Show a, Enum a, Bounded a) => Int -> Enum' a -> Bool
-prop_additive_turning_inverse n (Enum' e) = e == ((Utils.turnEnum n) . (Utils.turnEnum (-n))) e

tests/TestMain.hs

@@ -1,23 +0,0 @@
-module Main where
-
-import qualified Test.Tasty              as Tasty
-
-import qualified Hastron.Game.TestPlayer as Player
-import qualified Hastron.TestUtils       as Utils
-
-main :: IO ()
-main = Tasty.defaultMain tests
-
-tests :: Tasty.TestTree
-tests = Tasty.testGroup "Tests" [properties, unitTests]
-
-unitTests :: Tasty.TestTree
-unitTests = Tasty.testGroup "Unit Tests" [hUnitTests]
-
-properties :: Tasty.TestTree
-properties = Tasty.testGroup "Quickcheck properties" [ Utils.properties
-                                                     , Player.properties
-                                                     ]
-
-hUnitTests :: Tasty.TestTree
-hUnitTests = Tasty.testGroup "HUnit unit tests" []