diff options
Diffstat (limited to 'src/HTanks.hs')
| -rw-r--r-- | src/HTanks.hs | 199 |
1 files changed, 199 insertions, 0 deletions
diff --git a/src/HTanks.hs b/src/HTanks.hs new file mode 100644 index 0000000..6d07cb6 --- /dev/null +++ b/src/HTanks.hs @@ -0,0 +1,199 @@ +{-# 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 () |