From 4fc298a611785ddac55cb0679953411638679edc Mon Sep 17 00:00:00 2001 From: 3gg <3gg@shellblade.net> Date: Thu, 14 Sep 2023 09:12:19 -0700 Subject: New Timer module and game loop with semi-fixed time step. --- Demos/Pong/Main.hs | 22 ++-- Spear.cabal | 19 ++-- Spear/App.hs | 92 +++++++++++------ Spear/Sys/Timer.hsc | 255 ++++++++++++++++++++++++++--------------------- Spear/Sys/Timer/Timer.h | 130 ------------------------ Spear/Sys/Timer/ctimer.c | 157 ----------------------------- Spear/Sys/Timer/timer.c | 101 +++++++++++++++++++ Spear/Sys/Timer/timer.h | 64 ++++++++++++ Spear/Window.hs | 105 +++++++++++-------- 9 files changed, 450 insertions(+), 495 deletions(-) delete mode 100644 Spear/Sys/Timer/Timer.h delete mode 100644 Spear/Sys/Timer/ctimer.c create mode 100644 Spear/Sys/Timer/timer.c create mode 100644 Spear/Sys/Timer/timer.h diff --git a/Demos/Pong/Main.hs b/Demos/Pong/Main.hs index a49efec..ac0feab 100644 --- a/Demos/Pong/Main.hs +++ b/Demos/Pong/Main.hs @@ -18,9 +18,11 @@ data GameState = GameState world :: [GameObject] } +app = App step render resize + main = withWindow (900, 600) (2, 0) (Just "Pong") initGame $ - loop step + loop app initGame :: Window -> Game () GameState initGame window = return $ GameState window newWorld @@ -28,16 +30,18 @@ initGame window = return $ GameState window newWorld step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool step elapsed dt inputEvents = do gs <- getGameState - gameIO . process $ inputEvents let events = translateEvents inputEvents modifyGameState $ \gs -> gs - { world = stepWorld (realToFrac elapsed) dt events (world gs) + { world = stepWorld (realToFrac elapsed) (realToFrac dt) events (world gs) } - getGameState >>= \gs -> gameIO . render $ world gs return (not $ exitRequested inputEvents) -render world = do +render :: Game GameState () +render = getGameState >>= \gs -> gameIO . render' $ world gs + +render' :: [GameObject] -> IO () +render' world = do -- Clear the background to a different colour than the playable area to make -- the latter distinguishable. GL.clearColor $= GL.Color4 0.2 0.2 0.2 0.0 @@ -74,22 +78,20 @@ renderGO go = do GL.vertex (GL.Vertex2 xmax ymax) GL.vertex (GL.Vertex2 xmax ymin) -process = mapM_ procEvent - -procEvent (Resize w h) = +resize :: WindowEvent -> Game s () +resize (ResizeEvent w h) = let r = fromIntegral w / fromIntegral h pad = if r > 1 then (r-1) / 2 else (1/r - 1) / 2 left = if r > 1 then -pad else 0 right = if r > 1 then 1 + pad else 1 bottom = if r > 1 then 0 else -pad top = if r > 1 then 1 else 1 + pad - in do + in gameIO $ do GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h)) GL.matrixMode $= GL.Projection GL.loadIdentity GL.ortho left right bottom top (-1) 1 GL.matrixMode $= GL.Modelview 0 -procEvent _ = return () translateEvents = mapMaybe translateEvents' where translateEvents' (KeyDown KEY_LEFT) = Just MoveLeft diff --git a/Spear.cabal b/Spear.cabal index 448f7f4..40b625d 100644 --- a/Spear.cabal +++ b/Spear.cabal @@ -83,14 +83,15 @@ library cc-options: -O2 -g -Wno-unused-result - c-sources: Spear/Assets/Image/Image.c - Spear/Assets/Image/BMP/BMP_load.c - Spear/Assets/Model/Model.c - Spear/Assets/Model/MD2/MD2_load.c - Spear/Assets/Model/OBJ/cvector.c - Spear/Assets/Model/OBJ/OBJ_load.c - Spear/Render/RenderModel.c - Spear/Sys/Timer/ctimer.c + c-sources: + Spear/Assets/Image/Image.c + Spear/Assets/Image/BMP/BMP_load.c + Spear/Assets/Model/Model.c + Spear/Assets/Model/MD2/MD2_load.c + Spear/Assets/Model/OBJ/cvector.c + Spear/Assets/Model/OBJ/OBJ_load.c + Spear/Render/RenderModel.c + Spear/Sys/Timer/timer.c includes: Spear/Assets/Image/BMP/BMP_load.h @@ -104,7 +105,7 @@ library Spear/Assets/Model/Model_error_code.h Spear/Assets/Model/sys_types.h Spear/Render/RenderModel.h - Timer/Timer.h + Timer/timer.h include-dirs: . diff --git a/Spear/App.hs b/Spear/App.hs index ca9a355..41a338b 100644 --- a/Spear/App.hs +++ b/Spear/App.hs @@ -1,5 +1,6 @@ module Spear.App - ( Elapsed, + ( App(..), + Elapsed, Dt, Step, loop, @@ -7,6 +8,7 @@ module Spear.App where import Control.Monad +import Data.Fixed (mod') import GHC.Float import Spear.Game import Spear.Sys.Timer as Timer @@ -14,49 +16,77 @@ import Spear.Window maxFPS = 60 --- | Time elapsed since the application started. +-- | Time elapsed. type Elapsed = Double -- | Time elapsed since the last frame. -type Dt = Float +type Dt = Double -- | Return true if the application should continue running, false otherwise. type Step s = Elapsed -> Dt -> [InputEvent] -> Game s Bool +-- | Application functions. +data App s = App + { stepApp :: Step s + , renderApp :: Game s () + , resizeApp :: WindowEvent -> Game s () + } + -- | Enter the main application loop. -loop :: Step s -> Window -> Game s () -loop step window = do +loop :: App s -> Window -> Game s () +loop app window = do + -- For convenience, trigger an initial resize followed by a render of the + -- application's initial state. + (width, height) <- gameIO $ getWindowSize window + resizeApp app (ResizeEvent width height) + renderApp app + let ddt = 1.0 / fromIntegral maxFPS -- Desired delta time. - frameTimer <- gameIO $ start newTimer - controlTimer <- gameIO $ start newTimer - loop' window ddt frameTimer controlTimer 0 step - return () + timer <- gameIO newTimer + gameIO $ Timer.start timer + loop' window ddt timer 0 0 app loop' :: Window -> Dt -> Timer -> - Timer -> Elapsed -> - Step s -> + Double -> -- Time budget. + App s -> Game s () -loop' window ddt frameTimer controlTimer elapsed step = do - controlTimer' <- gameIO $ tick controlTimer - frameTimer' <- gameIO $ tick frameTimer - let dt = getDelta frameTimer' - let elapsed' = elapsed + float2Double dt - inputEvents <- gameIO $ pollEvents window - continue <- step elapsed' dt inputEvents - gameIO $ swapBuffers window - close <- gameIO $ shouldWindowClose window - controlTimer'' <- gameIO $ tick controlTimer' - let dt = getDelta controlTimer'' - when (dt < ddt) $ gameIO $ Timer.sleep (ddt - dt) - when (continue && not close) $ - loop' - window - ddt - frameTimer' - controlTimer'' - elapsed' - step +loop' window ddt inputTimer elapsed timeBudget app = do + timer <- gameIO $ tick inputTimer + + (Events inputEvents windowEvents) <- gameIO $ pollEvents window + + let timeBudgetThisFrame = timeBudget + timeDeltaToSec (deltaTime timer) + + let steps = floor (timeBudgetThisFrame / ddt) + continue <- and <$> forM [1..steps] (\i -> + stepApp app (elapsed + fromIntegral i * ddt) ddt inputEvents) + + let elapsed' = elapsed + fromIntegral steps * ddt + let timeBudget' = timeBudgetThisFrame `mod'` ddt + + when continue $ do + forM_ windowEvents $ \event -> case event of + ResizeEvent {} -> resizeApp app event + renderApp app + gameIO $ swapBuffers window + + -- TODO: Conversion of TimeDelta to/from double should be unnecessary here. + -- We ideally need ddt expressed in TimeDelta. + frameEnd <- gameIO now + let frameTime = timeDeltaToSec $ timeDiff (lastTick timer) frameEnd + when (frameTime < ddt) $ do + gameIO $ Timer.sleep (timeSecToDelta (ddt - frameTime)) + + close <- gameIO $ shouldWindowClose window + when (continue && not close) $ + loop' + window + ddt + timer + elapsed' + timeBudget' + app diff --git a/Spear/Sys/Timer.hsc b/Spear/Sys/Timer.hsc index 85718ce..2c806d8 100644 --- a/Spear/Sys/Timer.hsc +++ b/Spear/Sys/Timer.hsc @@ -1,19 +1,22 @@ -{-# LANGUAGE CPP, ForeignFunctionInterface #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} + module Spear.Sys.Timer ( - Timer + Timer(..) , newTimer -, tick , start -, stop -, reset -, getTime -, getDelta -, isRunning +, tick +, now +, timeDiff +, timeDeltaToSec +, timeSecToDelta +, timePointToNs , sleep ) where +import Data.Word import Foreign.C.Types import Foreign.Marshal.Alloc (alloca) import Foreign.Ptr @@ -21,130 +24,152 @@ import Foreign.Storable import Control.Monad import System.IO.Unsafe +#include "Timer/timer.h" + + #ifdef WIN32 -type TimeReading = CULLong +type TimePoint = Word64 #else -type TimeReading = CDouble +{- +struct timespec { + time_t tv_sec; /* seconds */ + long tv_nsec; /* nanoseconds */ +}; +-} +data TimeSpec = TimeSpec { + tvSec :: {-# UNPACK #-} !CTime, + tvNsec :: {-# UNPACK #-} !CLong +} +type TimePoint = TimeSpec #endif +type TimeDelta = Word64 + data Timer = Timer - { getBaseTime :: TimeReading - , getPausedTime :: TimeReading - , getStopTime :: TimeReading - , getPrevTime :: TimeReading - , getCurTime :: TimeReading - , getDeltaTime :: CFloat - , getRunning :: CChar - } + { startTime :: {-# UNPACK #-} !TimePoint + , lastTick :: {-# UNPACK #-} !TimePoint + , runningTime :: {-# UNPACK #-} !TimeDelta + , deltaTime :: {-# UNPACK #-} !TimeDelta + } + + +#ifndef WIN32 +instance Storable TimeSpec where + sizeOf _ = #{size struct timespec} + alignment _ = #{alignment struct timespec} + + peek ptr = do + tvSec <- #{peek struct timespec, tv_sec} ptr + tvNsec <- #{peek struct timespec, tv_nsec} ptr + return $ TimeSpec tvSec tvNsec + + poke ptr (TimeSpec tvSec tvNsec) = do + #{poke struct timespec, tv_sec} ptr tvSec + #{poke struct timespec, tv_nsec} ptr tvNsec +#endif -#include "Timer/Timer.h" instance Storable Timer where - sizeOf _ = #{size Timer} - alignment _ = alignment (undefined :: TimeReading) - - peek ptr = do - baseTime <- #{peek Timer, baseTime} ptr - pausedTime <- #{peek Timer, pausedTime} ptr - stopTime <- #{peek Timer, stopTime} ptr - prevTime <- #{peek Timer, prevTime} ptr - curTime <- #{peek Timer, curTime} ptr - deltaTime <- #{peek Timer, deltaTime} ptr - stopped <- #{peek Timer, stopped} ptr - return $ Timer baseTime pausedTime stopTime prevTime curTime deltaTime stopped - - poke ptr (Timer baseTime pausedTime stopTime prevTime curTime deltaTime stopped) = do - #{poke Timer, baseTime} ptr baseTime - #{poke Timer, pausedTime} ptr pausedTime - #{poke Timer, stopTime} ptr stopTime - #{poke Timer, prevTime} ptr prevTime - #{poke Timer, curTime} ptr curTime - #{poke Timer, deltaTime} ptr deltaTime - #{poke Timer, stopped} ptr stopped - -foreign import ccall unsafe "Timer.h timer_init" - c_timer_init :: Ptr Timer -> IO () - -foreign import ccall unsafe "Timer.h timer_tick" - c_timer_tick :: Ptr Timer -> IO () + --sizeOf _ = #{size Timer} + sizeOf _ = #{size struct Timer} + --alignment _ = alignment (undefined :: Timer) + alignment _ = #{alignment struct Timer} + + peek ptr = do + startTime <- #{peek struct Timer, start_time} ptr + lastTick <- #{peek struct Timer, last_tick} ptr + runningTime <- #{peek struct Timer, running_time} ptr + deltaTime <- #{peek struct Timer, delta_time} ptr + return $ Timer startTime lastTick runningTime deltaTime + + poke ptr (Timer startTime lastTick runningTime deltaTime) = do + #{poke struct Timer, start_time} ptr startTime + #{poke struct Timer, last_tick} ptr lastTick + #{poke struct Timer, running_time} ptr runningTime + #{poke struct Timer, delta_time} ptr deltaTime -foreign import ccall unsafe "Timer.h timer_start" + +foreign import ccall unsafe "timer.h timer_make" + c_timer_make :: Ptr Timer -> IO () + +foreign import ccall unsafe "timer.h timer_start" c_timer_start :: Ptr Timer -> IO () -foreign import ccall unsafe "Timer.h timer_stop" - c_timer_stop :: Ptr Timer -> IO () +foreign import ccall unsafe "timer.h timer_tick" + c_timer_tick :: Ptr Timer -> IO () -foreign import ccall unsafe "Timer.h timer_reset" - c_timer_reset :: Ptr Timer -> IO () +foreign import ccall unsafe "timer.h time_now" + c_time_now :: Ptr TimePoint -> IO () -foreign import ccall unsafe "Timer.h timer_get_time" - c_timer_get_time :: Ptr Timer -> IO (CDouble) +foreign import ccall safe "timer.h time_diff" + c_time_diff :: Ptr TimePoint -> Ptr TimePoint -> TimeDelta -foreign import ccall unsafe "Timer.h timer_get_delta" - c_timer_get_delta :: Ptr Timer -> IO (CFloat) +foreign import ccall safe "timer.h time_delta_to_sec" + c_time_delta_to_sec :: TimeDelta -> Double -foreign import ccall unsafe "Timer.h timer_is_running" - c_timer_is_running :: Ptr Timer -> IO (CChar) +foreign import ccall safe "timer.h sec_to_time_delta" + c_sec_to_time_delta :: Double -> TimeDelta -foreign import ccall "Timer.h timer_sleep" - c_timer_sleep :: CFloat -> IO () +foreign import ccall safe "timer.h time_point_to_ns" + c_time_point_to_ns :: Ptr TimePoint -> Word64 --- | Construct a new timer. -newTimer :: Timer -newTimer = unsafePerformIO . unsafeInterleaveIO . alloca $ \tptr -> do - c_timer_init tptr - peek tptr +foreign import ccall "timer.h time_sleep" + c_time_sleep :: TimeDelta -> IO () --- | Update the timer. -tick :: Timer -> IO (Timer) -tick t = alloca $ \tptr -> do - poke tptr t - c_timer_tick tptr - peek tptr + +withTimer c_func timer = alloca $ \ptr -> do + poke ptr timer + c_func ptr + + +withTimer' c_func timer = alloca $ \ptr -> do + poke ptr timer + c_func ptr + peek ptr + +-- | Construct a new timer. +newTimer :: IO Timer +newTimer = alloca $ \ptr -> do + c_timer_make ptr + peek ptr -- | Start the timer. -start :: Timer -> IO (Timer) -start t = alloca $ \tptr -> do - poke tptr t - c_timer_start tptr - t' <- peek tptr - return t' - --- | Stop the timer. -stop :: Timer -> IO (Timer) -stop t = alloca $ \tptr -> do - poke tptr t - c_timer_stop tptr - peek tptr - --- | Reset the timer. -reset :: Timer -> IO (Timer) -reset t = alloca $ \tptr -> do - poke tptr t - c_timer_reset tptr - peek tptr - --- | Get the timer's total running time. -getTime :: Timer -> Double -getTime t = unsafeDupablePerformIO . alloca $ \tptr -> do - poke tptr t - time <- c_timer_get_time tptr - return (realToFrac time) - --- | Get the time elapsed between the last two ticks. -getDelta :: Timer -> Float -getDelta t = unsafeDupablePerformIO . alloca $ \tptr -> do - poke tptr t - dt <- c_timer_get_delta tptr - return (realToFrac dt) - --- | Return true if the timer is running (not stopped), false otherwise. -isRunning :: Timer -> Bool -isRunning t = unsafeDupablePerformIO . alloca $ \tptr -> do - poke tptr t - running <- c_timer_is_running tptr - return (running /= 0) - --- | Put the caller thread to sleep for the given number of seconds. -sleep :: Float -> IO () -sleep = c_timer_sleep . realToFrac +start :: Timer -> IO () +start = withTimer c_timer_start + +-- | Update the timer. +tick :: Timer -> IO Timer +tick = withTimer' c_timer_tick + +-- | Get the current time. +now :: IO TimePoint +now = alloca $ \ptr -> do + c_time_now ptr + peek ptr + +-- | Get the time delta between two timepoints. +timeDiff :: TimePoint -> TimePoint -> TimeDelta +timeDiff t1 t2 = unsafeDupablePerformIO $ + alloca $ \ptr1 -> + alloca $ \ptr2 -> do + poke ptr1 t1 + poke ptr2 t2 + return $ c_time_diff ptr1 ptr2 + +-- | Get the time elapsed in seconds. +timeDeltaToSec :: TimeDelta -> Double +timeDeltaToSec = c_time_delta_to_sec + +-- | Convert the time elapsed in seconds to a time delta. +timeSecToDelta :: Double -> TimeDelta +timeSecToDelta = c_sec_to_time_delta + +-- | Convert the time point to nanoseconds. +timePointToNs :: TimePoint -> Word64 +timePointToNs t = unsafeDupablePerformIO $ alloca $ \ptr -> do + poke ptr t + return $ c_time_point_to_ns ptr + +-- | Put the caller thread to sleep for the given amount of time. +sleep :: TimeDelta -> IO () +sleep = c_time_sleep diff --git a/Spear/Sys/Timer/Timer.h b/Spear/Sys/Timer/Timer.h deleted file mode 100644 index 308509c..0000000 --- a/Spear/Sys/Timer/Timer.h +++ /dev/null @@ -1,130 +0,0 @@ -#pragma once - -#ifdef WIN32 -#ifdef _MSC_VER -typedef __int64 timeReading; -#else -typedef __UINT64_TYPE__ timeReading; -#endif -#else -typedef __UINT64_TYPE__ timeReading; -#endif - -#ifdef __cplusplus -extern "C" { -#endif - -/* - Header: Timer - A high resolution timer module. -*/ - -/* - Struct: Timer -*/ -typedef struct -{ - timeReading baseTime; // The instant since we start timing. - timeReading stopTime; // The instant the timer is stopped. - timeReading prevTime; // The instant the timer was ticked prior to the last tick. - timeReading curTime; // The instant the timer was last ticked. - timeReading pausedTime; // Amount of time the timer has been stopped for. - float deltaTime; // Amount of time elapsed since the last call to tick. - char stopped; -} Timer; - -/* - Function: timer_init - Construct a new timer. - - The timer is initialised by making a call to reset(). Since time - calculations are measured from the instant the timer is reset (base time), - you probably want to make a manual call to reset() at the start of - your application, otherwise the application will be measuring times - from the instant the timer's constructor is called, which can be error prone. - - A call to start() must be made prior to any time calculations, as the - timer is initialised as stopped. -*/ -void timer_init (Timer*); - -/* - Function: timer_tick - Update the timer's values. - - This function updates the timer's running time and caches the time - elapsed since the last tick or since the start if this is the first - tick after the last call to start(). - - This function has no effect on a stopped ticker. -*/ -void timer_tick (Timer*); - -/* - Function: timer_start - Start the timer. - - This function starts the timer for the first time or resumes it - after a call to stop(). - - Note that this function does not reset the timer's base time; - it's only a mechanism to resume a stopped timer. -*/ -void timer_start (Timer*); - -/* - Function: timer_stop - Stop the timer. - - This function essentially freezes time; any values dependent on - the timer will behave as if time had not passed since the moment - the timer was stopped. - - To resume the timer call start(). -*/ -void timer_stop (Timer*); - -/* - Function: timer_reset - Reset the timer. - - This function resets all of the timer's values such as running and - stop times and sets the timer to stopped. The total running time is - then measured from the instant the timer is reset, making the timer - behave as a newly constructed one. - - A call to start() must be made prior to any further time calculations. -*/ -void timer_reset (Timer*); - -/* - Function: timer_get_time - Get the total running time. - - The amount of time the timer has been stopped for is not taken - into account. -*/ -double timer_get_time (const Timer*); - -/* - Function: timer_get_delta - Get the time elapsed since the last tick, or since the start if - this is the first tick. -*/ -float timer_get_delta (const Timer*); - -/* - Function: timer_is_running - Return true if the timer is running (not stopped), false otherwise. -*/ -char timer_is_running (const Timer*); - -/* - Function: timer_sleep - Put the caller thread to sleep for the given number of seconds. -*/ -void timer_sleep (float seconds); - -#ifdef __cplusplus -} -#endif diff --git a/Spear/Sys/Timer/ctimer.c b/Spear/Sys/Timer/ctimer.c deleted file mode 100644 index 8c059c0..0000000 --- a/Spear/Sys/Timer/ctimer.c +++ /dev/null @@ -1,157 +0,0 @@ -#include "Timer.h" -#include - -#ifdef __APPLE__ - #include -#elif WIN32 - #define WIN32_LEAN_AND_MEAN - #include -#else // Linux - #include - const double NSEC_TO_SEC = 1.0 / 1000000000.0; - const double SEC_TO_NSECd = 1000000000.0; - const timeReading SEC_TO_NSEC = 1000000000; -#endif - -static double secondsPerCount; - -static void timer_initialise_subsystem () -{ -#ifdef WIN32 - __int64 countsPerSec; - QueryPerformanceFrequency((LARGE_INTEGER*)&countsPerSec); - secondsPerCount = 1.0 / (double)countsPerSec; -#else - struct timespec ts; - clock_getres(CLOCK_REALTIME, &ts); - secondsPerCount = (double)ts.tv_sec + ((double)ts.tv_nsec * NSEC_TO_SEC); -#endif -} - -static timeReading now () -{ - timeReading t; -#ifdef __APPLE__ - t = mach_absolute_time(); -#elif WIN32 - QueryPerformanceCounter((LARGE_INTEGER*)&t); -#else - struct timespec ts; - clock_gettime(CLOCK_REALTIME, &ts); - t = ts.tv_sec*SEC_TO_NSEC + ts.tv_nsec; -#endif - return t; -} - -void timer_init (Timer* timer) -{ - timer_initialise_subsystem(); - timer_reset (timer); -} - -void timer_tick (Timer* timer) -{ - if (timer->stopped) - { - timer->deltaTime = 0.0; - return; - } - - //Get the time on this frame. - timer->curTime = now(); - - //Time delta between the current frame and the previous. - timer->deltaTime = (float) ((timer->curTime - timer->prevTime) * secondsPerCount); - - //Update for next frame. - timer->prevTime = timer->curTime; - - // Force nonnegative. The DXSDK's CDXUTTimer mentions that if the - // processor goes into a power save mode or we get shuffled to - // another processor, then the delta time can be negative. - if(timer->deltaTime < 0.0f) - { - timer->deltaTime = 0.0f; - } -} - -void timer_reset (Timer* timer) -{ - timeReading n = now(); - timer->baseTime = n; - timer->stopTime = n; - timer->prevTime = n; - timer->curTime = n; - timer->pausedTime = 0; - timer->deltaTime = 0.0f; - timer->stopped = 1; -} - -void timer_stop (Timer* timer) -{ - // Don't do anything if we are already stopped. - if (!timer->stopped) - { - // Grab the stop time. - timer->stopTime = now(); - - // Now we are stopped. - timer->stopped = 1; - } -} - -void timer_start (Timer* timer) -{ - // Only start if we are stopped. - if (timer->stopped) - { - timeReading startTime = now(); - - // Accumulate the paused time. - timer->pausedTime = timer->pausedTime + startTime - timer->stopTime; - - // Make the previous time valid. - timer->prevTime = startTime; - - //Now we are running. - timer->stopTime = 0; - timer->stopped = 0; - } -} - -double timer_get_time (const Timer* timer) -{ - // If we are stopped, we do not count the time we have been stopped for. - if (timer->stopped) - { - return (double)((timer->stopTime - timer->baseTime) * secondsPerCount); - } - // Otherwise return the time elapsed since the start but without - // taking into account the time we have been stopped for. - else - { - return (double)((timer->curTime - timer->baseTime - timer->pausedTime) * secondsPerCount); - } -} - -float timer_get_delta (const Timer* timer) -{ - return timer->deltaTime; -} - -char timer_is_running (const Timer* timer) -{ - return !timer->stopped; -} - -void timer_sleep (float seconds) -{ -#ifdef WIN32 - Sleep((DWORD)(seconds * 1000)); -#else - struct timespec ts; - ts.tv_sec = (int) seconds; - ts.tv_nsec = (long) ((double)(seconds - (int)seconds) * SEC_TO_NSECd); - nanosleep(&ts, NULL); -#endif -} diff --git a/Spear/Sys/Timer/timer.c b/Spear/Sys/Timer/timer.c new file mode 100644 index 0000000..8487f48 --- /dev/null +++ b/Spear/Sys/Timer/timer.c @@ -0,0 +1,101 @@ +#include "timer.h" + +#include +#ifdef _WIN32 +#define WIN32_LEAN_AND_MEAN +#include +#endif + +#ifdef _WIN32 +static const int64_t microseconds = 1000000; +#endif +static const int64_t nanoseconds = 1000000000; + +#ifdef _WIN32 +static double seconds_per_count; +#endif + +static void timer_initialise() { +#ifdef _WIN32 + __int64 counts_per_sec; + QueryPerformanceFrequency((LARGE_INTEGER*)&counts_per_sec); + seconds_per_count = 1.0 / (double)counts_per_sec; +#endif +} + +void timer_make(Timer* timer) { + timer_initialise(); + *timer = (Timer){0}; + timer_start(timer); +} + +void timer_start(Timer* timer) { + time_now(&timer->start_time); + timer->last_tick = timer->start_time; + timer->running_time = 0; + timer->delta_time = 0; +} + +void timer_tick(Timer* timer) { + time_point this_tick; + time_now(&this_tick); + timer->running_time = time_diff(&timer->start_time, &this_tick); + timer->delta_time = time_diff(&timer->last_tick, &this_tick); + timer->last_tick = this_tick; +} + +void time_now(time_point* t) { +#ifdef _WIN32 + QueryPerformanceCounter((LARGE_INTEGER*)t); +#else + clock_gettime(CLOCK_REALTIME, t); +#endif +} + +time_delta time_diff(time_point* start, time_point* end) { +#ifdef _WIN32 + // Force nonnegative. The DXSDK's CDXUTTimer mentions that if the + // processor goes into a power save mode or we get shuffled to + // another processor, then the delta time can be negative. + return std::max(0, *end - *start); +#else + return (end->tv_sec - start->tv_sec) * 1e9 + (end->tv_nsec - start->tv_nsec); +#endif +} + +double time_delta_to_sec(time_delta dt) { +#ifdef _WIN32 + return (double)dt * seconds_per_count; +#else + return (double)dt * 1.0e-9; +#endif +} + +time_delta sec_to_time_delta(double seconds) { +#ifdef _WIN32 + return (time_delta)(seconds / seconds_per_count); +#else + return (time_delta)(seconds * 1.0e9); +#endif +} + +uint64_t time_point_to_ns(time_point* t) { +#ifdef _WIN32 + return (uint64_t)((double)*t * seconds_per_count * 1.0e+9); +#else + return (uint64_t)t->tv_sec * 1e+9 + (uint64_t)t->tv_nsec; +#endif +} + +void time_sleep(time_delta dt) { +#ifdef _WIN32 + const int64_t ms = dt / microseconds; + Sleep((DWORD)(ms)); +#else + const int64_t sec = dt / nanoseconds; + struct timespec ts; + ts.tv_sec = (long)sec; + ts.tv_nsec = (long)(dt % nanoseconds); + nanosleep(&ts, NULL); +#endif +} diff --git a/Spear/Sys/Timer/timer.h b/Spear/Sys/Timer/timer.h new file mode 100644 index 0000000..e426135 --- /dev/null +++ b/Spear/Sys/Timer/timer.h @@ -0,0 +1,64 @@ +#pragma once + +#include + +/// A particular point in time. +#ifdef _WIN32 +typedef uint64_t time_point; +#else +// Need to macro to make CLOCK_REALTIME available when compiling with ISO C11. +// The constant is only needed in the source file, but the header file needs to +// include time.h too. +#ifndef __USE_POSIX199309 +#define __USE_POSIX199309 +#endif // +#include +typedef struct timespec time_point; +#endif + +/// Time elapsed between two time points. +typedef uint64_t time_delta; + +/// A high resolution timer. +typedef struct Timer { + time_point start_time; // The instant the timer was last started. + time_point last_tick; // The instant the timer was last ticked. + time_delta running_time; // Time elapsed since the timer was last started. + time_delta delta_time; // Time elapsed since the last tick. +} Timer; + +/// Construct a new timer. +void timer_make(Timer*); + +/// Start the timer. +/// This sets the time point from which time deltas are measured. +/// Calling this multilple times resets the timer. +void timer_start(Timer*); + +/// Update the timer's running and delta times. +void timer_tick(Timer*); + +/// Get the current time. +void time_now(time_point*); + +/// Return the time elapsed between two timestamps. +time_delta time_diff(time_point* start, time_point* end); + +/// Return the time elapsed in seconds. +double time_delta_to_sec(time_delta dt); + +/// Convert the time elapsed in seconds to a time delta. +time_delta sec_to_time_delta(double seconds); + +/// Convert the time point to nanoseconds. +uint64_t time_point_to_ns(time_point*); + +/// Put the caller thread to sleep for the given amount of time. +void time_sleep(time_delta dt); + +/// The time point 0. +#ifdef _WIN32 +static const time_point time_zero = 0; +#else +static const time_point time_zero = {0, 0}; +#endif diff --git a/Spear/Window.hs b/Spear/Window.hs index 336910b..b130f5c 100644 --- a/Spear/Window.hs +++ b/Spear/Window.hs @@ -9,10 +9,13 @@ module Spear.Window Width, Height, Init, + WindowEvent(..), + Events(..), withWindow, pollEvents, shouldWindowClose, swapBuffers, + getWindowSize, -- * Input whenKeyDown, @@ -48,8 +51,6 @@ type Context = (Int, Int) type WindowTitle = String -type CloseRequest = MVar Bool - -- | Game initialiser. type Init s = Window -> Game () s @@ -58,11 +59,28 @@ newtype WindowException = WindowException String deriving (Show) instance Exception WindowException +data WindowEvent + = ResizeEvent Width Height + +data InputEvent + = KeyDown Key + | KeyUp Key + | MouseDown MouseButton + | MouseUp MouseButton + | MouseMove MousePos MouseDelta + deriving (Eq, Show) + +data Events = Events + { inputEvents :: [InputEvent] + , windowEvents :: [WindowEvent] + } + -- | A window. data Window = Window - { glfwWindow :: GLFW.Window, - closeRequest :: CloseRequest, - inputEvents :: MVar [InputEvent] + { glfwWindow :: GLFW.Window + , closeRequestMVar :: MVar Bool + , inputEventsMVar :: MVar [InputEvent] + , windowEventsMVar :: MVar [WindowEvent] } withWindow :: @@ -93,58 +111,71 @@ setup :: IO Window setup (w, h) (major, minor) windowTitle = do closeRequest <- newEmptyMVar - inputEvents <- newEmptyMVar - let onResize' = onResize inputEvents - let title = fromMaybe "" windowTitle - let monitor = Nothing + windowEvents <- newEmptyMVar + inputEvents <- newEmptyMVar + mousePos <- newEmptyMVar -- To compute deltas between mouse positions. + maybeWindow <- do GLFW.windowHint $ GLFW.WindowHint'ContextVersionMajor major GLFW.windowHint $ GLFW.WindowHint'ContextVersionMinor minor when (major >= 3) $ GLFW.windowHint $ GLFW.WindowHint'OpenGLProfile GLFW.OpenGLProfile'Compat - GLFW.createWindow w h title monitor Nothing + GLFW.createWindow w h (fromMaybe "Spear" windowTitle) Nothing Nothing + unless (isJust maybeWindow) $ throwIO (WindowException "GLFW.openWindow failed") let window = fromJust maybeWindow + GLFW.setWindowCloseCallback window . Just $ onWindowClose closeRequest - GLFW.setWindowSizeCallback window . Just $ onResize' - GLFW.setKeyCallback window . Just $ onKey inputEvents - GLFW.setCharCallback window . Just $ onChar inputEvents + GLFW.setWindowSizeCallback window . Just $ onResize windowEvents + GLFW.setKeyCallback window . Just $ onKey inputEvents + GLFW.setCharCallback window . Just $ onChar inputEvents GLFW.setMouseButtonCallback window . Just $ onMouseButton inputEvents - onMouseMove inputEvents >>= GLFW.setCursorPosCallback window . Just - onResize' window w h - return $ Spear.Window.Window window closeRequest inputEvents + GLFW.setCursorPosCallback window . Just $ onMouseMove mousePos inputEvents + + return $ Window window closeRequest inputEvents windowEvents -- | Poll the window's events. -pollEvents :: Window -> IO [InputEvent] +pollEvents :: Window -> IO Events pollEvents window = do GLFW.pollEvents - events <- - tryTakeMVar (inputEvents window) >>= \xs -> case xs of - Nothing -> return [] - Just events -> return events - putMVar (inputEvents window) [] - return events + inputEvents <- getEvents (inputEventsMVar window) + windowEvents <- getEvents (windowEventsMVar window) + return (Events inputEvents windowEvents) + +getEvents :: MVar [a] -> IO [a] +getEvents mvar = tryTakeMVar mvar >>= \xs -> do + putMVar mvar [] -- Clear the events. + case xs of + Nothing -> return [] + Just events -> return events -- | Return true when the user requests to close the window. shouldWindowClose :: Window -> IO Bool -shouldWindowClose = getRequest . closeRequest +shouldWindowClose = getRequest . closeRequestMVar -- | Swaps buffers. swapBuffers :: Window -> IO () swapBuffers = GLFW.swapBuffers . glfwWindow +-- | Get the window's size. +getWindowSize :: Window -> IO (Width, Height) +getWindowSize = GLFW.getWindowSize . glfwWindow + getRequest :: MVar Bool -> IO Bool getRequest mvar = tryTakeMVar mvar >>= \x -> return $ fromMaybe False x onWindowClose :: MVar Bool -> GLFW.WindowCloseCallback -onWindowClose closeRequest window = do putMVar closeRequest True +onWindowClose closeRequest window = putMVar closeRequest True -onResize :: MVar [InputEvent] -> GLFW.WindowSizeCallback -onResize events window w h = addEvent events $ Resize w h +-- Since the only WindowEvent right now is ResizeEvent, and all ResizeEvents but +-- the last in a poll can be ignored, we just replace the contents of the mvar +-- here instead of adding the event to the list. +onResize :: MVar [WindowEvent] -> GLFW.WindowSizeCallback +onResize windowEvents window w h = putMVar windowEvents [ResizeEvent w h] onKey :: MVar [InputEvent] -> GLFW.KeyCallback -onKey events window key _ GLFW.KeyState'Pressed _ = addEvent events $ KeyDown (fromGLFWkey key) -onKey events window key _ GLFW.KeyState'Released _ = addEvent events $ KeyUp (fromGLFWkey key) +onKey events window key _ GLFW.KeyState'Pressed _ = addEvent events $ KeyDown (fromGLFWkey key) +onKey events window key _ GLFW.KeyState'Released _ = addEvent events $ KeyUp (fromGLFWkey key) onKey events window key _ GLFW.KeyState'Repeating _ = return () onChar :: MVar [InputEvent] -> GLFW.CharCallback @@ -154,11 +185,8 @@ onMouseButton :: MVar [InputEvent] -> GLFW.MouseButtonCallback onMouseButton events window button GLFW.MouseButtonState'Pressed _ = addEvent events $ MouseDown (fromGLFWbutton button) onMouseButton events window button GLFW.MouseButtonState'Released _ = addEvent events $ MouseUp (fromGLFWbutton button) -onMouseMove :: MVar [InputEvent] -> IO GLFW.CursorPosCallback -onMouseMove events = newEmptyMVar <&> flip onMouseMove' events - -onMouseMove' :: MVar MousePos -> MVar [InputEvent] -> GLFW.CursorPosCallback -onMouseMove' oldPos events window x y = do +onMouseMove :: MVar MousePos -> MVar [InputEvent] -> GLFW.CursorPosCallback +onMouseMove oldPos events window x y = do (old_x, old_y) <- tryTakeMVar oldPos >>= \old -> case old of Nothing -> return (x, y) @@ -215,15 +243,6 @@ processButtons window = foldM f [] button return $ if isDown then result : acc else acc -data InputEvent - = Resize Width Height - | KeyDown Key - | KeyUp Key - | MouseDown MouseButton - | MouseUp MouseButton - | MouseMove MousePos MouseDelta - deriving (Eq, Show) - data Key = KEY_A | KEY_B -- cgit v1.2.3