Removed IO from Game monad

src/Game.hs

@@ -29,8 +29,8 @@ data GameState = GameState
     , bullets  :: ![Bullet]
     } deriving (Show)
 
-newtype Game a = Game (StateT GameState IO a)
+newtype Game a = Game (State GameState a)
-    deriving (Monad, MonadIO, MonadState GameState)
+    deriving (Monad, MonadState GameState)
 
-runGame :: GameState -> Game a -> IO (a, GameState)
+runGame :: GameState -> Game a -> (a, GameState)
-runGame st (Game a) = runStateT a st
+runGame st (Game a) = runState a st

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}
+                                          ], textures = M.empty, gameState = gamestate}
-             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
+         runMain mainstate $ do
-                                                              ], bullets = []}
-         
-         runGame gameState $ runMain mainState $ do
                             setup
                             mainLoop
          

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
+               { run       :: !Bool
-               , driver   :: !SomeDriver
+               , driver    :: !SomeDriver
-               , time     :: !UTCTime
+               , time      :: !UTCTime
-               , players  :: ![SomePlayer]
+               , players   :: ![SomePlayer]
-               , textures :: !(M.Map Texture TextureObject)
+               , textures  :: !(M.Map Texture TextureObject)
+               , gameState :: !GameState
                }
 
-newtype MainT m a = MainT (StateT MainState m a)
+newtype Main a = Main (StateT MainState IO a)
-    deriving (Monad, MonadState MainState, MonadIO, MonadTrans)
+    deriving (Monad, MonadState MainState, MonadIO)
 
-type Main = MainT Game
+runMain :: MainState -> Main a -> IO (a, MainState)
-
+runMain st (Main a) = runStateT a st
-runMain :: MainState -> Main a -> Game (a, MainState)
-runMain st (MainT a) = runStateT a st

src/Render.hs

@@ -74,8 +74,8 @@ setup = do
 
 render :: Main ()
 render = do
-  tanklist <- lift $ gets tanks
+  tanklist <- gets $ tanks . gameState
-  bulletlist <- lift $ gets bullets
+  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]

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}
+  modify $ \state ->
-  lift $ modify $ \state ->
+      let thebullets = map (runState $ updateBullet . gameState $ state) $ bullets $ gameState state
-      let thebullets = map (runState $ updateBullet state) $ bullets state
+          leftbullets = collideBullets $ zipWith (\(left, bullet') bullet -> (left, bullet, bullet')) thebullets $ bullets $ gameState 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 $ gameState state) leftbullets) (zip (tanks $ gameState state) newtanks)
-          bt = hitBullets $ liftM2 (\(b, (_, b')) (t, t') -> (b, b', t, t')) (zip (bullets state) leftbullets) (zip (tanks 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 [] = []