Restructured Simulation module
This commit is contained in:
parent
b694c7705e
commit
4ecea2f9dc
2 changed files with 42 additions and 54 deletions
|
@ -2,8 +2,6 @@
|
|||
|
||||
module Game ( Bullet(..)
|
||||
, GameState(..)
|
||||
, Game
|
||||
, runGame
|
||||
) where
|
||||
|
||||
import Level
|
||||
|
@ -28,9 +26,3 @@ data GameState = GameState
|
|||
, tanks :: ![Tank]
|
||||
, bullets :: ![Bullet]
|
||||
} deriving (Show)
|
||||
|
||||
newtype Game a = Game (State GameState a)
|
||||
deriving (Monad, MonadState GameState)
|
||||
|
||||
runGame :: GameState -> Game a -> (a, GameState)
|
||||
runGame st (Game a) = runState a st
|
||||
|
|
|
@ -15,45 +15,44 @@ import Data.Maybe
|
|||
import Data.Ratio
|
||||
|
||||
|
||||
updateAngle :: Micro -> State Tank ()
|
||||
updateAngle angle = do
|
||||
oldangle <- gets tankDir
|
||||
tspeed <- liftM (/100) $ gets tankTurnspeed
|
||||
updateAngle :: Micro -> Tank -> Tank
|
||||
updateAngle angle tank = tank {tankDir = newangle180}
|
||||
where
|
||||
oldangle = tankDir tank
|
||||
tspeed = (tankTurnspeed tank)/100
|
||||
|
||||
let diff = angle - oldangle
|
||||
let diff360 = if (diff > 180)
|
||||
diff = angle - oldangle
|
||||
diff360 = if (diff > 180)
|
||||
then (diff-360)
|
||||
else if (diff <= -180)
|
||||
then (diff+360)
|
||||
else diff
|
||||
|
||||
let (diff180, angle180) = if (diff360 > 90)
|
||||
(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)
|
||||
turn = if (diff180 > tspeed)
|
||||
then tspeed
|
||||
else if (diff180 < -tspeed)
|
||||
then (-tspeed)
|
||||
else diff180
|
||||
|
||||
let newangle = angle180 + turn
|
||||
newangle = angle180 + turn
|
||||
|
||||
let newangle180 = if (newangle > 180)
|
||||
newangle180 = if (newangle > 180)
|
||||
then (newangle-360)
|
||||
else if (newangle <= -180)
|
||||
then (newangle+360)
|
||||
else newangle
|
||||
|
||||
modify $ \tank -> tank {tankDir = newangle180}
|
||||
|
||||
|
||||
updateTank :: GameState -> Maybe Micro -> Bool -> Maybe Micro -> State Tank ()
|
||||
updateTank game angle move aangle = do
|
||||
when (isJust angle) $
|
||||
updateAngle $ fromJust angle
|
||||
modify $ updateAngle $ fromJust angle
|
||||
|
||||
when (isJust aangle) $
|
||||
modify $ \tank -> tank {tankAim = fromJust aangle}
|
||||
|
@ -79,10 +78,10 @@ updateTank game angle move aangle = do
|
|||
modify $ collisionTankBorder lw lh
|
||||
|
||||
|
||||
updateBullet :: GameState -> State Bullet Bool
|
||||
updateBullet game = do
|
||||
bullet <- get
|
||||
let angle = (fromRational . toRational . bulletDir $ bullet)*pi/180
|
||||
updateBullet :: GameState -> Bullet -> (Bullet, Bool)
|
||||
updateBullet game bullet = (bullet {bulletX = newx, bulletY = newy, bulletDir = dir3, bulletBouncesLeft = bounces3}, bounces3 >= 0)
|
||||
where
|
||||
angle = (fromRational . toRational . bulletDir $ bullet)*pi/180
|
||||
speed = bulletSpeed bullet
|
||||
dx = speed * fromRational (round ((cos angle)*1000)%100000)
|
||||
dy = speed * fromRational (round ((sin angle)*1000)%100000)
|
||||
|
@ -97,20 +96,12 @@ updateBullet game = do
|
|||
(newx, dir2, bounces2) = if x < 0 then (-x, sg*180 - dir, bounces-1) else if x > lw then (2*lw-x, sg*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
|
||||
game <- gets gameState
|
||||
let oldtanks = tanks game
|
||||
|
||||
(p, t, s) <- liftIO $ liftM unzip3 $ mapM (updateTank' game) $ zip oldplayers oldtanks
|
||||
let ts = zip3 t s [0..]
|
||||
gameStep :: [(Tank, Bool)] -> GameState -> GameState
|
||||
gameStep tanksshoot state = state {tanks = thetanks, bullets = newbullets ++ (map snd . filter fst $ leftbullets2)}
|
||||
where
|
||||
ts = zipWith (\(t, s) n -> (t, s, n)) tanksshoot [0..]
|
||||
shootingtanks = map (\(tank, _, n) -> (tank, n)) $ filter (\(tank, shoot, _) -> shoot && (tankBulletsLeft tank) > 0) $ ts
|
||||
thetanks = map (\(tank, n) -> tank {tankBulletsLeft = (tankBulletsLeft tank) + (countLostTankBullets n leftbullets2)}) $ zip newtanks2 [0..]
|
||||
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
|
||||
|
@ -121,18 +112,12 @@ simulationStep = do
|
|||
, bulletTank = n
|
||||
}) shootingtanks
|
||||
|
||||
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)
|
||||
thebullets = map (updateBullet state) $ bullets state
|
||||
leftbullets = collideBullets $ zipWith (\(bullet', left) 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)
|
||||
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 {players = p, gameState = (gameState state) {tanks = thetanks, bullets = newbullets ++ (map snd . filter fst $ leftbullets2)}}
|
||||
|
||||
where
|
||||
collideBullets [] = []
|
||||
collideBullets ((left, bullet, bullet'):bs) = let (c, ls) = collideBullet bullet bullet' bs
|
||||
in (left && not c, bullet'):(collideBullets ls)
|
||||
|
@ -145,9 +130,20 @@ simulationStep = do
|
|||
hitBullets [] = []
|
||||
hitBullets ((b, b', t, t'):xs) = (collisionBulletTank (b, b') (t, t'), b', t'):(hitBullets xs)
|
||||
|
||||
countLostTankBullets n (x:xs) = (if ((not . fst $ x) && (n == (bulletTank . snd $ x))) then 1 else 0) + (countLostTankBullets n xs)
|
||||
countLostTankBullets n [] = 0
|
||||
|
||||
simulationStep :: Main ()
|
||||
simulationStep = do
|
||||
oldplayers <- gets players
|
||||
game <- gets gameState
|
||||
let oldtanks = tanks game
|
||||
|
||||
(p, t, s) <- liftIO $ liftM unzip3 $ mapM (updateTank' game) $ zip oldplayers oldtanks
|
||||
|
||||
modify $ \state -> state {players = p, gameState = gameStep (zip t s) (gameState state)}
|
||||
where
|
||||
updateTank' game (player, tank) = do
|
||||
(p, angle, move, aangle, shoot) <- playerUpdate player tank
|
||||
let t = execState (updateTank game angle move aangle) tank
|
||||
return $ if (tankLife tank > 0) then (p, t, shoot) else (player, tank, False)
|
||||
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