{-# 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 System.Time data MainState = MainState { driver :: !SomeDriver , time :: !ClockTime } 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 clockTime <- getClockTime let mainState = MainState {driver = SomeDriver gl, time = clockTime} gameState = GameState {level = testLevel, tanks = [Tank 0.0 0.0 0]} setup 800 600 runGame gameState $ runMain mainState $ mainLoop deinitGL gl minFrameTime :: Integer minFrameTime = 10 mainLoop :: Main () mainLoop = do gl <- gets driver t <- gets time run <- liftIO $ handleEvents gl lift render liftIO $ swapBuffers gl newTime <- liftIO getClockTime let td = timeDiff newTime t when (td < minFrameTime) $ liftIO $ threadDelay $ fromIntegral $ 1000*(minFrameTime - td) newTime <- liftIO getClockTime let td = timeDiff newTime t lift $ modify $ \state -> state {tanks = (Tank ((posx . head . tanks $ state)+0.0001*(fromIntegral td)) 0.0 0):(tail . tanks $ state)} --liftIO $ print $ timeDiff newTime t modify $ \state -> state {time = newTime} when run $ mainLoop timeDiff :: ClockTime -> ClockTime -> Integer timeDiff (TOD s1 ps1) (TOD s2 ps2) = (s1-s2)*1000 + (ps1-ps2)`div`1000000000 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