summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMatthias Schiffer <matthias@gamezock.de>2010-02-24 02:42:10 +0100
committerMatthias Schiffer <matthias@gamezock.de>2010-02-24 02:42:10 +0100
commit4a6d841bc7e3b17bf399ae2e39d409fe85a6fffb (patch)
tree2668cbf6f6c21f2ab5c44e7322e4237d29d34a1b
parent9036ac310501dd9d2eba181270711c328963d17f (diff)
downloadhtanks-4a6d841bc7e3b17bf399ae2e39d409fe85a6fffb.tar
htanks-4a6d841bc7e3b17bf399ae2e39d409fe85a6fffb.zip
Used fixed point numbers for coordinates
-rw-r--r--HTanks.hs36
-rw-r--r--Render.hs12
-rw-r--r--Tank.hs8
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