summaryrefslogtreecommitdiffstats
path: root/HTanks.hs
diff options
context:
space:
mode:
authorMatthias Schiffer <matthias@gamezock.de>2010-03-09 03:49:15 +0100
committerMatthias Schiffer <matthias@gamezock.de>2010-03-09 03:49:15 +0100
commit7327695ca3d9aee5da1d0bc98572d877dd8c8546 (patch)
treee733714968ae0a041f76b213ffe31cca70ada6fb /HTanks.hs
parent2bb85618366681c7c97f8b36cc85a18c45beb924 (diff)
downloadhtanks-7327695ca3d9aee5da1d0bc98572d877dd8c8546.tar
htanks-7327695ca3d9aee5da1d0bc98572d877dd8c8546.zip
Moved source files to src directory
Diffstat (limited to 'HTanks.hs')
-rw-r--r--HTanks.hs199
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 ()