diff options
Diffstat (limited to 'src/HTanks.hs')
| -rw-r--r-- | src/HTanks.hs | 136 |
1 files changed, 4 insertions, 132 deletions
diff --git a/src/HTanks.hs b/src/HTanks.hs index 88ac4e4..03388db 100644 --- a/src/HTanks.hs +++ b/src/HTanks.hs @@ -1,39 +1,23 @@ -{-# LANGUAGE PatternGuards, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE PatternGuards #-} import Game import Level +import MainLoop import Render import Player import CPUPlayer import DefaultPlayer +import Simulation import GLDriver import GLX import Control.Concurrent (threadDelay) import Control.Monad.State -import Data.Fixed import Data.Maybe import qualified Data.Map as M -import Data.Ratio import qualified Data.Set as S -import Data.Time.Clock - - -data MainState = MainState - { run :: !Bool - , driver :: !SomeDriver - , time :: !UTCTime - , players :: ![SomePlayer] - } - -newtype MainT m a = MainT (StateT MainState m a) - deriving (Monad, MonadState MainState, MonadIO, MonadTrans) - -type Main = MainT Game - -runMain :: MainState -> Main a -> Game (a, MainState) -runMain st (MainT a) = runStateT a st +import Data.Time main :: IO () @@ -88,118 +72,6 @@ mainLoop = do when runnext mainLoop -updateAngle :: Micro -> State Tank () -updateAngle angle = do - oldangle <- gets tankDir - tspeed <- gets tankTurnspeed >>= return . (/1000) - - let diff = angle - oldangle - let diff360 = if (diff > 180) - then (diff-360) - else if (diff <= -180) - then (diff+360) - else diff - - let (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) - then tspeed - else if (diff180 < -tspeed) - then (-tspeed) - else diff180 - - let newangle = angle180 + turn - - let newangle180 = if (newangle > 180) - then (newangle-360) - else if (newangle <= -180) - then (newangle+360) - else newangle - - modify $ \tank -> tank {tankDir = newangle180} - - -updateTank :: Maybe Micro -> Bool -> Maybe Micro -> State Tank () -updateTank angle move aangle = do - when (isJust angle) $ - updateAngle $ fromJust angle - - when (isJust aangle) $ - modify $ \tank -> tank {tankAim = fromJust aangle} - - when move $ do - tdir <- gets tankDir - tspeed <- gets tankSpeed - moved <- gets tankMoving - - when (isNothing angle || (isJust angle && (tdir == fromJust angle)) || moved) $ do - let anglej = (fromRational . toRational $ tdir)*pi/180 - x = tspeed * fromRational (round ((cos anglej)*1000)%1000000) - y = tspeed * fromRational (round ((sin anglej)*1000)%1000000) - - modify $ \tank -> tank {tankX = x + tankX tank, tankY = y + tankY tank, tankMoving = True} - - when (not move) $ do - modify $ \tank -> tank {tankMoving = False} - - -updateBullet :: GameState -> State Bullet Bool -updateBullet game = do - bullet <- get - let angle = (fromRational . toRational . bulletDir $ bullet)*pi/180 - speed = bulletSpeed bullet - dx = speed * fromRational (round ((cos angle)*1000)%1000000) - dy = speed * fromRational (round ((sin angle)*1000)%1000000) - x = dx + bulletX bullet - y = dy + bulletY bullet - lw = fromIntegral . levelWidth . level $ game - lh = fromIntegral . levelHeight . level $ game - dir = bulletDir bullet - bounces = bulletBouncesLeft bullet - - (newx, dir2, bounces2) = if x < 0 then (-x, (signum dir)*180 - dir, bounces-1) else if x > lw then (2*lw-x, (signum dir)*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 - oldtanks <- lift $ gets tanks - - let (p, t, s) = unzip3 $ map updateTank' $ zip oldplayers oldtanks - ts = zip3 t s [0..] - shootingtanks = map (\(tank, _, n) -> (tank, n)) $ filter (\(tank, shoot, _) -> shoot && (tankBulletsLeft tank) > 0) $ ts - 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 - - modify $ \state -> state {players = p} - lift $ modify $ \state -> - let thebullets = map (runState $ updateBullet state) $ newbullets ++ bullets state - thetanks = map (\(tank, n) -> tank {tankBulletsLeft = (tankBulletsLeft tank) + (countLostTankBullets n thebullets)}) $ zip newtanks [0..] - in state {tanks = thetanks, bullets = map snd . filter fst $ thebullets} - where - updateTank' (player, tank) = let (p, angle, move, aangle, bullet) = playerUpdate player tank - t = execState (updateTank angle move aangle) tank - in (p, t, bullet) - countLostTankBullets n (x:xs) = (if ((not . fst $ x) && (n == (bulletTank . snd $ x))) then 1 else 0) + (countLostTankBullets n xs) - countLostTankBullets n [] = 0 - - handleEvents :: Main () handleEvents = do (newgl, event) <- gets driver >>= liftIO . nextEvent |