summaryrefslogtreecommitdiffstats
path: root/src/Simulation.hs
blob: 2d5a0fa8be60b95974e32be3b3215721aa893fe7 (plain)
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)