diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Bindings/GLX.hsc | 5 | ||||
| -rw-r--r-- | src/Collision.hs | 2 | ||||
| -rw-r--r-- | src/GLDriver.hs | 3 | ||||
| -rw-r--r-- | src/GLX.hs | 2 | ||||
| -rw-r--r-- | src/HTanks.hs | 9 |
5 files changed, 17 insertions, 4 deletions
diff --git a/src/Bindings/GLX.hsc b/src/Bindings/GLX.hsc index d5fed4d..f773aad 100644 --- a/src/Bindings/GLX.hsc +++ b/src/Bindings/GLX.hsc @@ -20,6 +20,7 @@ module Bindings.GLX ( createColormap , makeCurrent , destroyContext , swapBuffers + , glxUsleep , Context(..) , Drawable ) where @@ -41,6 +42,7 @@ import Graphics.X11.Xlib.Types (Dimension, Display, Pixel, Position) #include <GL/glx.h> +#include <unistd.h> type Drawable = XID @@ -263,3 +265,6 @@ foreign import ccall unsafe "GL/glx.h glXDestroyContext" foreign import ccall unsafe "GL/glx.h glXSwapBuffers" swapBuffers :: Display -> Drawable -> IO () + +foreign import ccall unsafe "unistd.h usleep" + glxUsleep :: CULong -> IO () diff --git a/src/Collision.hs b/src/Collision.hs index a69dc10..30ec6e9 100644 --- a/src/Collision.hs +++ b/src/Collision.hs @@ -16,7 +16,7 @@ tankLength :: Micro tankLength = 0.95 bulletDiameter :: Micro -bulletDiameter = 0.1 +bulletDiameter = 0.05 collisionTankBorder :: Micro -> Micro -> Tank -> Tank collisionTankBorder lw lh tank = tank {tankX = newx, tankY = newy} diff --git a/src/GLDriver.hs b/src/GLDriver.hs index 7340075..3d344ef 100644 --- a/src/GLDriver.hs +++ b/src/GLDriver.hs @@ -24,6 +24,8 @@ class Driver a where swapBuffers :: a -> IO () + usleep :: a -> Integer -> IO () + nextEvent :: a -> IO (a, Maybe SomeEvent) data SomeDriver = forall d. Driver d => SomeDriver d @@ -34,6 +36,7 @@ instance Driver SomeDriver where deinitGL (SomeDriver d) = deinitGL d swapBuffers (SomeDriver d) = swapBuffers d nextEvent (SomeDriver d) = nextEvent d >>= \(gl, ev) -> return (SomeDriver gl, ev) + usleep (SomeDriver d) = usleep d class (Typeable a, Show a) => Event a @@ -105,6 +105,8 @@ instance Driver GLX where swapBuffers glx = Bindings.GLX.swapBuffers (glxDisplay glx) (glxWindow glx) nextEvent glx = allocaXEvent $ nextEvent' glx + + usleep _ usecs = glxUsleep $ fromIntegral usecs nextEvent' :: GLX -> XEventPtr -> IO (GLX, Maybe SomeEvent) diff --git a/src/HTanks.hs b/src/HTanks.hs index 660f03c..55d82ec 100644 --- a/src/HTanks.hs +++ b/src/HTanks.hs @@ -21,6 +21,9 @@ import qualified Data.Map as M import qualified Data.Set as S import Data.Time +import Foreign.C.Types + + main :: IO () main = do let theLevel = testLevel @@ -45,7 +48,7 @@ main = do deinitGL gl minFrameTime :: NominalDiffTime -minFrameTime = 0.01 +minFrameTime = 0.02 mainLoop :: Main () mainLoop = do @@ -60,9 +63,10 @@ mainLoop = do rtime <- liftIO getCurrentTime let drender = diffUTCTime rtime t when (drender < minFrameTime) $ - liftIO $ threadDelay $ truncate $ 1e6*(minFrameTime - drender) + liftIO $ usleep gl $ truncate $ 1e6*(minFrameTime - drender) currenttime <- liftIO getCurrentTime + liftIO $ print $ diffUTCTime currenttime rtime let d = round $ 1e2*(diffUTCTime currenttime t) replicateM_ d simulationStep @@ -74,7 +78,6 @@ mainLoop = do runnext <- gets run when runnext mainLoop - handleEvents :: Main () handleEvents = do (newgl, event) <- gets driver >>= liftIO . nextEvent |