1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
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 1 r1
Vector c2 s2 = toVector 1 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 (tspeed/100) tdir >< 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 = dir'', bulletBouncesLeft = bounces3}, bounces3 >= 0)
where
rot180 = fromAngle pi
speed = bulletSpeed bullet
dir = bulletDir bullet
Vertex x y = toVector (speed/100) dir >< bulletPos bullet
bounces = bulletBouncesLeft bullet
lw = fromIntegral . levelWidth . level $ game
lh = fromIntegral . levelHeight . level $ game
(x', dir', bounces2) = if x < 0 then (-x, negateV dir, bounces-1) else if x > lw then (2*lw-x, negateV dir, bounces-1) else (x, dir, bounces)
(y', dir'', bounces3) = if y < 0 then (-y, rot180 ^-^ dir', bounces2-1) else if y > lh then (2*lh-y, rot180 ^-^ dir', bounces2-1) else (y, dir', 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)
|