summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--src/Game.hs8
-rw-r--r--src/HTanks.hs14
-rw-r--r--src/MainLoop.hs24
-rw-r--r--src/Render.hs6
-rw-r--r--src/Simulation.hs13
5 files changed, 31 insertions, 34 deletions
diff --git a/src/Game.hs b/src/Game.hs
index 21fe6cd..59d67aa 100644
--- a/src/Game.hs
+++ b/src/Game.hs
@@ -29,8 +29,8 @@ data GameState = GameState
, bullets :: ![Bullet]
} deriving (Show)
-newtype Game a = Game (StateT GameState IO a)
- deriving (Monad, MonadIO, MonadState GameState)
+newtype Game a = Game (State GameState a)
+ deriving (Monad, MonadState GameState)
-runGame :: GameState -> Game a -> IO (a, GameState)
-runGame st (Game a) = runStateT a st
+runGame :: GameState -> Game a -> (a, GameState)
+runGame st (Game a) = runState a st
diff --git a/src/HTanks.hs b/src/HTanks.hs
index 2fcdb66..5a8bdec 100644
--- a/src/HTanks.hs
+++ b/src/HTanks.hs
@@ -32,16 +32,16 @@ main = do
when (initialized gl) $ do
currentTime <- getCurrentTime
- let mainState = MainState {run = True, driver = SomeDriver gl, time = currentTime, players =
+ let gamestate = GameState {level = theLevel, tanks = [ Tank 5.0 5.0 0 0 1.5 270 False 3 1 5 1
+ , Tank 5.0 3.5 0 0 1.5 270 False 3 1 5 1
+ ], bullets = []}
+ mainstate = MainState {run = True, driver = SomeDriver gl, time = currentTime, players =
[ --SomePlayer $ DefaultPlayer S.empty 0 0 False
SomePlayer $ hwiidPlayer
, SomePlayer $ CPUPlayer 0
- ], textures = M.empty}
- gameState = GameState {level = theLevel, tanks = [ Tank 5.0 5.0 0 0 1.5 270 False 3 1 5 1
- , Tank 5.0 3.5 0 0 1.5 270 False 3 1 5 1
- ], bullets = []}
-
- runGame gameState $ runMain mainState $ do
+ ], textures = M.empty, gameState = gamestate}
+
+ runMain mainstate $ do
setup
mainLoop
diff --git a/src/MainLoop.hs b/src/MainLoop.hs
index 0ebaa53..a484435 100644
--- a/src/MainLoop.hs
+++ b/src/MainLoop.hs
@@ -1,8 +1,7 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module MainLoop ( MainState(..)
- , MainT(..)
- , Main
+ , Main(..)
, runMain
) where
@@ -18,17 +17,16 @@ import qualified Data.Map as M
data MainState = MainState
- { run :: !Bool
- , driver :: !SomeDriver
- , time :: !UTCTime
- , players :: ![SomePlayer]
- , textures :: !(M.Map Texture TextureObject)
+ { run :: !Bool
+ , driver :: !SomeDriver
+ , time :: !UTCTime
+ , players :: ![SomePlayer]
+ , textures :: !(M.Map Texture TextureObject)
+ , gameState :: !GameState
}
-newtype MainT m a = MainT (StateT MainState m a)
- deriving (Monad, MonadState MainState, MonadIO, MonadTrans)
+newtype Main a = Main (StateT MainState IO a)
+ deriving (Monad, MonadState MainState, MonadIO)
-type Main = MainT Game
-
-runMain :: MainState -> Main a -> Game (a, MainState)
-runMain st (MainT a) = runStateT a st
+runMain :: MainState -> Main a -> IO (a, MainState)
+runMain st (Main a) = runStateT a st
diff --git a/src/Render.hs b/src/Render.hs
index ec7ae62..c00a476 100644
--- a/src/Render.hs
+++ b/src/Render.hs
@@ -74,8 +74,8 @@ setup = do
render :: Main ()
render = do
- tanklist <- lift $ gets tanks
- bulletlist <- lift $ gets bullets
+ tanklist <- gets $ tanks . gameState
+ bulletlist <- gets $ bullets . gameState
playerlist <- gets players
textureWood <- getTexture TextureWood
@@ -84,7 +84,7 @@ render = do
textureBullet <- getTexture TextureBullet
textureCrosshair <- getTexture TextureCrosshair
- (lw, lh) <- lift $ gets level >>= \l -> return (fromIntegral . levelWidth $ l :: GLfloat, fromIntegral . levelHeight $ l :: GLfloat)
+ (lw, lh) <- gets (level . gameState) >>= \l -> return (fromIntegral . levelWidth $ l :: GLfloat, fromIntegral . levelHeight $ l :: GLfloat)
liftIO $ do
clear [ColorBuffer]
diff --git a/src/Simulation.hs b/src/Simulation.hs
index 7b2505f..c092ad5 100644
--- a/src/Simulation.hs
+++ b/src/Simulation.hs
@@ -105,7 +105,7 @@ updateBullet game = do
simulationStep :: Main ()
simulationStep = do
oldplayers <- gets players
- game <- lift get
+ game <- gets gameState
let oldtanks = tanks game
(p, t, s) <- liftIO $ liftM unzip3 $ mapM (updateTank' game) $ zip oldplayers oldtanks
@@ -121,17 +121,16 @@ simulationStep = do
, bulletTank = n
}) shootingtanks
- modify $ \state -> state {players = p}
- lift $ modify $ \state ->
- let thebullets = map (runState $ updateBullet state) $ bullets state
- leftbullets = collideBullets $ zipWith (\(left, bullet') bullet -> (left, bullet, bullet')) thebullets $ bullets state
- bt = hitBullets $ liftM2 (\(b, (_, b')) (t, t') -> (b, b', t, t')) (zip (bullets state) leftbullets) (zip (tanks state) newtanks)
+ modify $ \state ->
+ let thebullets = map (runState $ updateBullet . gameState $ state) $ bullets $ gameState state
+ leftbullets = collideBullets $ zipWith (\(left, bullet') bullet -> (left, bullet, bullet')) thebullets $ bullets $ gameState state
+ bt = hitBullets $ liftM2 (\(b, (_, b')) (t, t') -> (b, b', t, t')) (zip (bullets $ gameState state) leftbullets) (zip (tanks $ gameState state) newtanks)
leftbullets2 = map (\(left, bullet) -> (left && (all (\(c, b, _) -> (b /= bullet) || (not c)) bt), bullet)) leftbullets
newtanks2 = map (\tank -> tank {tankLife = (tankLife tank) - (sum . map (\(c, _, t) -> if (t == tank && c) then 1 else 0) $ bt)}) newtanks
thetanks = map (\(tank, n) -> tank {tankBulletsLeft = (tankBulletsLeft tank) + (countLostTankBullets n leftbullets2)}) $ zip newtanks2 [0..]
- in state {tanks = thetanks, bullets = newbullets ++ (map snd . filter fst $ leftbullets2)}
+ in state {players = p, gameState = (gameState state) {tanks = thetanks, bullets = newbullets ++ (map snd . filter fst $ leftbullets2)}}
where
collideBullets [] = []