From 4a6d841bc7e3b17bf399ae2e39d409fe85a6fffb Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <matthias@gamezock.de>
Date: Wed, 24 Feb 2010 02:42:10 +0100
Subject: Used fixed point numbers for coordinates

---
 HTanks.hs | 36 +++++++++++++++++-------------------
 Render.hs | 12 +++++++++---
 Tank.hs   |  8 +++++---
 3 files changed, 31 insertions(+), 25 deletions(-)

diff --git a/HTanks.hs b/HTanks.hs
index fd4b018..c2a5437 100644
--- a/HTanks.hs
+++ b/HTanks.hs
@@ -11,12 +11,12 @@ import GLX
 import Control.Concurrent (threadDelay)
 import Control.Monad.State
 import Data.Maybe
-import System.Time
+import Data.Time.Clock
 
 
 data MainState = MainState
                { driver   :: !SomeDriver
-               , time     :: !ClockTime
+               , time     :: !UTCTime
                }
 
 newtype MainT m a = MainT (StateT MainState m a)
@@ -33,8 +33,8 @@ main = do
   gl <- initGL glxDriver
   
   when (initialized gl) $ do
-         clockTime <- getClockTime
-         let mainState = MainState {driver = SomeDriver gl, time = clockTime}
+         currentTime <- getCurrentTime
+         let mainState = MainState {driver = SomeDriver gl, time = currentTime}
              gameState = GameState {level = testLevel, tanks = [Tank 0.0 0.0 0]}
          
          setup 800 600
@@ -42,8 +42,8 @@ main = do
          
          deinitGL gl
 
-minFrameTime :: Integer
-minFrameTime = 10
+minFrameTime :: NominalDiffTime
+minFrameTime = 0.01
 
 mainLoop :: Main ()
 mainLoop = do
@@ -55,27 +55,25 @@ mainLoop = do
   
   liftIO $ swapBuffers gl
   
-  newTime <- liftIO getClockTime
-  let td = timeDiff newTime t
-  when (td < minFrameTime) $
-       liftIO $ threadDelay $ fromIntegral $ 1000*(minFrameTime - td)
+  rtime <- liftIO getCurrentTime
+  let drender = diffUTCTime rtime t
+  when (drender < minFrameTime) $
+       liftIO $ threadDelay $ truncate $ 1e6*(minFrameTime - drender)
   
-  newTime <- liftIO getClockTime
-  let td = timeDiff newTime t
+  currenttime <- liftIO getCurrentTime
+  let d = round $ 1e3*(diffUTCTime currenttime t)
   
-  lift $ modify $ \state -> state {tanks = (Tank ((posx . head . tanks $ state)+0.0001*(fromIntegral td)) 0.0 0):(tail . tanks $ state)}
+  lift $ modify $ \state -> state {tanks = (Tank ((posx . head . tanks $ state)+(0.0001* fromIntegral d)) 0.0 0):(tail . tanks $ state)}
   
-  --liftIO $ print $ timeDiff newTime t
+  liftIO $ print $ d
   
-  modify $ \state -> state {time = newTime}
+  let newtime = addUTCTime ((1e-3)*(fromIntegral d)) 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
diff --git a/Render.hs b/Render.hs
index b11e2ff..ec34e78 100644
--- a/Render.hs
+++ b/Render.hs
@@ -9,6 +9,9 @@ import Tank
 
 import Control.Monad.State
 
+import Data.Fixed
+import Data.Ratio
+
 import Graphics.Rendering.OpenGL.GL (($=), GLfloat)
 import Graphics.Rendering.OpenGL.GL.BeginEnd (renderPrimitive, PrimitiveMode(..))
 import Graphics.Rendering.OpenGL.GL.CoordTrans (matrixMode, MatrixMode(..), viewport, Position(..), Size(..), loadIdentity, ortho)
@@ -38,13 +41,16 @@ resize w h = do
 render :: Game ()
 render = do
   tank <- liftM head $ gets tanks
-  let x = posx tank
-      y = posy tank
+  let x = toFloat . posx $ tank
+      y = toFloat . posy $ tank
   
   liftIO $ do
            clear [ColorBuffer]
            
            renderPrimitive Triangles $ do
-                    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)
                     vertex $ Vertex2 (x+0.5 :: GLfloat) (y-0.5 :: GLfloat)
+
+toFloat :: Real a => a -> GLfloat
+toFloat = fromRational . toRational
\ No newline at end of file
diff --git a/Tank.hs b/Tank.hs
index c5bf465..4e1f02a 100644
--- a/Tank.hs
+++ b/Tank.hs
@@ -1,8 +1,10 @@
 module Tank ( Tank(..)
             ) where
 
+import Data.Fixed
+
 data Tank = Tank
-          { posx :: !Float
-          , posy :: !Float
-          , dir :: !Float
+          { posx :: !Micro
+          , posy :: !Micro
+          , dir  :: !Micro
           } deriving Show
-- 
cgit v1.2.3