Used fixed point numbers for coordinates

This commit is contained in:
Matthias Schiffer 2010-02-24 02:42:10 +01:00
parent 9036ac3105
commit 4a6d841bc7
3 changed files with 31 additions and 25 deletions

View file

@ -11,12 +11,12 @@ import GLX
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
import Control.Monad.State import Control.Monad.State
import Data.Maybe import Data.Maybe
import System.Time import Data.Time.Clock
data MainState = MainState data MainState = MainState
{ driver :: !SomeDriver { driver :: !SomeDriver
, time :: !ClockTime , time :: !UTCTime
} }
newtype MainT m a = MainT (StateT MainState m a) newtype MainT m a = MainT (StateT MainState m a)
@ -33,8 +33,8 @@ main = do
gl <- initGL glxDriver gl <- initGL glxDriver
when (initialized gl) $ do when (initialized gl) $ do
clockTime <- getClockTime currentTime <- getCurrentTime
let mainState = MainState {driver = SomeDriver gl, time = clockTime} let mainState = MainState {driver = SomeDriver gl, time = currentTime}
gameState = GameState {level = testLevel, tanks = [Tank 0.0 0.0 0]} gameState = GameState {level = testLevel, tanks = [Tank 0.0 0.0 0]}
setup 800 600 setup 800 600
@ -42,8 +42,8 @@ main = do
deinitGL gl deinitGL gl
minFrameTime :: Integer minFrameTime :: NominalDiffTime
minFrameTime = 10 minFrameTime = 0.01
mainLoop :: Main () mainLoop :: Main ()
mainLoop = do mainLoop = do
@ -55,27 +55,25 @@ mainLoop = do
liftIO $ swapBuffers gl liftIO $ swapBuffers gl
newTime <- liftIO getClockTime rtime <- liftIO getCurrentTime
let td = timeDiff newTime t let drender = diffUTCTime rtime t
when (td < minFrameTime) $ when (drender < minFrameTime) $
liftIO $ threadDelay $ fromIntegral $ 1000*(minFrameTime - td) liftIO $ threadDelay $ truncate $ 1e6*(minFrameTime - drender)
newTime <- liftIO getClockTime currenttime <- liftIO getCurrentTime
let td = timeDiff newTime t 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 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 :: Driver a => a -> IO Bool
handleEvents gl = do handleEvents gl = do
event <- nextEvent gl event <- nextEvent gl

View file

@ -9,6 +9,9 @@ import Tank
import Control.Monad.State import Control.Monad.State
import Data.Fixed
import Data.Ratio
import Graphics.Rendering.OpenGL.GL (($=), GLfloat) import Graphics.Rendering.OpenGL.GL (($=), GLfloat)
import Graphics.Rendering.OpenGL.GL.BeginEnd (renderPrimitive, PrimitiveMode(..)) import Graphics.Rendering.OpenGL.GL.BeginEnd (renderPrimitive, PrimitiveMode(..))
import Graphics.Rendering.OpenGL.GL.CoordTrans (matrixMode, MatrixMode(..), viewport, Position(..), Size(..), loadIdentity, ortho) import Graphics.Rendering.OpenGL.GL.CoordTrans (matrixMode, MatrixMode(..), viewport, Position(..), Size(..), loadIdentity, ortho)
@ -38,13 +41,16 @@ resize w h = do
render :: Game () render :: Game ()
render = do render = do
tank <- liftM head $ gets tanks tank <- liftM head $ gets tanks
let x = posx tank let x = toFloat . posx $ tank
y = posy tank y = toFloat . posy $ tank
liftIO $ do liftIO $ do
clear [ColorBuffer] clear [ColorBuffer]
renderPrimitive Triangles $ do 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)
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

View file

@ -1,8 +1,10 @@
module Tank ( Tank(..) module Tank ( Tank(..)
) where ) where
import Data.Fixed
data Tank = Tank data Tank = Tank
{ posx :: !Float { posx :: !Micro
, posy :: !Float , posy :: !Micro
, dir :: !Float , dir :: !Micro
} deriving Show } deriving Show