{-# LANGUAGE PatternGuards, GeneralizedNewtypeDeriving #-} import Game import Level import Render import Tank import GLDriver import GLX import Control.Concurrent (threadDelay) import Control.Monad.State import Data.Maybe import Data.Time.Clock data MainState = MainState { driver :: !SomeDriver , time :: !UTCTime } 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 {driver = SomeDriver gl, time = currentTime} gameState = GameState {level = testLevel, tanks = [Tank 0.0 0.0 0]} setup 800 600 runGame gameState $ runMain mainState $ mainLoop deinitGL gl minFrameTime :: NominalDiffTime minFrameTime = 0.01 mainLoop :: Main () mainLoop = do gl <- gets driver t <- gets time run <- liftIO $ handleEvents gl 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) lift $ modify $ \state -> state {tanks = (Tank ((posx . head . tanks $ state)+(0.0001* fromIntegral d)) 0.0 0):(tail . tanks $ state)} liftIO $ print $ d let newtime = addUTCTime ((1e-3)*(fromIntegral d)) t modify $ \state -> state {time = newtime} when run $ mainLoop handleEvents :: Driver a => a -> IO Bool handleEvents gl = do event <- nextEvent gl if (isJust event) then handleEvent $ fromJust event else return True handleEvent :: SomeEvent -> IO Bool handleEvent ev | Just (ResizeEvent w h) <- fromEvent ev = do resize w h return True | Just QuitEvent <- fromEvent ev = return False | otherwise = return True