diff options
| -rw-r--r-- | GLDriver.hs | 12 | ||||
| -rw-r--r-- | HTanks.hs | 55 | ||||
| -rw-r--r-- | Render.hs | 20 |
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 @@ -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 @@ -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) |