Moved parts of Main to Simulation module
This commit is contained in:
Matthias Schiffer
parent
9d34024718
commit
f3d9814ad5
4 changed files with 160 additions and 133 deletions
|
|
@ -14,6 +14,6 @@ data-files: tex/*.png
|
||||||
executable: HTanks
|
executable: HTanks
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
main-is: HTanks.hs
|
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
|
ghc-options: -threaded
|
||||||
extra-libraries: glpng
|
extra-libraries: glpng
|
||||||
|
|
|
||||||
136
src/HTanks.hs
136
src/HTanks.hs
|
|
@ -1,39 +1,23 @@
|
||||||
{-# LANGUAGE PatternGuards, GeneralizedNewtypeDeriving #-}
|
{-# LANGUAGE PatternGuards #-}
|
||||||
|
|
||||||
import Game
|
import Game
|
||||||
import Level
|
import Level
|
||||||
|
import MainLoop
|
||||||
import Render
|
import Render
|
||||||
import Player
|
import Player
|
||||||
import CPUPlayer
|
import CPUPlayer
|
||||||
import DefaultPlayer
|
import DefaultPlayer
|
||||||
|
import Simulation
|
||||||
|
|
||||||
import GLDriver
|
import GLDriver
|
||||||
import GLX
|
import GLX
|
||||||
|
|
||||||
import Control.Concurrent (threadDelay)
|
import Control.Concurrent (threadDelay)
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import Data.Fixed
|
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Ratio
|
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
import Data.Time.Clock
|
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
|
|
||||||
|
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
|
|
@ -88,118 +72,6 @@ mainLoop = do
|
||||||
when runnext mainLoop
|
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 :: Main ()
|
||||||
handleEvents = do
|
handleEvents = do
|
||||||
(newgl, event) <- gets driver >>= liftIO . nextEvent
|
(newgl, event) <- gets driver >>= liftIO . nextEvent
|
||||||
|
|
|
||||||
31
src/MainLoop.hs
Normal file
31
src/MainLoop.hs
Normal file
|
|
@ -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
|
||||||
124
src/Simulation.hs
Normal file
124
src/Simulation.hs
Normal file
|
|
@ -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
|
||||||
Reference in a new issue