diff options
| -rw-r--r-- | src/Game.hs | 8 | ||||
| -rw-r--r-- | src/HTanks.hs | 14 | ||||
| -rw-r--r-- | src/MainLoop.hs | 24 | ||||
| -rw-r--r-- | src/Render.hs | 6 | ||||
| -rw-r--r-- | src/Simulation.hs | 13 |
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 [] = [] |