summaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorMatthias Schiffer <matthias@gamezock.de>2010-04-07 15:07:27 +0200
committerMatthias Schiffer <matthias@gamezock.de>2010-04-07 15:07:27 +0200
commitd6b28723a26151d8ac6cb195d4e2135b05fdac5a (patch)
tree3b70252d6384a1a4434364095c3b600118872307 /src
parentc0d2d54ea1687a80ff76fa032ad4dc89670d2988 (diff)
downloadhtanks-d6b28723a26151d8ac6cb195d4e2135b05fdac5a.tar
htanks-d6b28723a26151d8ac6cb195d4e2135b05fdac5a.zip
Use system sleep functions as threadDelay sleep to long without -threaded
Diffstat (limited to 'src')
-rw-r--r--src/Bindings/GLX.hsc5
-rw-r--r--src/Collision.hs2
-rw-r--r--src/GLDriver.hs3
-rw-r--r--src/GLX.hs2
-rw-r--r--src/HTanks.hs9
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
diff --git a/src/GLX.hs b/src/GLX.hs
index 6f5b0fc..6f245a7 100644
--- a/src/GLX.hs
+++ b/src/GLX.hs
@@ -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