aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Demos/Pong/Main.hs22
-rw-r--r--Spear.cabal19
-rw-r--r--Spear/App.hs92
-rw-r--r--Spear/Sys/Timer.hsc255
-rw-r--r--Spear/Sys/Timer/Timer.h130
-rw-r--r--Spear/Sys/Timer/ctimer.c157
-rw-r--r--Spear/Sys/Timer/timer.c101
-rw-r--r--Spear/Sys/Timer/timer.h64
-rw-r--r--Spear/Window.hs105
9 files changed, 450 insertions, 495 deletions
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
18 world :: [GameObject] 18 world :: [GameObject]
19 } 19 }
20 20
21app = App step render resize
22
21main = 23main =
22 withWindow (900, 600) (2, 0) (Just "Pong") initGame $ 24 withWindow (900, 600) (2, 0) (Just "Pong") initGame $
23 loop step 25 loop app
24 26
25initGame :: Window -> Game () GameState 27initGame :: Window -> Game () GameState
26initGame window = return $ GameState window newWorld 28initGame window = return $ GameState window newWorld
@@ -28,16 +30,18 @@ initGame window = return $ GameState window newWorld
28step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool 30step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool
29step elapsed dt inputEvents = do 31step elapsed dt inputEvents = do
30 gs <- getGameState 32 gs <- getGameState
31 gameIO . process $ inputEvents
32 let events = translateEvents inputEvents 33 let events = translateEvents inputEvents
33 modifyGameState $ \gs -> 34 modifyGameState $ \gs ->
34 gs 35 gs
35 { world = stepWorld (realToFrac elapsed) dt events (world gs) 36 { world = stepWorld (realToFrac elapsed) (realToFrac dt) events (world gs)
36 } 37 }
37 getGameState >>= \gs -> gameIO . render $ world gs
38 return (not $ exitRequested inputEvents) 38 return (not $ exitRequested inputEvents)
39 39
40render world = do 40render :: Game GameState ()
41render = getGameState >>= \gs -> gameIO . render' $ world gs
42
43render' :: [GameObject] -> IO ()
44render' world = do
41 -- Clear the background to a different colour than the playable area to make 45 -- Clear the background to a different colour than the playable area to make
42 -- the latter distinguishable. 46 -- the latter distinguishable.
43 GL.clearColor $= GL.Color4 0.2 0.2 0.2 0.0 47 GL.clearColor $= GL.Color4 0.2 0.2 0.2 0.0
@@ -74,22 +78,20 @@ renderGO go = do
74 GL.vertex (GL.Vertex2 xmax ymax) 78 GL.vertex (GL.Vertex2 xmax ymax)
75 GL.vertex (GL.Vertex2 xmax ymin) 79 GL.vertex (GL.Vertex2 xmax ymin)
76 80
77process = mapM_ procEvent 81resize :: WindowEvent -> Game s ()
78 82resize (ResizeEvent w h) =
79procEvent (Resize w h) =
80 let r = fromIntegral w / fromIntegral h 83 let r = fromIntegral w / fromIntegral h
81 pad = if r > 1 then (r-1) / 2 else (1/r - 1) / 2 84 pad = if r > 1 then (r-1) / 2 else (1/r - 1) / 2
82 left = if r > 1 then -pad else 0 85 left = if r > 1 then -pad else 0
83 right = if r > 1 then 1 + pad else 1 86 right = if r > 1 then 1 + pad else 1
84 bottom = if r > 1 then 0 else -pad 87 bottom = if r > 1 then 0 else -pad
85 top = if r > 1 then 1 else 1 + pad 88 top = if r > 1 then 1 else 1 + pad
86 in do 89 in gameIO $ do
87 GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h)) 90 GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h))
88 GL.matrixMode $= GL.Projection 91 GL.matrixMode $= GL.Projection
89 GL.loadIdentity 92 GL.loadIdentity
90 GL.ortho left right bottom top (-1) 1 93 GL.ortho left right bottom top (-1) 1
91 GL.matrixMode $= GL.Modelview 0 94 GL.matrixMode $= GL.Modelview 0
92procEvent _ = return ()
93 95
94translateEvents = mapMaybe translateEvents' 96translateEvents = mapMaybe translateEvents'
95 where translateEvents' (KeyDown KEY_LEFT) = Just MoveLeft 97 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
83 83
84 cc-options: -O2 -g -Wno-unused-result 84 cc-options: -O2 -g -Wno-unused-result
85 85
86 c-sources: Spear/Assets/Image/Image.c 86 c-sources:
87 Spear/Assets/Image/BMP/BMP_load.c 87 Spear/Assets/Image/Image.c
88 Spear/Assets/Model/Model.c 88 Spear/Assets/Image/BMP/BMP_load.c
89 Spear/Assets/Model/MD2/MD2_load.c 89 Spear/Assets/Model/Model.c
90 Spear/Assets/Model/OBJ/cvector.c 90 Spear/Assets/Model/MD2/MD2_load.c
91 Spear/Assets/Model/OBJ/OBJ_load.c 91 Spear/Assets/Model/OBJ/cvector.c
92 Spear/Render/RenderModel.c 92 Spear/Assets/Model/OBJ/OBJ_load.c
93 Spear/Sys/Timer/ctimer.c 93 Spear/Render/RenderModel.c
94 Spear/Sys/Timer/timer.c
94 95
95 includes: 96 includes:
96 Spear/Assets/Image/BMP/BMP_load.h 97 Spear/Assets/Image/BMP/BMP_load.h
@@ -104,7 +105,7 @@ library
104 Spear/Assets/Model/Model_error_code.h 105 Spear/Assets/Model/Model_error_code.h
105 Spear/Assets/Model/sys_types.h 106 Spear/Assets/Model/sys_types.h
106 Spear/Render/RenderModel.h 107 Spear/Render/RenderModel.h
107 Timer/Timer.h 108 Timer/timer.h
108 109
109 include-dirs: 110 include-dirs:
110 . 111 .
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 @@
1module Spear.App 1module Spear.App
2 ( Elapsed, 2 ( App(..),
3 Elapsed,
3 Dt, 4 Dt,
4 Step, 5 Step,
5 loop, 6 loop,
@@ -7,6 +8,7 @@ module Spear.App
7where 8where
8 9
9import Control.Monad 10import Control.Monad
11import Data.Fixed (mod')
10import GHC.Float 12import GHC.Float
11import Spear.Game 13import Spear.Game
12import Spear.Sys.Timer as Timer 14import Spear.Sys.Timer as Timer
@@ -14,49 +16,77 @@ import Spear.Window
14 16
15maxFPS = 60 17maxFPS = 60
16 18
17-- | Time elapsed since the application started. 19-- | Time elapsed.
18type Elapsed = Double 20type Elapsed = Double
19 21
20-- | Time elapsed since the last frame. 22-- | Time elapsed since the last frame.
21type Dt = Float 23type Dt = Double
22 24
23-- | Return true if the application should continue running, false otherwise. 25-- | Return true if the application should continue running, false otherwise.
24type Step s = Elapsed -> Dt -> [InputEvent] -> Game s Bool 26type Step s = Elapsed -> Dt -> [InputEvent] -> Game s Bool
25 27
28-- | Application functions.
29data App s = App
30 { stepApp :: Step s
31 , renderApp :: Game s ()
32 , resizeApp :: WindowEvent -> Game s ()
33 }
34
26-- | Enter the main application loop. 35-- | Enter the main application loop.
27loop :: Step s -> Window -> Game s () 36loop :: App s -> Window -> Game s ()
28loop step window = do 37loop app window = do
38 -- For convenience, trigger an initial resize followed by a render of the
39 -- application's initial state.
40 (width, height) <- gameIO $ getWindowSize window
41 resizeApp app (ResizeEvent width height)
42 renderApp app
43
29 let ddt = 1.0 / fromIntegral maxFPS -- Desired delta time. 44 let ddt = 1.0 / fromIntegral maxFPS -- Desired delta time.
30 frameTimer <- gameIO $ start newTimer 45 timer <- gameIO newTimer
31 controlTimer <- gameIO $ start newTimer 46 gameIO $ Timer.start timer
32 loop' window ddt frameTimer controlTimer 0 step 47 loop' window ddt timer 0 0 app
33 return ()
34 48
35loop' :: 49loop' ::
36 Window -> 50 Window ->
37 Dt -> 51 Dt ->
38 Timer -> 52 Timer ->
39 Timer ->
40 Elapsed -> 53 Elapsed ->
41 Step s -> 54 Double -> -- Time budget.
55 App s ->
42 Game s () 56 Game s ()
43loop' window ddt frameTimer controlTimer elapsed step = do 57loop' window ddt inputTimer elapsed timeBudget app = do
44 controlTimer' <- gameIO $ tick controlTimer 58 timer <- gameIO $ tick inputTimer
45 frameTimer' <- gameIO $ tick frameTimer 59
46 let dt = getDelta frameTimer' 60 (Events inputEvents windowEvents) <- gameIO $ pollEvents window
47 let elapsed' = elapsed + float2Double dt 61
48 inputEvents <- gameIO $ pollEvents window 62 let timeBudgetThisFrame = timeBudget + timeDeltaToSec (deltaTime timer)
49 continue <- step elapsed' dt inputEvents 63
50 gameIO $ swapBuffers window 64 let steps = floor (timeBudgetThisFrame / ddt)
51 close <- gameIO $ shouldWindowClose window 65 continue <- and <$> forM [1..steps] (\i ->
52 controlTimer'' <- gameIO $ tick controlTimer' 66 stepApp app (elapsed + fromIntegral i * ddt) ddt inputEvents)
53 let dt = getDelta controlTimer'' 67
54 when (dt < ddt) $ gameIO $ Timer.sleep (ddt - dt) 68 let elapsed' = elapsed + fromIntegral steps * ddt
55 when (continue && not close) $ 69 let timeBudget' = timeBudgetThisFrame `mod'` ddt
56 loop' 70
57 window 71 when continue $ do
58 ddt 72 forM_ windowEvents $ \event -> case event of
59 frameTimer' 73 ResizeEvent {} -> resizeApp app event
60 controlTimer'' 74 renderApp app
61 elapsed' 75 gameIO $ swapBuffers window
62 step 76
77 -- TODO: Conversion of TimeDelta to/from double should be unnecessary here.
78 -- We ideally need ddt expressed in TimeDelta.
79 frameEnd <- gameIO now
80 let frameTime = timeDeltaToSec $ timeDiff (lastTick timer) frameEnd
81 when (frameTime < ddt) $ do
82 gameIO $ Timer.sleep (timeSecToDelta (ddt - frameTime))
83
84 close <- gameIO $ shouldWindowClose window
85 when (continue && not close) $
86 loop'
87 window
88 ddt
89 timer
90 elapsed'
91 timeBudget'
92 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 @@
1{-# LANGUAGE CPP, ForeignFunctionInterface #-} 1{-# LANGUAGE CPP #-}
2{-# LANGUAGE ForeignFunctionInterface #-}
3
2module Spear.Sys.Timer 4module Spear.Sys.Timer
3( 5(
4 Timer 6 Timer(..)
5, newTimer 7, newTimer
6, tick
7, start 8, start
8, stop 9, tick
9, reset 10, now
10, getTime 11, timeDiff
11, getDelta 12, timeDeltaToSec
12, isRunning 13, timeSecToDelta
14, timePointToNs
13, sleep 15, sleep
14) 16)
15where 17where
16 18
19import Data.Word
17import Foreign.C.Types 20import Foreign.C.Types
18import Foreign.Marshal.Alloc (alloca) 21import Foreign.Marshal.Alloc (alloca)
19import Foreign.Ptr 22import Foreign.Ptr
@@ -21,130 +24,152 @@ import Foreign.Storable
21import Control.Monad 24import Control.Monad
22import System.IO.Unsafe 25import System.IO.Unsafe
23 26
27#include "Timer/timer.h"
28
29
24#ifdef WIN32 30#ifdef WIN32
25type TimeReading = CULLong 31type TimePoint = Word64
26#else 32#else
27type TimeReading = CDouble 33{-
34struct timespec {
35 time_t tv_sec; /* seconds */
36 long tv_nsec; /* nanoseconds */
37};
38-}
39data TimeSpec = TimeSpec {
40 tvSec :: {-# UNPACK #-} !CTime,
41 tvNsec :: {-# UNPACK #-} !CLong
42}
43type TimePoint = TimeSpec
28#endif 44#endif
29 45
46type TimeDelta = Word64
47
30data Timer = Timer 48data Timer = Timer
31 { getBaseTime :: TimeReading 49 { startTime :: {-# UNPACK #-} !TimePoint
32 , getPausedTime :: TimeReading 50 , lastTick :: {-# UNPACK #-} !TimePoint
33 , getStopTime :: TimeReading 51 , runningTime :: {-# UNPACK #-} !TimeDelta
34 , getPrevTime :: TimeReading 52 , deltaTime :: {-# UNPACK #-} !TimeDelta
35 , getCurTime :: TimeReading 53 }
36 , getDeltaTime :: CFloat 54
37 , getRunning :: CChar 55
38 } 56#ifndef WIN32
57instance Storable TimeSpec where
58 sizeOf _ = #{size struct timespec}
59 alignment _ = #{alignment struct timespec}
60
61 peek ptr = do
62 tvSec <- #{peek struct timespec, tv_sec} ptr
63 tvNsec <- #{peek struct timespec, tv_nsec} ptr
64 return $ TimeSpec tvSec tvNsec
65
66 poke ptr (TimeSpec tvSec tvNsec) = do
67 #{poke struct timespec, tv_sec} ptr tvSec
68 #{poke struct timespec, tv_nsec} ptr tvNsec
69#endif
39 70
40#include "Timer/Timer.h"
41 71
42instance Storable Timer where 72instance Storable Timer where
43 sizeOf _ = #{size Timer} 73 --sizeOf _ = #{size Timer}
44 alignment _ = alignment (undefined :: TimeReading) 74 sizeOf _ = #{size struct Timer}
45 75 --alignment _ = alignment (undefined :: Timer)
46 peek ptr = do 76 alignment _ = #{alignment struct Timer}
47 baseTime <- #{peek Timer, baseTime} ptr 77
48 pausedTime <- #{peek Timer, pausedTime} ptr 78 peek ptr = do
49 stopTime <- #{peek Timer, stopTime} ptr 79 startTime <- #{peek struct Timer, start_time} ptr
50 prevTime <- #{peek Timer, prevTime} ptr 80 lastTick <- #{peek struct Timer, last_tick} ptr
51 curTime <- #{peek Timer, curTime} ptr 81 runningTime <- #{peek struct Timer, running_time} ptr
52 deltaTime <- #{peek Timer, deltaTime} ptr 82 deltaTime <- #{peek struct Timer, delta_time} ptr
53 stopped <- #{peek Timer, stopped} ptr 83 return $ Timer startTime lastTick runningTime deltaTime
54 return $ Timer baseTime pausedTime stopTime prevTime curTime deltaTime stopped 84
55 85 poke ptr (Timer startTime lastTick runningTime deltaTime) = do
56 poke ptr (Timer baseTime pausedTime stopTime prevTime curTime deltaTime stopped) = do 86 #{poke struct Timer, start_time} ptr startTime
57 #{poke Timer, baseTime} ptr baseTime 87 #{poke struct Timer, last_tick} ptr lastTick
58 #{poke Timer, pausedTime} ptr pausedTime 88 #{poke struct Timer, running_time} ptr runningTime
59 #{poke Timer, stopTime} ptr stopTime 89 #{poke struct Timer, delta_time} ptr deltaTime
60 #{poke Timer, prevTime} ptr prevTime
61 #{poke Timer, curTime} ptr curTime
62 #{poke Timer, deltaTime} ptr deltaTime
63 #{poke Timer, stopped} ptr stopped
64
65foreign import ccall unsafe "Timer.h timer_init"
66 c_timer_init :: Ptr Timer -> IO ()
67
68foreign import ccall unsafe "Timer.h timer_tick"
69 c_timer_tick :: Ptr Timer -> IO ()
70 90
71foreign import ccall unsafe "Timer.h timer_start" 91
92foreign import ccall unsafe "timer.h timer_make"
93 c_timer_make :: Ptr Timer -> IO ()
94
95foreign import ccall unsafe "timer.h timer_start"
72 c_timer_start :: Ptr Timer -> IO () 96 c_timer_start :: Ptr Timer -> IO ()
73 97
74foreign import ccall unsafe "Timer.h timer_stop" 98foreign import ccall unsafe "timer.h timer_tick"
75 c_timer_stop :: Ptr Timer -> IO () 99 c_timer_tick :: Ptr Timer -> IO ()
76 100
77foreign import ccall unsafe "Timer.h timer_reset" 101foreign import ccall unsafe "timer.h time_now"
78 c_timer_reset :: Ptr Timer -> IO () 102 c_time_now :: Ptr TimePoint -> IO ()
79 103
80foreign import ccall unsafe "Timer.h timer_get_time" 104foreign import ccall safe "timer.h time_diff"
81 c_timer_get_time :: Ptr Timer -> IO (CDouble) 105 c_time_diff :: Ptr TimePoint -> Ptr TimePoint -> TimeDelta
82 106
83foreign import ccall unsafe "Timer.h timer_get_delta" 107foreign import ccall safe "timer.h time_delta_to_sec"
84 c_timer_get_delta :: Ptr Timer -> IO (CFloat) 108 c_time_delta_to_sec :: TimeDelta -> Double
85 109
86foreign import ccall unsafe "Timer.h timer_is_running" 110foreign import ccall safe "timer.h sec_to_time_delta"
87 c_timer_is_running :: Ptr Timer -> IO (CChar) 111 c_sec_to_time_delta :: Double -> TimeDelta
88 112
89foreign import ccall "Timer.h timer_sleep" 113foreign import ccall safe "timer.h time_point_to_ns"
90 c_timer_sleep :: CFloat -> IO () 114 c_time_point_to_ns :: Ptr TimePoint -> Word64
91 115
92-- | Construct a new timer. 116foreign import ccall "timer.h time_sleep"
93newTimer :: Timer 117 c_time_sleep :: TimeDelta -> IO ()
94newTimer = unsafePerformIO . unsafeInterleaveIO . alloca $ \tptr -> do
95 c_timer_init tptr
96 peek tptr
97 118
98-- | Update the timer. 119
99tick :: Timer -> IO (Timer) 120withTimer c_func timer = alloca $ \ptr -> do
100tick t = alloca $ \tptr -> do 121 poke ptr timer
101 poke tptr t 122 c_func ptr
102 c_timer_tick tptr 123
103 peek tptr 124
125withTimer' c_func timer = alloca $ \ptr -> do
126 poke ptr timer
127 c_func ptr
128 peek ptr
129
130-- | Construct a new timer.
131newTimer :: IO Timer
132newTimer = alloca $ \ptr -> do
133 c_timer_make ptr
134 peek ptr
104 135
105-- | Start the timer. 136-- | Start the timer.
106start :: Timer -> IO (Timer) 137start :: Timer -> IO ()
107start t = alloca $ \tptr -> do 138start = withTimer c_timer_start
108 poke tptr t 139
109 c_timer_start tptr 140-- | Update the timer.
110 t' <- peek tptr 141tick :: Timer -> IO Timer
111 return t' 142tick = withTimer' c_timer_tick
112 143
113-- | Stop the timer. 144-- | Get the current time.
114stop :: Timer -> IO (Timer) 145now :: IO TimePoint
115stop t = alloca $ \tptr -> do 146now = alloca $ \ptr -> do
116 poke tptr t 147 c_time_now ptr
117 c_timer_stop tptr 148 peek ptr
118 peek tptr 149
119 150-- | Get the time delta between two timepoints.
120-- | Reset the timer. 151timeDiff :: TimePoint -> TimePoint -> TimeDelta
121reset :: Timer -> IO (Timer) 152timeDiff t1 t2 = unsafeDupablePerformIO $
122reset t = alloca $ \tptr -> do 153 alloca $ \ptr1 ->
123 poke tptr t 154 alloca $ \ptr2 -> do
124 c_timer_reset tptr 155 poke ptr1 t1
125 peek tptr 156 poke ptr2 t2
126 157 return $ c_time_diff ptr1 ptr2
127-- | Get the timer's total running time. 158
128getTime :: Timer -> Double 159-- | Get the time elapsed in seconds.
129getTime t = unsafeDupablePerformIO . alloca $ \tptr -> do 160timeDeltaToSec :: TimeDelta -> Double
130 poke tptr t 161timeDeltaToSec = c_time_delta_to_sec
131 time <- c_timer_get_time tptr 162
132 return (realToFrac time) 163-- | Convert the time elapsed in seconds to a time delta.
133 164timeSecToDelta :: Double -> TimeDelta
134-- | Get the time elapsed between the last two ticks. 165timeSecToDelta = c_sec_to_time_delta
135getDelta :: Timer -> Float 166
136getDelta t = unsafeDupablePerformIO . alloca $ \tptr -> do 167-- | Convert the time point to nanoseconds.
137 poke tptr t 168timePointToNs :: TimePoint -> Word64
138 dt <- c_timer_get_delta tptr 169timePointToNs t = unsafeDupablePerformIO $ alloca $ \ptr -> do
139 return (realToFrac dt) 170 poke ptr t
140 171 return $ c_time_point_to_ns ptr
141-- | Return true if the timer is running (not stopped), false otherwise. 172
142isRunning :: Timer -> Bool 173-- | Put the caller thread to sleep for the given amount of time.
143isRunning t = unsafeDupablePerformIO . alloca $ \tptr -> do 174sleep :: TimeDelta -> IO ()
144 poke tptr t 175sleep = c_time_sleep
145 running <- c_timer_is_running tptr
146 return (running /= 0)
147
148-- | Put the caller thread to sleep for the given number of seconds.
149sleep :: Float -> IO ()
150sleep = c_timer_sleep . realToFrac
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 @@
1#pragma once
2
3#ifdef WIN32
4#ifdef _MSC_VER
5typedef __int64 timeReading;
6#else
7typedef __UINT64_TYPE__ timeReading;
8#endif
9#else
10typedef __UINT64_TYPE__ timeReading;
11#endif
12
13#ifdef __cplusplus
14extern "C" {
15#endif
16
17/*
18 Header: Timer
19 A high resolution timer module.
20*/
21
22/*
23 Struct: Timer
24*/
25typedef struct
26{
27 timeReading baseTime; // The instant since we start timing.
28 timeReading stopTime; // The instant the timer is stopped.
29 timeReading prevTime; // The instant the timer was ticked prior to the last tick.
30 timeReading curTime; // The instant the timer was last ticked.
31 timeReading pausedTime; // Amount of time the timer has been stopped for.
32 float deltaTime; // Amount of time elapsed since the last call to tick.
33 char stopped;
34} Timer;
35
36/*
37 Function: timer_init
38 Construct a new timer.
39
40 The timer is initialised by making a call to reset(). Since time
41 calculations are measured from the instant the timer is reset (base time),
42 you probably want to make a manual call to reset() at the start of
43 your application, otherwise the application will be measuring times
44 from the instant the timer's constructor is called, which can be error prone.
45
46 A call to start() must be made prior to any time calculations, as the
47 timer is initialised as stopped.
48*/
49void timer_init (Timer*);
50
51/*
52 Function: timer_tick
53 Update the timer's values.
54
55 This function updates the timer's running time and caches the time
56 elapsed since the last tick or since the start if this is the first
57 tick after the last call to start().
58
59 This function has no effect on a stopped ticker.
60*/
61void timer_tick (Timer*);
62
63/*
64 Function: timer_start
65 Start the timer.
66
67 This function starts the timer for the first time or resumes it
68 after a call to stop().
69
70 Note that this function does not reset the timer's base time;
71 it's only a mechanism to resume a stopped timer.
72*/
73void timer_start (Timer*);
74
75/*
76 Function: timer_stop
77 Stop the timer.
78
79 This function essentially freezes time; any values dependent on
80 the timer will behave as if time had not passed since the moment
81 the timer was stopped.
82
83 To resume the timer call start().
84*/
85void timer_stop (Timer*);
86
87/*
88 Function: timer_reset
89 Reset the timer.
90
91 This function resets all of the timer's values such as running and
92 stop times and sets the timer to stopped. The total running time is
93 then measured from the instant the timer is reset, making the timer
94 behave as a newly constructed one.
95
96 A call to start() must be made prior to any further time calculations.
97*/
98void timer_reset (Timer*);
99
100/*
101 Function: timer_get_time
102 Get the total running time.
103
104 The amount of time the timer has been stopped for is not taken
105 into account.
106*/
107double timer_get_time (const Timer*);
108
109/*
110 Function: timer_get_delta
111 Get the time elapsed since the last tick, or since the start if
112 this is the first tick.
113*/
114float timer_get_delta (const Timer*);
115
116/*
117 Function: timer_is_running
118 Return true if the timer is running (not stopped), false otherwise.
119*/
120char timer_is_running (const Timer*);
121
122/*
123 Function: timer_sleep
124 Put the caller thread to sleep for the given number of seconds.
125*/
126void timer_sleep (float seconds);
127
128#ifdef __cplusplus
129}
130#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 @@
1#include "Timer.h"
2#include <stdlib.h>
3
4#ifdef __APPLE__
5 #include <mach/mach_time.h>
6#elif WIN32
7 #define WIN32_LEAN_AND_MEAN
8 #include <Windows.h>
9#else // Linux
10 #include <time.h>
11 const double NSEC_TO_SEC = 1.0 / 1000000000.0;
12 const double SEC_TO_NSECd = 1000000000.0;
13 const timeReading SEC_TO_NSEC = 1000000000;
14#endif
15
16static double secondsPerCount;
17
18static void timer_initialise_subsystem ()
19{
20#ifdef WIN32
21 __int64 countsPerSec;
22 QueryPerformanceFrequency((LARGE_INTEGER*)&countsPerSec);
23 secondsPerCount = 1.0 / (double)countsPerSec;
24#else
25 struct timespec ts;
26 clock_getres(CLOCK_REALTIME, &ts);
27 secondsPerCount = (double)ts.tv_sec + ((double)ts.tv_nsec * NSEC_TO_SEC);
28#endif
29}
30
31static timeReading now ()
32{
33 timeReading t;
34#ifdef __APPLE__
35 t = mach_absolute_time();
36#elif WIN32
37 QueryPerformanceCounter((LARGE_INTEGER*)&t);
38#else
39 struct timespec ts;
40 clock_gettime(CLOCK_REALTIME, &ts);
41 t = ts.tv_sec*SEC_TO_NSEC + ts.tv_nsec;
42#endif
43 return t;
44}
45
46void timer_init (Timer* timer)
47{
48 timer_initialise_subsystem();
49 timer_reset (timer);
50}
51
52void timer_tick (Timer* timer)
53{
54 if (timer->stopped)
55 {
56 timer->deltaTime = 0.0;
57 return;
58 }
59
60 //Get the time on this frame.
61 timer->curTime = now();
62
63 //Time delta between the current frame and the previous.
64 timer->deltaTime = (float) ((timer->curTime - timer->prevTime) * secondsPerCount);
65
66 //Update for next frame.
67 timer->prevTime = timer->curTime;
68
69 // Force nonnegative. The DXSDK's CDXUTTimer mentions that if the
70 // processor goes into a power save mode or we get shuffled to
71 // another processor, then the delta time can be negative.
72 if(timer->deltaTime < 0.0f)
73 {
74 timer->deltaTime = 0.0f;
75 }
76}
77
78void timer_reset (Timer* timer)
79{
80 timeReading n = now();
81 timer->baseTime = n;
82 timer->stopTime = n;
83 timer->prevTime = n;
84 timer->curTime = n;
85 timer->pausedTime = 0;
86 timer->deltaTime = 0.0f;
87 timer->stopped = 1;
88}
89
90void timer_stop (Timer* timer)
91{
92 // Don't do anything if we are already stopped.
93 if (!timer->stopped)
94 {
95 // Grab the stop time.
96 timer->stopTime = now();
97
98 // Now we are stopped.
99 timer->stopped = 1;
100 }
101}
102
103void timer_start (Timer* timer)
104{
105 // Only start if we are stopped.
106 if (timer->stopped)
107 {
108 timeReading startTime = now();
109
110 // Accumulate the paused time.
111 timer->pausedTime = timer->pausedTime + startTime - timer->stopTime;
112
113 // Make the previous time valid.
114 timer->prevTime = startTime;
115
116 //Now we are running.
117 timer->stopTime = 0;
118 timer->stopped = 0;
119 }
120}
121
122double timer_get_time (const Timer* timer)
123{
124 // If we are stopped, we do not count the time we have been stopped for.
125 if (timer->stopped)
126 {
127 return (double)((timer->stopTime - timer->baseTime) * secondsPerCount);
128 }
129 // Otherwise return the time elapsed since the start but without
130 // taking into account the time we have been stopped for.
131 else
132 {
133 return (double)((timer->curTime - timer->baseTime - timer->pausedTime) * secondsPerCount);
134 }
135}
136
137float timer_get_delta (const Timer* timer)
138{
139 return timer->deltaTime;
140}
141
142char timer_is_running (const Timer* timer)
143{
144 return !timer->stopped;
145}
146
147void timer_sleep (float seconds)
148{
149#ifdef WIN32
150 Sleep((DWORD)(seconds * 1000));
151#else
152 struct timespec ts;
153 ts.tv_sec = (int) seconds;
154 ts.tv_nsec = (long) ((double)(seconds - (int)seconds) * SEC_TO_NSECd);
155 nanosleep(&ts, NULL);
156#endif
157}
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 @@
1#include "timer.h"
2
3#include <stdlib.h>
4#ifdef _WIN32
5#define WIN32_LEAN_AND_MEAN
6#include <Windows.h>
7#endif
8
9#ifdef _WIN32
10static const int64_t microseconds = 1000000;
11#endif
12static const int64_t nanoseconds = 1000000000;
13
14#ifdef _WIN32
15static double seconds_per_count;
16#endif
17
18static void timer_initialise() {
19#ifdef _WIN32
20 __int64 counts_per_sec;
21 QueryPerformanceFrequency((LARGE_INTEGER*)&counts_per_sec);
22 seconds_per_count = 1.0 / (double)counts_per_sec;
23#endif
24}
25
26void timer_make(Timer* timer) {
27 timer_initialise();
28 *timer = (Timer){0};
29 timer_start(timer);
30}
31
32void timer_start(Timer* timer) {
33 time_now(&timer->start_time);
34 timer->last_tick = timer->start_time;
35 timer->running_time = 0;
36 timer->delta_time = 0;
37}
38
39void timer_tick(Timer* timer) {
40 time_point this_tick;
41 time_now(&this_tick);
42 timer->running_time = time_diff(&timer->start_time, &this_tick);
43 timer->delta_time = time_diff(&timer->last_tick, &this_tick);
44 timer->last_tick = this_tick;
45}
46
47void time_now(time_point* t) {
48#ifdef _WIN32
49 QueryPerformanceCounter((LARGE_INTEGER*)t);
50#else
51 clock_gettime(CLOCK_REALTIME, t);
52#endif
53}
54
55time_delta time_diff(time_point* start, time_point* end) {
56#ifdef _WIN32
57 // Force nonnegative. The DXSDK's CDXUTTimer mentions that if the
58 // processor goes into a power save mode or we get shuffled to
59 // another processor, then the delta time can be negative.
60 return std::max(0, *end - *start);
61#else
62 return (end->tv_sec - start->tv_sec) * 1e9 + (end->tv_nsec - start->tv_nsec);
63#endif
64}
65
66double time_delta_to_sec(time_delta dt) {
67#ifdef _WIN32
68 return (double)dt * seconds_per_count;
69#else
70 return (double)dt * 1.0e-9;
71#endif
72}
73
74time_delta sec_to_time_delta(double seconds) {
75#ifdef _WIN32
76 return (time_delta)(seconds / seconds_per_count);
77#else
78 return (time_delta)(seconds * 1.0e9);
79#endif
80}
81
82uint64_t time_point_to_ns(time_point* t) {
83#ifdef _WIN32
84 return (uint64_t)((double)*t * seconds_per_count * 1.0e+9);
85#else
86 return (uint64_t)t->tv_sec * 1e+9 + (uint64_t)t->tv_nsec;
87#endif
88}
89
90void time_sleep(time_delta dt) {
91#ifdef _WIN32
92 const int64_t ms = dt / microseconds;
93 Sleep((DWORD)(ms));
94#else
95 const int64_t sec = dt / nanoseconds;
96 struct timespec ts;
97 ts.tv_sec = (long)sec;
98 ts.tv_nsec = (long)(dt % nanoseconds);
99 nanosleep(&ts, NULL);
100#endif
101}
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 @@
1#pragma once
2
3#include <stdint.h>
4
5/// A particular point in time.
6#ifdef _WIN32
7typedef uint64_t time_point;
8#else
9// Need to macro to make CLOCK_REALTIME available when compiling with ISO C11.
10// The constant is only needed in the source file, but the header file needs to
11// include time.h too.
12#ifndef __USE_POSIX199309
13#define __USE_POSIX199309
14#endif //
15#include <time.h>
16typedef struct timespec time_point;
17#endif
18
19/// Time elapsed between two time points.
20typedef uint64_t time_delta;
21
22/// A high resolution timer.
23typedef struct Timer {
24 time_point start_time; // The instant the timer was last started.
25 time_point last_tick; // The instant the timer was last ticked.
26 time_delta running_time; // Time elapsed since the timer was last started.
27 time_delta delta_time; // Time elapsed since the last tick.
28} Timer;
29
30/// Construct a new timer.
31void timer_make(Timer*);
32
33/// Start the timer.
34/// This sets the time point from which time deltas are measured.
35/// Calling this multilple times resets the timer.
36void timer_start(Timer*);
37
38/// Update the timer's running and delta times.
39void timer_tick(Timer*);
40
41/// Get the current time.
42void time_now(time_point*);
43
44/// Return the time elapsed between two timestamps.
45time_delta time_diff(time_point* start, time_point* end);
46
47/// Return the time elapsed in seconds.
48double time_delta_to_sec(time_delta dt);
49
50/// Convert the time elapsed in seconds to a time delta.
51time_delta sec_to_time_delta(double seconds);
52
53/// Convert the time point to nanoseconds.
54uint64_t time_point_to_ns(time_point*);
55
56/// Put the caller thread to sleep for the given amount of time.
57void time_sleep(time_delta dt);
58
59/// The time point 0.
60#ifdef _WIN32
61static const time_point time_zero = 0;
62#else
63static const time_point time_zero = {0, 0};
64#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
9 Width, 9 Width,
10 Height, 10 Height,
11 Init, 11 Init,
12 WindowEvent(..),
13 Events(..),
12 withWindow, 14 withWindow,
13 pollEvents, 15 pollEvents,
14 shouldWindowClose, 16 shouldWindowClose,
15 swapBuffers, 17 swapBuffers,
18 getWindowSize,
16 19
17 -- * Input 20 -- * Input
18 whenKeyDown, 21 whenKeyDown,
@@ -48,8 +51,6 @@ type Context = (Int, Int)
48 51
49type WindowTitle = String 52type WindowTitle = String
50 53
51type CloseRequest = MVar Bool
52
53-- | Game initialiser. 54-- | Game initialiser.
54type Init s = Window -> Game () s 55type Init s = Window -> Game () s
55 56
@@ -58,11 +59,28 @@ newtype WindowException = WindowException String deriving (Show)
58 59
59instance Exception WindowException 60instance Exception WindowException
60 61
62data WindowEvent
63 = ResizeEvent Width Height
64
65data InputEvent
66 = KeyDown Key
67 | KeyUp Key
68 | MouseDown MouseButton
69 | MouseUp MouseButton
70 | MouseMove MousePos MouseDelta
71 deriving (Eq, Show)
72
73data Events = Events
74 { inputEvents :: [InputEvent]
75 , windowEvents :: [WindowEvent]
76 }
77
61-- | A window. 78-- | A window.
62data Window = Window 79data Window = Window
63 { glfwWindow :: GLFW.Window, 80 { glfwWindow :: GLFW.Window
64 closeRequest :: CloseRequest, 81 , closeRequestMVar :: MVar Bool
65 inputEvents :: MVar [InputEvent] 82 , inputEventsMVar :: MVar [InputEvent]
83 , windowEventsMVar :: MVar [WindowEvent]
66 } 84 }
67 85
68withWindow :: 86withWindow ::
@@ -93,58 +111,71 @@ setup ::
93 IO Window 111 IO Window
94setup (w, h) (major, minor) windowTitle = do 112setup (w, h) (major, minor) windowTitle = do
95 closeRequest <- newEmptyMVar 113 closeRequest <- newEmptyMVar
96 inputEvents <- newEmptyMVar 114 windowEvents <- newEmptyMVar
97 let onResize' = onResize inputEvents 115 inputEvents <- newEmptyMVar
98 let title = fromMaybe "" windowTitle 116 mousePos <- newEmptyMVar -- To compute deltas between mouse positions.
99 let monitor = Nothing 117
100 maybeWindow <- do 118 maybeWindow <- do
101 GLFW.windowHint $ GLFW.WindowHint'ContextVersionMajor major 119 GLFW.windowHint $ GLFW.WindowHint'ContextVersionMajor major
102 GLFW.windowHint $ GLFW.WindowHint'ContextVersionMinor minor 120 GLFW.windowHint $ GLFW.WindowHint'ContextVersionMinor minor
103 when (major >= 3) $ GLFW.windowHint $ GLFW.WindowHint'OpenGLProfile GLFW.OpenGLProfile'Compat 121 when (major >= 3) $ GLFW.windowHint $ GLFW.WindowHint'OpenGLProfile GLFW.OpenGLProfile'Compat
104 GLFW.createWindow w h title monitor Nothing 122 GLFW.createWindow w h (fromMaybe "Spear" windowTitle) Nothing Nothing
123
105 unless (isJust maybeWindow) $ throwIO (WindowException "GLFW.openWindow failed") 124 unless (isJust maybeWindow) $ throwIO (WindowException "GLFW.openWindow failed")
106 let window = fromJust maybeWindow 125 let window = fromJust maybeWindow
126
107 GLFW.setWindowCloseCallback window . Just $ onWindowClose closeRequest 127 GLFW.setWindowCloseCallback window . Just $ onWindowClose closeRequest
108 GLFW.setWindowSizeCallback window . Just $ onResize' 128 GLFW.setWindowSizeCallback window . Just $ onResize windowEvents
109 GLFW.setKeyCallback window . Just $ onKey inputEvents 129 GLFW.setKeyCallback window . Just $ onKey inputEvents
110 GLFW.setCharCallback window . Just $ onChar inputEvents 130 GLFW.setCharCallback window . Just $ onChar inputEvents
111 GLFW.setMouseButtonCallback window . Just $ onMouseButton inputEvents 131 GLFW.setMouseButtonCallback window . Just $ onMouseButton inputEvents
112 onMouseMove inputEvents >>= GLFW.setCursorPosCallback window . Just 132 GLFW.setCursorPosCallback window . Just $ onMouseMove mousePos inputEvents
113 onResize' window w h 133
114 return $ Spear.Window.Window window closeRequest inputEvents 134 return $ Window window closeRequest inputEvents windowEvents
115 135
116-- | Poll the window's events. 136-- | Poll the window's events.
117pollEvents :: Window -> IO [InputEvent] 137pollEvents :: Window -> IO Events
118pollEvents window = do 138pollEvents window = do
119 GLFW.pollEvents 139 GLFW.pollEvents
120 events <- 140 inputEvents <- getEvents (inputEventsMVar window)
121 tryTakeMVar (inputEvents window) >>= \xs -> case xs of 141 windowEvents <- getEvents (windowEventsMVar window)
122 Nothing -> return [] 142 return (Events inputEvents windowEvents)
123 Just events -> return events 143
124 putMVar (inputEvents window) [] 144getEvents :: MVar [a] -> IO [a]
125 return events 145getEvents mvar = tryTakeMVar mvar >>= \xs -> do
146 putMVar mvar [] -- Clear the events.
147 case xs of
148 Nothing -> return []
149 Just events -> return events
126 150
127-- | Return true when the user requests to close the window. 151-- | Return true when the user requests to close the window.
128shouldWindowClose :: Window -> IO Bool 152shouldWindowClose :: Window -> IO Bool
129shouldWindowClose = getRequest . closeRequest 153shouldWindowClose = getRequest . closeRequestMVar
130 154
131-- | Swaps buffers. 155-- | Swaps buffers.
132swapBuffers :: Window -> IO () 156swapBuffers :: Window -> IO ()
133swapBuffers = GLFW.swapBuffers . glfwWindow 157swapBuffers = GLFW.swapBuffers . glfwWindow
134 158
159-- | Get the window's size.
160getWindowSize :: Window -> IO (Width, Height)
161getWindowSize = GLFW.getWindowSize . glfwWindow
162
135getRequest :: MVar Bool -> IO Bool 163getRequest :: MVar Bool -> IO Bool
136getRequest mvar = 164getRequest mvar =
137 tryTakeMVar mvar >>= \x -> return $ fromMaybe False x 165 tryTakeMVar mvar >>= \x -> return $ fromMaybe False x
138 166
139onWindowClose :: MVar Bool -> GLFW.WindowCloseCallback 167onWindowClose :: MVar Bool -> GLFW.WindowCloseCallback
140onWindowClose closeRequest window = do putMVar closeRequest True 168onWindowClose closeRequest window = putMVar closeRequest True
141 169
142onResize :: MVar [InputEvent] -> GLFW.WindowSizeCallback 170-- Since the only WindowEvent right now is ResizeEvent, and all ResizeEvents but
143onResize events window w h = addEvent events $ Resize w h 171-- the last in a poll can be ignored, we just replace the contents of the mvar
172-- here instead of adding the event to the list.
173onResize :: MVar [WindowEvent] -> GLFW.WindowSizeCallback
174onResize windowEvents window w h = putMVar windowEvents [ResizeEvent w h]
144 175
145onKey :: MVar [InputEvent] -> GLFW.KeyCallback 176onKey :: MVar [InputEvent] -> GLFW.KeyCallback
146onKey events window key _ GLFW.KeyState'Pressed _ = addEvent events $ KeyDown (fromGLFWkey key) 177onKey events window key _ GLFW.KeyState'Pressed _ = addEvent events $ KeyDown (fromGLFWkey key)
147onKey events window key _ GLFW.KeyState'Released _ = addEvent events $ KeyUp (fromGLFWkey key) 178onKey events window key _ GLFW.KeyState'Released _ = addEvent events $ KeyUp (fromGLFWkey key)
148onKey events window key _ GLFW.KeyState'Repeating _ = return () 179onKey events window key _ GLFW.KeyState'Repeating _ = return ()
149 180
150onChar :: MVar [InputEvent] -> GLFW.CharCallback 181onChar :: MVar [InputEvent] -> GLFW.CharCallback
@@ -154,11 +185,8 @@ onMouseButton :: MVar [InputEvent] -> GLFW.MouseButtonCallback
154onMouseButton events window button GLFW.MouseButtonState'Pressed _ = addEvent events $ MouseDown (fromGLFWbutton button) 185onMouseButton events window button GLFW.MouseButtonState'Pressed _ = addEvent events $ MouseDown (fromGLFWbutton button)
155onMouseButton events window button GLFW.MouseButtonState'Released _ = addEvent events $ MouseUp (fromGLFWbutton button) 186onMouseButton events window button GLFW.MouseButtonState'Released _ = addEvent events $ MouseUp (fromGLFWbutton button)
156 187
157onMouseMove :: MVar [InputEvent] -> IO GLFW.CursorPosCallback 188onMouseMove :: MVar MousePos -> MVar [InputEvent] -> GLFW.CursorPosCallback
158onMouseMove events = newEmptyMVar <&> flip onMouseMove' events 189onMouseMove oldPos events window x y = do
159
160onMouseMove' :: MVar MousePos -> MVar [InputEvent] -> GLFW.CursorPosCallback
161onMouseMove' oldPos events window x y = do
162 (old_x, old_y) <- 190 (old_x, old_y) <-
163 tryTakeMVar oldPos >>= \old -> case old of 191 tryTakeMVar oldPos >>= \old -> case old of
164 Nothing -> return (x, y) 192 Nothing -> return (x, y)
@@ -215,15 +243,6 @@ processButtons window = foldM f []
215 button 243 button
216 return $ if isDown then result : acc else acc 244 return $ if isDown then result : acc else acc
217 245
218data InputEvent
219 = Resize Width Height
220 | KeyDown Key
221 | KeyUp Key
222 | MouseDown MouseButton
223 | MouseUp MouseButton
224 | MouseMove MousePos MouseDelta
225 deriving (Eq, Show)
226
227data Key 246data Key
228 = KEY_A 247 = KEY_A
229 | KEY_B 248 | KEY_B
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-01 06:33:43 +0000