summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--GLDriver.hs12
-rw-r--r--HTanks.hs55
-rw-r--r--Render.hs20
3 files changed, 62 insertions, 25 deletions
diff --git a/GLDriver.hs b/GLDriver.hs
index 2e3dafc..9fb2642 100644
--- a/GLDriver.hs
+++ b/GLDriver.hs
@@ -1,6 +1,7 @@
{-# LANGUAGE ExistentialQuantification, DeriveDataTypeable #-}
module GLDriver ( Driver(..)
+ , SomeDriver(..)
, Event
, SomeEvent(..)
, QuitEvent(..)
@@ -21,6 +22,15 @@ class Driver a where
nextEvent :: a -> IO (Maybe SomeEvent)
+data SomeDriver = forall d. Driver d => SomeDriver d
+
+instance Driver SomeDriver where
+ initialized (SomeDriver d) = initialized d
+ initGL (SomeDriver d) = initGL d >>= return . SomeDriver
+ deinitGL (SomeDriver d) = deinitGL d
+ swapBuffers (SomeDriver d) = swapBuffers d
+ nextEvent (SomeDriver d) = nextEvent d
+
class Typeable a => Event a
@@ -34,4 +44,4 @@ data QuitEvent = QuitEvent deriving Typeable
instance Event QuitEvent
data ResizeEvent = ResizeEvent Int Int deriving Typeable
-instance Event ResizeEvent \ No newline at end of file
+instance Event ResizeEvent
diff --git a/HTanks.hs b/HTanks.hs
index d5536b2..fd4b018 100644
--- a/HTanks.hs
+++ b/HTanks.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE PatternGuards, GeneralizedNewtypeDeriving #-}
import Game
import Level
@@ -14,45 +14,66 @@ import Data.Maybe
import System.Time
+data MainState = MainState
+ { driver :: !SomeDriver
+ , time :: !ClockTime
+ }
+
+newtype MainT m a = MainT (StateT MainState m a)
+ deriving (Monad, MonadState MainState, MonadIO, MonadTrans)
+
+type Main = MainT Game
+
+runMain :: MainState -> Main a -> Game (a, MainState)
+runMain st (MainT a) = runStateT a st
+
+
main :: IO ()
main = do
gl <- initGL glxDriver
- let gameState = GameState {level = testLevel, tanks = [Tank 0.5 0.5 0]}
-
when (initialized gl) $ do
- time <- getClockTime
+ clockTime <- getClockTime
+ let mainState = MainState {driver = SomeDriver gl, time = clockTime}
+ gameState = GameState {level = testLevel, tanks = [Tank 0.0 0.0 0]}
setup 800 600
- runGame gameState $ mainLoop gl time
+ runGame gameState $ runMain mainState $ mainLoop
deinitGL gl
minFrameTime :: Integer
-minFrameTime = 10000
+minFrameTime = 10
-mainLoop :: Driver a => a -> ClockTime -> Game ()
-mainLoop gl time = do
+mainLoop :: Main ()
+mainLoop = do
+ gl <- gets driver
+ t <- gets time
run <- liftIO $ handleEvents gl
- render
+ lift render
liftIO $ swapBuffers gl
newTime <- liftIO getClockTime
- let td = timeDiff newTime time
+ let td = timeDiff newTime t
when (td < minFrameTime) $
- liftIO $ threadDelay $ fromIntegral (minFrameTime - td)
+ liftIO $ threadDelay $ fromIntegral $ 1000*(minFrameTime - td)
newTime <- liftIO getClockTime
+ let td = timeDiff newTime t
+
+ lift $ modify $ \state -> state {tanks = (Tank ((posx . head . tanks $ state)+0.0001*(fromIntegral td)) 0.0 0):(tail . tanks $ state)}
+
+ --liftIO $ print $ timeDiff newTime t
- --liftIO $ print $ timeDiff newTime time
+ modify $ \state -> state {time = newTime}
- when run $ mainLoop gl newTime
+ when run $ mainLoop
timeDiff :: ClockTime -> ClockTime -> Integer
-timeDiff (TOD s1 ps1) (TOD s2 ps2) = (s1-s2)*1000000 + (ps1-ps2)`div`1000000
+timeDiff (TOD s1 ps1) (TOD s2 ps2) = (s1-s2)*1000 + (ps1-ps2)`div`1000000000
handleEvents :: Driver a => a -> IO Bool
@@ -66,8 +87,8 @@ handleEvents gl = do
handleEvent :: SomeEvent -> IO Bool
handleEvent ev
- | Just QuitEvent <- fromEvent ev = return False
| Just (ResizeEvent w h) <- fromEvent ev = do
- resize w h
- return True
+ resize w h
+ return True
+ | Just QuitEvent <- fromEvent ev = return False
| otherwise = return True
diff --git a/Render.hs b/Render.hs
index 86a7ccf..b11e2ff 100644
--- a/Render.hs
+++ b/Render.hs
@@ -5,6 +5,7 @@ module Render ( setup
import Game
+import Tank
import Control.Monad.State
@@ -16,8 +17,9 @@ import Graphics.Rendering.OpenGL.GL.VertexSpec
setup :: Int -> Int -> IO ()
-setup = resize
-
+setup w h = do
+ resize w h
+
resize :: Int -> Int -> IO ()
resize w h = do
let wn = fromIntegral w
@@ -34,11 +36,15 @@ resize w h = do
render :: Game ()
-render = liftIO $ do
+render = do
+ tank <- liftM head $ gets tanks
+ let x = posx tank
+ y = posy tank
+
+ liftIO $ do
clear [ColorBuffer]
renderPrimitive Triangles $ do
- vertex $ Vertex2 (-0.5 :: GLfloat) (0.5 :: GLfloat)
- vertex $ Vertex2 (0.5 :: GLfloat) (0.5 :: GLfloat)
- vertex $ Vertex2 (0.5 :: GLfloat) (-0.5 :: GLfloat)
- \ No newline at end of file
+ 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)