Use state monad to hold main loop state

GLDriver.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE ExistentialQuantification, DeriveDataTypeable #-}
 
 module GLDriver ( Driver(..)
+                , SomeDriver(..)
                 , Event
                 , SomeEvent(..)
                 , QuitEvent(..)
@@ -21,6 +22,15 @@ class Driver a where
     
     nextEvent :: a -> IO (Maybe SomeEvent)
 
+data SomeDriver = forall d. Driver d => SomeDriver d
+
+instance Driver SomeDriver where
+    initialized (SomeDriver d) = initialized d
+    initGL (SomeDriver d) = initGL d >>= return . SomeDriver
+    deinitGL (SomeDriver d) = deinitGL d
+    swapBuffers (SomeDriver d) = swapBuffers d
+    nextEvent (SomeDriver d) = nextEvent d
+
 
 class Typeable a => Event a
 

HTanks.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE PatternGuards, GeneralizedNewtypeDeriving #-}
 
 import Game
 import Level
@@ -14,45 +14,66 @@ 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
   
-  let gameState = GameState {level = testLevel, tanks = [Tank 0.5 0.5 0]}
-  
   when (initialized gl) $ do
-         time <- getClockTime
+         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 $ mainLoop gl time
+         runGame gameState $ runMain mainState $ mainLoop
          
          deinitGL gl
 
 minFrameTime :: Integer
-minFrameTime = 10000
+minFrameTime = 10
 
-mainLoop :: Driver a => a -> ClockTime -> Game ()
+mainLoop :: Main ()
-mainLoop gl time = do
+mainLoop = do
+  gl <- gets driver
+  t <- gets time
   run <- liftIO $ handleEvents gl
   
-  render
+  lift render
   
   liftIO $ swapBuffers gl
   
   newTime <- liftIO getClockTime
-  let td = timeDiff newTime time
+  let td = timeDiff newTime t
   when (td < minFrameTime) $
-       liftIO $ threadDelay $ fromIntegral (minFrameTime - td)
+       liftIO $ threadDelay $ fromIntegral $ 1000*(minFrameTime - td)
   
   newTime <- liftIO getClockTime
+  let td = timeDiff newTime t
   
-  --liftIO $ print $ timeDiff newTime time
+  lift $ modify $ \state -> state {tanks = (Tank ((posx . head . tanks $ state)+0.0001*(fromIntegral td)) 0.0 0):(tail . tanks $ state)}
   
-  when run $ mainLoop gl newTime
+  --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)*1000000 + (ps1-ps2)`div`1000000
+timeDiff (TOD s1 ps1) (TOD s2 ps2) = (s1-s2)*1000 + (ps1-ps2)`div`1000000000
 
 
 handleEvents :: Driver a => a -> IO Bool
@@ -66,8 +87,8 @@ handleEvents gl = do
 
 handleEvent :: SomeEvent -> IO Bool
 handleEvent ev
-    | Just QuitEvent <- fromEvent ev = return False
     | Just (ResizeEvent w h) <- fromEvent ev = do
                                   resize w h
                                   return True
+    | Just QuitEvent <- fromEvent ev = return False
     | otherwise                      = return True

Render.hs

@@ -5,6 +5,7 @@ module Render ( setup
 
 
 import Game
+import Tank
 
 import Control.Monad.State
 
@@ -16,7 +17,8 @@ import Graphics.Rendering.OpenGL.GL.VertexSpec
 
 
 setup :: Int -> Int -> IO ()
-setup = resize
+setup w h = do
+  resize w h
 
 resize :: Int -> Int -> IO ()
 resize w h = do
@@ -34,11 +36,15 @@ resize w h = do
 
 
 render :: Game ()
-render = liftIO $ do
+render = do
+  tank <- liftM head $ gets tanks
+  let x = posx tank
+      y = posy tank
+  
+  liftIO $ do
            clear [ColorBuffer]
            
            renderPrimitive Triangles $ do
-                    vertex $ Vertex2 (-0.5 :: GLfloat) (0.5 :: GLfloat)
+                    vertex $ Vertex2 (x-0.5 :: GLfloat) (y+0.5 :: GLfloat)
-                    vertex $ Vertex2 (0.5 :: GLfloat) (0.5 :: GLfloat)
+                    vertex $ Vertex2 (x+0.5 :: GLfloat) (y+0.5 :: GLfloat)
-                    vertex $ Vertex2 (0.5 :: GLfloat) (-0.5 :: GLfloat)
+                    vertex $ Vertex2 (x+0.5 :: GLfloat) (y-0.5 :: GLfloat)
-