Moved parts of Main to Simulation module

4 files changed, 160 insertions, 133 deletions

diff --git a/htanks.cabal b/htanks.cabal
index 0a705e9..053eec7 100644
--- a/htanks.cabal
+++ b/htanks.cabal
@@ -14,6 +14,6 @@ data-files:          tex/*.png
 executable:          HTanks
 hs-source-dirs:      src
 main-is:             HTanks.hs
-other-modules:       CPUPlayer, DefaultPlayer, Game, GLDriver, GLX, Level, Paths_htanks, Player, Render, Texture, Bindings.GLX, Bindings.GLPng
+other-modules:       CPUPlayer, DefaultPlayer, Game, GLDriver, GLX, Level, MainLoop, Paths_htanks, Player, Render, Simulation, Texture, Bindings.GLX, Bindings.GLPng
 ghc-options:         -threaded
 extra-libraries:     glpng
diff --git a/src/HTanks.hs b/src/HTanks.hs
index 88ac4e4..03388db 100644
--- a/src/HTanks.hs
+++ b/src/HTanks.hs
@@ -1,39 +1,23 @@
-{-# LANGUAGE PatternGuards, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE PatternGuards #-}
 
 import Game
 import Level
+import MainLoop
 import Render
 import Player
 import CPUPlayer
 import DefaultPlayer
+import Simulation
 
 import GLDriver
 import GLX
 
 import Control.Concurrent (threadDelay)
 import Control.Monad.State
-import Data.Fixed
 import Data.Maybe
 import qualified Data.Map as M
-import Data.Ratio
 import qualified Data.Set as S
-import Data.Time.Clock
-
-
-data MainState = MainState
-               { run      :: !Bool
-               , driver   :: !SomeDriver
-               , time     :: !UTCTime
-               , players  :: ![SomePlayer]
-               }
-
-newtype MainT m a = MainT (StateT MainState m a)
-    deriving (Monad, MonadState MainState, MonadIO, MonadTrans)
-
-type Main = MainT Game
-
-runMain :: MainState -> Main a -> Game (a, MainState)
-runMain st (MainT a) = runStateT a st
+import Data.Time
 
 
 main :: IO ()
@@ -88,118 +72,6 @@ mainLoop = do
   when runnext mainLoop
 
 
-updateAngle :: Micro -> State Tank ()
-updateAngle angle = do
-  oldangle <- gets tankDir
-  tspeed <- gets tankTurnspeed >>= return . (/1000)
-  
-  let diff = angle - oldangle
-  let diff360 = if (diff > 180)
-                then (diff-360)
-                else if (diff <= -180)
-                     then (diff+360)
-                     else diff
-  
-  let (diff180, angle180) = if (diff360 > 90)
-                            then (diff360-180, oldangle+180)
-                            else if (diff360 <= -90)
-                                 then (diff360+180, oldangle-180)
-                                 else (diff360, oldangle)
-  
-  let turn = if (diff180 > tspeed)
-             then tspeed
-             else if (diff180 < -tspeed)
-                  then (-tspeed)
-                  else diff180
-  
-  let newangle = angle180 + turn
-  
-  let newangle180 = if (newangle > 180)
-                    then (newangle-360)
-                    else if (newangle <= -180)
-                         then (newangle+360)
-                         else newangle
-  
-  modify $ \tank -> tank {tankDir = newangle180}
-
-
-updateTank :: Maybe Micro -> Bool -> Maybe Micro -> State Tank ()
-updateTank angle move aangle = do
-  when (isJust angle) $
-       updateAngle $ fromJust angle
-  
-  when (isJust aangle) $
-       modify $ \tank -> tank {tankAim = fromJust aangle}
-  
-  when move $ do
-    tdir <- gets tankDir
-    tspeed <- gets tankSpeed
-    moved <- gets tankMoving
-    
-    when (isNothing angle || (isJust angle && (tdir == fromJust angle)) || moved) $ do
-                   let anglej = (fromRational . toRational $ tdir)*pi/180
-                       x = tspeed * fromRational (round ((cos anglej)*1000)%1000000)
-                       y = tspeed * fromRational (round ((sin anglej)*1000)%1000000)
-                   
-                   modify $ \tank -> tank {tankX = x + tankX tank, tankY = y + tankY tank, tankMoving = True}
-  
-  when (not move) $ do
-                   modify $ \tank -> tank {tankMoving = False}
-
-
-updateBullet :: GameState -> State Bullet Bool
-updateBullet game = do
-  bullet <- get
-  let angle = (fromRational . toRational . bulletDir $ bullet)*pi/180
-      speed = bulletSpeed bullet
-      dx = speed * fromRational (round ((cos angle)*1000)%1000000)
-      dy = speed * fromRational (round ((sin angle)*1000)%1000000)
-      x = dx + bulletX bullet
-      y = dy + bulletY bullet
-      lw = fromIntegral . levelWidth . level $ game
-      lh = fromIntegral . levelHeight . level $ game
-      dir = bulletDir bullet
-      bounces = bulletBouncesLeft bullet
-      
-      (newx, dir2, bounces2) = if x < 0 then (-x, (signum dir)*180 - dir, bounces-1) else if x > lw then (2*lw-x, (signum dir)*180 - dir, bounces-1) else (x, dir, bounces)
-      (newy, dir3, bounces3) = if y < 0 then (-y, -dir2, bounces2-1) else if y > lh then (2*lh-y, -dir2, bounces2-1) else (y, dir2, bounces2)
-  
-  put bullet {bulletX = newx, bulletY = newy, bulletDir = dir3, bulletBouncesLeft = bounces3}
-  
-  return (bounces3 >= 0)
-
-
-simulationStep :: Main ()
-simulationStep = do
-  oldplayers <- gets players
-  oldtanks <- lift $ gets tanks
-  
-  let (p, t, s) = unzip3 $ map updateTank' $ zip oldplayers oldtanks
-      ts = zip3 t s [0..]
-      shootingtanks = map (\(tank, _, n) -> (tank, n)) $ filter (\(tank, shoot, _) -> shoot && (tankBulletsLeft tank) > 0) $ ts
-      newtanks = map (\(tank, shoot, _) -> if (shoot && (tankBulletsLeft tank) > 0) then tank {tankBulletsLeft = (tankBulletsLeft tank) - 1} else tank) $ ts
-      newbullets = map (\(tank, n) -> Bullet
-                                      { bulletX = tankX tank
-                                      , bulletY = tankY tank
-                                      , bulletDir = tankAim tank
-                                      , bulletSpeed = tankBulletSpeed tank
-                                      , bulletBouncesLeft = tankBulletBounces tank
-                                      , bulletTank = n
-                                      }) shootingtanks
-  
-  modify $ \state -> state {players = p}
-  lift $ modify $ \state ->
-      let thebullets = map (runState $ updateBullet state) $ newbullets ++ bullets state
-          thetanks = map (\(tank, n) -> tank {tankBulletsLeft = (tankBulletsLeft tank) + (countLostTankBullets n thebullets)}) $ zip newtanks [0..]
-      in state {tanks = thetanks, bullets = map snd . filter fst $ thebullets}
-    where
-      updateTank' (player, tank) = let (p, angle, move, aangle, bullet) = playerUpdate player tank
-                                       t = execState (updateTank angle move aangle) tank
-                                   in (p, t, bullet)
-      countLostTankBullets n (x:xs) = (if ((not . fst $ x) && (n == (bulletTank . snd $ x))) then 1 else 0) + (countLostTankBullets n xs)
-      countLostTankBullets n []     = 0
-      
-
 handleEvents :: Main ()
 handleEvents = do
   (newgl, event) <- gets driver >>= liftIO . nextEvent
diff --git a/src/MainLoop.hs b/src/MainLoop.hs
new file mode 100644
index 0000000..94b5e9d
--- /dev/null
+++ b/src/MainLoop.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module MainLoop ( MainState(..)
+                , MainT(..)
+                , Main
+                , runMain
+                ) where
+
+import Game
+import GLDriver
+import Player
+
+import Control.Monad.State
+import Control.Monad.Trans
+import Data.Time
+
+
+data MainState = MainState
+               { run      :: !Bool
+               , driver   :: !SomeDriver
+               , time     :: !UTCTime
+               , players  :: ![SomePlayer]
+               }
+
+newtype MainT m a = MainT (StateT MainState m a)
+    deriving (Monad, MonadState MainState, MonadIO, MonadTrans)
+
+type Main = MainT Game
+
+runMain :: MainState -> Main a -> Game (a, MainState)
+runMain st (MainT a) = runStateT a st
diff --git a/src/Simulation.hs b/src/Simulation.hs
new file mode 100644
index 0000000..f45ab99
--- /dev/null
+++ b/src/Simulation.hs
@@ -0,0 +1,124 @@
+module Simulation ( simulationStep
+                  ) where
+
+import Game
+import Level
+import MainLoop
+import Player
+
+import Control.Monad.State
+import Data.Fixed
+import Data.Maybe
+import Data.Ratio
+
+
+updateAngle :: Micro -> State Tank ()
+updateAngle angle = do
+  oldangle <- gets tankDir
+  tspeed <- gets tankTurnspeed >>= return . (/1000)
+  
+  let diff = angle - oldangle
+  let diff360 = if (diff > 180)
+                then (diff-360)
+                else if (diff <= -180)
+                     then (diff+360)
+                     else diff
+  
+  let (diff180, angle180) = if (diff360 > 90)
+                            then (diff360-180, oldangle+180)
+                            else if (diff360 <= -90)
+                                 then (diff360+180, oldangle-180)
+                                 else (diff360, oldangle)
+  
+  let turn = if (diff180 > tspeed)
+             then tspeed
+             else if (diff180 < -tspeed)
+                  then (-tspeed)
+                  else diff180
+  
+  let newangle = angle180 + turn
+  
+  let newangle180 = if (newangle > 180)
+                    then (newangle-360)
+                    else if (newangle <= -180)
+                         then (newangle+360)
+                         else newangle
+  
+  modify $ \tank -> tank {tankDir = newangle180}
+
+
+updateTank :: Maybe Micro -> Bool -> Maybe Micro -> State Tank ()
+updateTank angle move aangle = do
+  when (isJust angle) $
+       updateAngle $ fromJust angle
+  
+  when (isJust aangle) $
+       modify $ \tank -> tank {tankAim = fromJust aangle}
+  
+  when move $ do
+    tdir <- gets tankDir
+    tspeed <- gets tankSpeed
+    moved <- gets tankMoving
+    
+    when (isNothing angle || (isJust angle && (tdir == fromJust angle)) || moved) $ do
+                   let anglej = (fromRational . toRational $ tdir)*pi/180
+                       x = tspeed * fromRational (round ((cos anglej)*1000)%1000000)
+                       y = tspeed * fromRational (round ((sin anglej)*1000)%1000000)
+                   
+                   modify $ \tank -> tank {tankX = x + tankX tank, tankY = y + tankY tank, tankMoving = True}
+  
+  when (not move) $ do
+                   modify $ \tank -> tank {tankMoving = False}
+
+
+updateBullet :: GameState -> State Bullet Bool
+updateBullet game = do
+  bullet <- get
+  let angle = (fromRational . toRational . bulletDir $ bullet)*pi/180
+      speed = bulletSpeed bullet
+      dx = speed * fromRational (round ((cos angle)*1000)%1000000)
+      dy = speed * fromRational (round ((sin angle)*1000)%1000000)
+      x = dx + bulletX bullet
+      y = dy + bulletY bullet
+      lw = fromIntegral . levelWidth . level $ game
+      lh = fromIntegral . levelHeight . level $ game
+      dir = bulletDir bullet
+      bounces = bulletBouncesLeft bullet
+      
+      (newx, dir2, bounces2) = if x < 0 then (-x, (signum dir)*180 - dir, bounces-1) else if x > lw then (2*lw-x, (signum dir)*180 - dir, bounces-1) else (x, dir, bounces)
+      (newy, dir3, bounces3) = if y < 0 then (-y, -dir2, bounces2-1) else if y > lh then (2*lh-y, -dir2, bounces2-1) else (y, dir2, bounces2)
+  
+  put bullet {bulletX = newx, bulletY = newy, bulletDir = dir3, bulletBouncesLeft = bounces3}
+  
+  return (bounces3 >= 0)
+
+
+simulationStep :: Main ()
+simulationStep = do
+  oldplayers <- gets players
+  oldtanks <- lift $ gets tanks
+  
+  let (p, t, s) = unzip3 $ map updateTank' $ zip oldplayers oldtanks
+      ts = zip3 t s [0..]
+      shootingtanks = map (\(tank, _, n) -> (tank, n)) $ filter (\(tank, shoot, _) -> shoot && (tankBulletsLeft tank) > 0) $ ts
+      newtanks = map (\(tank, shoot, _) -> if (shoot && (tankBulletsLeft tank) > 0) then tank {tankBulletsLeft = (tankBulletsLeft tank) - 1} else tank) $ ts
+      newbullets = map (\(tank, n) -> Bullet
+                                      { bulletX = tankX tank
+                                      , bulletY = tankY tank
+                                      , bulletDir = tankAim tank
+                                      , bulletSpeed = tankBulletSpeed tank
+                                      , bulletBouncesLeft = tankBulletBounces tank
+                                      , bulletTank = n
+                                      }) shootingtanks
+  
+  modify $ \state -> state {players = p}
+  lift $ modify $ \state ->
+      let thebullets = map (runState $ updateBullet state) $ newbullets ++ bullets state
+          thetanks = map (\(tank, n) -> tank {tankBulletsLeft = (tankBulletsLeft tank) + (countLostTankBullets n thebullets)}) $ zip newtanks [0..]
+      in state {tanks = thetanks, bullets = map snd . filter fst $ thebullets}
+    where
+      updateTank' (player, tank) = let (p, angle, move, aangle, bullet) = playerUpdate player tank
+                                       t = execState (updateTank angle move aangle) tank
+                                   in (p, t, bullet)
+      countLostTankBullets n (x:xs) = (if ((not . fst $ x) && (n == (bulletTank . snd $ x))) then 1 else 0) + (countLostTankBullets n xs)
+      countLostTankBullets n []     = 0