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.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
|
||||
|
|
12
Render.hs
12
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
|
8
Tank.hs
8
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
|
||||
|
|
Reference in a new issue