141 lines
6.2 KiB
Haskell
141 lines
6.2 KiB
Haskell
module Simulation ( simulationStep
|
|
) where
|
|
|
|
import Collision
|
|
import Game
|
|
import Level
|
|
import MainLoop
|
|
import Player
|
|
import Tank
|
|
import Transformable
|
|
import Vector
|
|
|
|
import Control.Monad.State
|
|
import Data.List
|
|
import Data.Maybe
|
|
import Data.VectorSpace
|
|
|
|
|
|
updateAngle :: Rotation -> Tank -> Tank
|
|
updateAngle dir tank = tank { tankDir = fromAngle newangle }
|
|
where
|
|
oldangle = toAngle . tankDir $ tank
|
|
angle = toAngle dir
|
|
tspeed = (tankTurnspeed tank)/100
|
|
|
|
diff = angle - oldangle
|
|
diff360 = if (diff > pi)
|
|
then (diff-2*pi)
|
|
else if (diff <= -pi)
|
|
then (diff+2*pi)
|
|
else diff
|
|
|
|
(diff180, angle180) = if (diff360 > pi/2)
|
|
then (diff360-180, oldangle+pi)
|
|
else if (diff360 <= -pi/2)
|
|
then (diff360+pi, oldangle-pi)
|
|
else (diff360, oldangle)
|
|
|
|
turn = if (diff180 > tspeed)
|
|
then tspeed
|
|
else if (diff180 < -tspeed)
|
|
then (-tspeed)
|
|
else diff180
|
|
|
|
newangle = angle180 + turn
|
|
|
|
approx :: Rotation -> Rotation -> Bool
|
|
approx r1 r2 = c1 `approx'` c2 && s1 `approx'` s2
|
|
where
|
|
approx' a b = (abs (a-b)) < 0.000001
|
|
Vector c1 s1 = toVector r1
|
|
Vector c2 s2 = toVector r2
|
|
|
|
updateTank :: GameState -> Maybe Rotation -> Bool -> Maybe Rotation -> State Tank ()
|
|
updateTank game dir move aim = do
|
|
when (isJust dir) $
|
|
modify $ updateAngle $ fromJust dir
|
|
|
|
when (isJust aim) $
|
|
modify $ \tank -> tank {tankAim = fromJust aim}
|
|
|
|
when move $ do
|
|
tank <- get
|
|
let tdir = tankDir tank
|
|
tspeed = tankSpeed tank
|
|
moved = tankMoving tank
|
|
|
|
when (isNothing dir || (isJust dir && (tdir `approx` fromJust dir) || moved)) $
|
|
put $ ((toVector tdir) ^* (tspeed/100)) >< tank {tankMoving = True}
|
|
|
|
when (not move) $ do
|
|
modify $ \tank -> tank {tankMoving = False}
|
|
|
|
let lw = fromIntegral . levelWidth . level $ game
|
|
lh = fromIntegral . levelHeight . level $ game
|
|
modify $ collisionTankBorder lw lh
|
|
|
|
|
|
updateBullet :: GameState -> Bullet -> (Bullet, Bool)
|
|
updateBullet game bullet = (bullet {bulletPos = Vertex x' y', bulletDir = fromVector $ Vector dx' dy', bulletBouncesLeft = bounces3}, bounces3 >= 0)
|
|
where
|
|
speed = bulletSpeed bullet
|
|
d@(Vector dx dy) = toVector $ bulletDir bullet
|
|
Vertex x y = (d ^* (speed/100)) >< bulletPos bullet
|
|
bounces = bulletBouncesLeft bullet
|
|
lw = fromIntegral . levelWidth . level $ game
|
|
lh = fromIntegral . levelHeight . level $ game
|
|
|
|
(x', dx', bounces2) = if x < 0 then (-x, -dx, bounces-1) else if x > lw then (2*lw-x, -dx, bounces-1) else (x, dx, bounces)
|
|
(y', dy', bounces3) = if y < 0 then (-y, -dy, bounces2-1) else if y > lh then (2*lh-y, -dy, bounces2-1) else (y, dy, bounces2)
|
|
|
|
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
|
|
{ bulletPos = tankPos tank
|
|
, bulletDir = tankAim tank
|
|
, bulletSpeed = tankBulletSpeed tank
|
|
, bulletBouncesLeft = tankBulletBounces tank
|
|
, bulletTank = n
|
|
}) shootingtanks
|
|
|
|
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
|
|
|
|
collideBullets [] = []
|
|
collideBullets ((left, bullet, bullet'):bs) = let (c, ls) = collideBullet bullet bullet' bs
|
|
in (left && not c, bullet'):(collideBullets ls)
|
|
collideBullet bullet bullet' bs = let cs = map (\(left, b, b') -> (left, collisionBulletBullet (bullet, bullet') (b, b'), b, b')) bs
|
|
collided = any (\(_,c,_,_) -> c) cs
|
|
left = map (\(left, c, b, b') -> (left && not c, b, b')) $ cs
|
|
in (collided, left)
|
|
|
|
hitBullets :: [(Bullet, Bullet, Tank, Tank)] -> [(Bool, Bullet, Tank)]
|
|
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, dir, move, aim, shoot) <- playerUpdate player tank
|
|
let t = execState (updateTank game dir move aim) tank
|
|
return $ if (tankLife tank > 0) then (p, t, shoot) else (player, tank, False)
|