Used fixed point numbers for coordinates
This commit is contained in:
parent
9036ac3105
commit
4a6d841bc7
3 changed files with 31 additions and 25 deletions
36
HTanks.hs
36
HTanks.hs
|
@ -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
|
||||||
|
|
12
Render.hs
12
Render.hs
|
@ -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
|
8
Tank.hs
8
Tank.hs
|
@ -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
|
||||||
|
|
Reference in a new issue