From d6b28723a26151d8ac6cb195d4e2135b05fdac5a Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <matthias@gamezock.de>
Date: Wed, 7 Apr 2010 15:07:27 +0200
Subject: Use system sleep functions as threadDelay sleep to long without
 -threaded

---
 src/Bindings/GLX.hsc | 5 +++++
 src/Collision.hs     | 2 +-
 src/GLDriver.hs      | 3 +++
 src/GLX.hs           | 2 ++
 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
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
-- 
cgit v1.2.3