From f3d9814ad5e7efe7aa883b1c58b854a574c0cf61 Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Tue, 9 Mar 2010 19:53:59 +0100 Subject: Moved parts of Main to Simulation module --- htanks.cabal | 2 +- src/HTanks.hs | 136 ++---------------------------------------------------- src/MainLoop.hs | 31 +++++++++++++ src/Simulation.hs | 124 +++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 160 insertions(+), 133 deletions(-) create mode 100644 src/MainLoop.hs create mode 100644 src/Simulation.hs 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 -- cgit v1.2.3