diff options
author | Matthias Schiffer <matthias@gamezock.de> | 2010-03-09 03:49:15 +0100 |
---|---|---|
committer | Matthias Schiffer <matthias@gamezock.de> | 2010-03-09 03:49:15 +0100 |
commit | 7327695ca3d9aee5da1d0bc98572d877dd8c8546 (patch) | |
tree | e733714968ae0a041f76b213ffe31cca70ada6fb /HTanks.hs | |
parent | 2bb85618366681c7c97f8b36cc85a18c45beb924 (diff) | |
download | htanks-7327695ca3d9aee5da1d0bc98572d877dd8c8546.tar htanks-7327695ca3d9aee5da1d0bc98572d877dd8c8546.zip |
Moved source files to src directory
Diffstat (limited to 'HTanks.hs')
-rw-r--r-- | HTanks.hs | 199 |
1 files changed, 0 insertions, 199 deletions
diff --git a/HTanks.hs b/HTanks.hs deleted file mode 100644 index 6d07cb6..0000000 --- a/HTanks.hs +++ /dev/null @@ -1,199 +0,0 @@ -{-# LANGUAGE PatternGuards, GeneralizedNewtypeDeriving #-} - -import Game -import Level -import Render -import Player -import CPUPlayer -import DefaultPlayer - -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 - - -main :: IO () -main = do - let theLevel = testLevel - gl <- initGL $ glxDriver (levelWidth theLevel) (levelHeight theLevel) - - when (initialized gl) $ do - currentTime <- getCurrentTime - let mainState = MainState {run = True, driver = SomeDriver gl, time = currentTime, players = - [ SomePlayer $ DefaultPlayer S.empty 0 0 False - , SomePlayer $ CPUPlayer 0 - ]} - gameState = GameState {level = theLevel, tanks = [ Tank 5.0 5.0 0 0 2 270 False 3 2 5 - , Tank 5.0 3.5 0 0 2 270 False 3 2 5 - ], shoots = [], textures = M.empty} - - runGame gameState $ do - setup - runMain mainState mainLoop - - deinitGL gl - -minFrameTime :: NominalDiffTime -minFrameTime = 0.01 - -mainLoop :: Main () -mainLoop = do - gl <- gets driver - t <- gets time - handleEvents - - lift render - - liftIO $ swapBuffers gl - - rtime <- liftIO getCurrentTime - let drender = diffUTCTime rtime t - when (drender < minFrameTime) $ - liftIO $ threadDelay $ truncate $ 1e6*(minFrameTime - drender) - - currenttime <- liftIO getCurrentTime - let d = round $ 1e3*(diffUTCTime currenttime t) - - replicateM_ d simulationStep - - let newtime = addUTCTime ((1e-3)*(fromIntegral d)) t - - modify $ \state -> state {time = newtime} - - runnext <- gets run - 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} - - -updateShoot :: State Shoot () -updateShoot = do - angle <- gets shootDir >>= return . (/180) . (*pi) . fromRational . toRational - speed <- gets shootSpeed - let dx = speed * fromRational (round ((cos angle)*1000)%1000000) - dy = speed * fromRational (round ((sin angle)*1000)%1000000) - - modify $ \shoot -> shoot {shootX = dx + shootX shoot, shootY = dy + shootY shoot} - - -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 && (tankShootsLeft tank) > 0) $ ts - newtanks = map (\(tank, shoot, _) -> if shoot then tank {tankShootsLeft = (tankShootsLeft tank) - 1} else tank) $ ts - newshoots = map (\(tank, n) -> Shoot - { shootX = tankX tank - , shootY = tankY tank - , shootDir = tankAim tank - , shootSpeed = tankShootSpeed tank - , shootBouncesLeft = tankShootBounces tank - , shootTank = n - }) shootingtanks - - - modify $ \state -> state {players = p} - lift $ modify $ \state -> state {tanks = newtanks, shoots = map (execState updateShoot) (shoots state ++ newshoots)} - where - updateTank' (player, tank) = let (p, angle, move, aangle, shoot) = playerUpdate player tank - t = execState (updateTank angle move aangle) tank - in (p, t, shoot) - - -handleEvents :: Main () -handleEvents = do - (newgl, event) <- gets driver >>= liftIO . nextEvent - modify $ \state -> state {driver = newgl} - when (isJust event) $ do - Main.handleEvent $ fromJust event - modify $ \state -> state {players = map (\p -> Player.handleEvent p $ fromJust event) $ players state} - handleEvents - -handleEvent :: SomeEvent -> Main () -handleEvent ev - | Just QuitEvent <- fromEvent ev = modify $ \state -> state {run = False} - | otherwise = return () |