diff options
-rw-r--r-- | src/Game.hs | 8 | ||||
-rw-r--r-- | src/Simulation.hs | 88 |
2 files changed, 42 insertions, 54 deletions
diff --git a/src/Game.hs b/src/Game.hs index 59d67aa..5af2ad2 100644 --- a/src/Game.hs +++ b/src/Game.hs @@ -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 diff --git a/src/Simulation.hs b/src/Simulation.hs index c092ad5..c1debb2 100644 --- a/src/Simulation.hs +++ b/src/Simulation.hs @@ -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 - - let diff = angle - oldangle - let diff360 = if (diff > 180) +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 - 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) @@ -96,21 +95,13 @@ updateBullet game = do 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) - - 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 @@ -120,19 +111,13 @@ simulationStep = do , bulletBouncesLeft = tankBulletBounces tank , 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) - 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 + + 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) @@ -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 |