This repository has been archived on 2025-03-03. You can view files and clone it, but cannot push or open issues or pull requests.
htanks/HTanks.hs
2010-02-23 20:51:30 +01:00

73 lines
1.6 KiB
Haskell

{-# LANGUAGE PatternGuards #-}
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
main :: IO ()
main = do
gl <- initGL glxDriver
let gameState = GameState {level = testLevel, tanks = [Tank 0.5 0.5 0]}
when (initialized gl) $ do
time <- getClockTime
setup 800 600
runGame gameState $ mainLoop gl time
deinitGL gl
minFrameTime :: Integer
minFrameTime = 10000
mainLoop :: Driver a => a -> ClockTime -> Game ()
mainLoop gl time = do
run <- liftIO $ handleEvents gl
render
liftIO $ swapBuffers gl
newTime <- liftIO getClockTime
let td = timeDiff newTime time
when (td < minFrameTime) $
liftIO $ threadDelay $ fromIntegral (minFrameTime - td)
newTime <- liftIO getClockTime
--liftIO $ print $ timeDiff newTime time
when run $ mainLoop gl newTime
timeDiff :: ClockTime -> ClockTime -> Integer
timeDiff (TOD s1 ps1) (TOD s2 ps2) = (s1-s2)*1000000 + (ps1-ps2)`div`1000000
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 QuitEvent <- fromEvent ev = return False
| Just (ResizeEvent w h) <- fromEvent ev = do
resize w h
return True
| otherwise = return True