{-# LANGUAGE PatternGuards, GeneralizedNewtypeDeriving #-} import Game import Level import Render import Tank 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 gl <- initGL glxDriver when (initialized gl) $ do currentTime <- getCurrentTime let mainState = MainState {run = True, driver = SomeDriver gl, time = currentTime, players = [ SomePlayer $ DefaultPlayer S.empty , SomePlayer $ CPUPlayer 0 ]} gameState = GameState {level = testLevel, tanks = [ Tank 0.0 0.0 0 0 2 360 False , Tank 0.0 (-1.5) 0 0 2 360 False ], textures = M.empty} runGame gameState $ do setup 800 600 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 dir tspeed <- gets turnspeed >>= 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 {dir = newangle180} updateTank :: Maybe Micro -> Bool -> State Tank () updateTank angle move = do when (isJust angle) $ updateAngle $ fromJust angle when move $ do tdir <- gets dir tspeed <- gets speed moved <- gets moving 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 {posx = x + posx tank, posy = y + posy tank, moving = True} when (not move) $ do modify $ \tank -> tank {moving = False} simulationStep :: Main () simulationStep = do oldplayers <- gets players oldtanks <- lift $ gets tanks let pt = unzip $ map updateTank' $ zip oldplayers oldtanks modify $ \state -> state {players = fst pt} lift $ modify $ \state -> state {tanks = snd pt} where updateTank' (player, tank) = let (p, angle, move) = playerMovement player tank t = execState (updateTank angle move) tank in (p, t) handleEvents :: Main () handleEvents = do event <- gets driver >>= liftIO . nextEvent 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 (ResizeEvent w h) <- fromEvent ev = lift $ resize w h | Just QuitEvent <- fromEvent ev = modify $ \state -> state {run = False} | otherwise = return ()