{-# 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 ()