This repository has been archived on 2025-03-03. You can view files and clone it, but cannot push or open issues or pull requests.
htanks/src/Simulation.hs
2010-04-11 02:12:48 +02:00

149 lines
6.7 KiB
Haskell

module Simulation ( simulationStep
) where
import Collision
import Game
import Level
import MainLoop
import Player
import Tank
import Control.Monad.State
import Data.Fixed
import Data.List
import Data.Maybe
import Data.Ratio
updateAngle :: Micro -> Tank -> Tank
updateAngle angle tank = tank {tankDir = newangle180}
where
oldangle = tankDir tank
tspeed = (tankTurnspeed tank)/100
diff = angle - oldangle
diff360 = if (diff > 180)
then (diff-360)
else if (diff <= -180)
then (diff+360)
else diff
(diff180, angle180) = if (diff360 > 90)
then (diff360-180, oldangle+180)
else if (diff360 <= -90)
then (diff360+180, oldangle-180)
else (diff360, oldangle)
turn = if (diff180 > tspeed)
then tspeed
else if (diff180 < -tspeed)
then (-tspeed)
else diff180
newangle = angle180 + turn
newangle180 = if (newangle > 180)
then (newangle-360)
else if (newangle <= -180)
then (newangle+360)
else newangle
updateTank :: GameState -> Maybe Micro -> Bool -> Maybe Micro -> State Tank ()
updateTank game angle move aangle = do
when (isJust angle) $
modify $ updateAngle $ fromJust angle
when (isJust aangle) $
modify $ \tank -> tank {tankAim = fromJust aangle}
when move $ do
tank <- get
let tdir = tankDir tank
tspeed = tankSpeed tank
moved = tankMoving tank
when (isNothing angle || (isJust angle && (tdir == fromJust angle)) || moved) $ do
let anglej = (fromRational . toRational $ tdir)*pi/180
dx = tspeed * fromRational (round ((cos anglej)*1000)%100000)
dy = tspeed * fromRational (round ((sin anglej)*1000)%100000)
put tank {tankX = dx + tankX tank, tankY = dy + tankY 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 {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)
x = dx + bulletX bullet
y = dy + bulletY bullet
lw = fromIntegral . levelWidth . level $ game
lh = fromIntegral . levelHeight . level $ game
dir = bulletDir bullet
bounces = bulletBouncesLeft bullet
sg = if dir < 0 then -1 else 1
(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)
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
, bulletY = tankY 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, 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)