From 9036ac310501dd9d2eba181270711c328963d17f Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <matthias@gamezock.de>
Date: Tue, 23 Feb 2010 23:31:11 +0100
Subject: Use state monad to hold main loop state

---
 GLDriver.hs | 12 +++++++++++-
 HTanks.hs   | 55 ++++++++++++++++++++++++++++++++++++++-----------------
 Render.hs   | 20 +++++++++++++-------
 3 files changed, 62 insertions(+), 25 deletions(-)

diff --git a/GLDriver.hs b/GLDriver.hs
index 2e3dafc..9fb2642 100644
--- a/GLDriver.hs
+++ b/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
 
@@ -34,4 +44,4 @@ data QuitEvent = QuitEvent deriving Typeable
 instance Event QuitEvent
 
 data ResizeEvent = ResizeEvent Int Int deriving Typeable
-instance Event ResizeEvent
\ No newline at end of file
+instance Event ResizeEvent
diff --git a/HTanks.hs b/HTanks.hs
index d5536b2..fd4b018 100644
--- a/HTanks.hs
+++ b/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 gl time = do
+mainLoop :: Main ()
+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
+  
+  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
   
-  --liftIO $ print $ timeDiff newTime time
+  modify $ \state -> state {time = newTime}
   
-  when run $ mainLoop gl 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
+                                  resize w h
+                                  return True
+    | Just QuitEvent <- fromEvent ev = return False
     | otherwise                      = return True
diff --git a/Render.hs b/Render.hs
index 86a7ccf..b11e2ff 100644
--- a/Render.hs
+++ b/Render.hs
@@ -5,6 +5,7 @@ module Render ( setup
 
 
 import Game
+import Tank
 
 import Control.Monad.State
 
@@ -16,8 +17,9 @@ 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
   let wn = fromIntegral w
@@ -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 (0.5 :: GLfloat) (0.5 :: GLfloat)
-                    vertex $ Vertex2 (0.5 :: GLfloat) (-0.5 :: GLfloat)
-                    
\ No newline at end of file
+                    vertex $ Vertex2 (x-0.5 :: GLfloat) (y+0.5 :: GLfloat)
+                    vertex $ Vertex2 (x+0.5 :: GLfloat) (y+0.5 :: GLfloat)
+                    vertex $ Vertex2 (x+0.5 :: GLfloat) (y-0.5 :: GLfloat)
-- 
cgit v1.2.3