diff options
| -rw-r--r-- | Demos/Pong/Main.hs | 2 | ||||
| -rw-r--r-- | Spear/App.hs | 66 | ||||
| -rw-r--r-- | Spear/Window.hs | 2 |
3 files changed, 44 insertions, 26 deletions
diff --git a/Demos/Pong/Main.hs b/Demos/Pong/Main.hs index 21fcb0c..d51a324 100644 --- a/Demos/Pong/Main.hs +++ b/Demos/Pong/Main.hs | |||
| @@ -26,7 +26,7 @@ data GameState = GameState | |||
| 26 | , world :: [GameObject] | 26 | , world :: [GameObject] |
| 27 | } | 27 | } |
| 28 | 28 | ||
| 29 | app = App step render resize | 29 | app = App defaultAppOptions step render resize |
| 30 | 30 | ||
| 31 | main = | 31 | main = |
| 32 | withWindow (1920, 1200) (Just "Pong") initGame endGame $ | 32 | withWindow (1920, 1200) (Just "Pong") initGame endGame $ |
diff --git a/Spear/App.hs b/Spear/App.hs index 96d45f1..bc4886c 100644 --- a/Spear/App.hs +++ b/Spear/App.hs | |||
| @@ -3,6 +3,7 @@ module Spear.App | |||
| 3 | Elapsed, | 3 | Elapsed, |
| 4 | Dt, | 4 | Dt, |
| 5 | Step, | 5 | Step, |
| 6 | defaultAppOptions, | ||
| 6 | loop, | 7 | loop, |
| 7 | ) | 8 | ) |
| 8 | where | 9 | where |
| @@ -14,8 +15,6 @@ import Spear.Game | |||
| 14 | import Spear.Sys.Timer as Timer | 15 | import Spear.Sys.Timer as Timer |
| 15 | import Spear.Window | 16 | import Spear.Window |
| 16 | 17 | ||
| 17 | maxFPS = 60 | ||
| 18 | |||
| 19 | -- | Time elapsed. | 18 | -- | Time elapsed. |
| 20 | type Elapsed = Double | 19 | type Elapsed = Double |
| 21 | 20 | ||
| @@ -25,9 +24,21 @@ type Dt = Double | |||
| 25 | -- | Return true if the application should continue running, false otherwise. | 24 | -- | Return true if the application should continue running, false otherwise. |
| 26 | type Step s = Elapsed -> Dt -> [InputEvent] -> Game s Bool | 25 | type Step s = Elapsed -> Dt -> [InputEvent] -> Game s Bool |
| 27 | 26 | ||
| 28 | -- | Application functions. | 27 | -- | Application options. |
| 28 | data AppOptions = AppOptions | ||
| 29 | { maxFPS :: Int | ||
| 30 | , enableProfiling :: Bool | ||
| 31 | } | ||
| 32 | |||
| 33 | defaultAppOptions = AppOptions | ||
| 34 | { maxFPS = 60 | ||
| 35 | , enableProfiling = False | ||
| 36 | } | ||
| 37 | |||
| 38 | -- | Application state. | ||
| 29 | data App s = App | 39 | data App s = App |
| 30 | { stepApp :: Step s | 40 | { options :: AppOptions |
| 41 | , stepApp :: Step s | ||
| 31 | , renderApp :: Game s () | 42 | , renderApp :: Game s () |
| 32 | , resizeApp :: WindowEvent -> Game s () | 43 | , resizeApp :: WindowEvent -> Game s () |
| 33 | } | 44 | } |
| @@ -41,50 +52,57 @@ loop app window = do | |||
| 41 | resizeApp app (ResizeEvent width height) | 52 | resizeApp app (ResizeEvent width height) |
| 42 | renderApp app | 53 | renderApp app |
| 43 | 54 | ||
| 44 | let ddt = secToTimeDelta $ 1.0 / fromIntegral maxFPS -- Desired delta time. | 55 | -- Desired delta time. |
| 56 | let fps = maxFPS . options $ app | ||
| 57 | let ddt = if fps > 0 then secToTimeDelta (1.0 / fromIntegral fps) else 0 | ||
| 45 | timer <- gameIO newTimer | 58 | timer <- gameIO newTimer |
| 46 | gameIO $ Timer.start timer | 59 | gameIO $ Timer.start timer |
| 47 | loop' window ddt timer 0 0 app | 60 | loop' window ddt 0 timer app |
| 48 | 61 | ||
| 49 | loop' :: | 62 | loop' :: |
| 50 | Window -> | 63 | Window -> |
| 51 | TimeDelta -> -- Desired frame delta time. | 64 | TimeDelta -> -- Desired frame delta time. |
| 52 | Timer -> | ||
| 53 | TimeDelta -> -- Total elapsed app time. | ||
| 54 | TimeDelta -> -- Time budget. | 65 | TimeDelta -> -- Time budget. |
| 66 | Timer -> | ||
| 55 | App s -> | 67 | App s -> |
| 56 | Game s () | 68 | Game s () |
| 57 | loop' window ddt inputTimer elapsed timeBudget app = do | 69 | loop' window ddt timeBudget inputTimer app = do |
| 58 | timer <- gameIO $ tick inputTimer | 70 | timer <- gameIO $ tick inputTimer |
| 59 | inputEvents <- gameIO $ pollInputEvents window | ||
| 60 | windowEvents <- gameIO $ pollWindowEvents window | 71 | windowEvents <- gameIO $ pollWindowEvents window |
| 61 | close <- gameIO $ shouldWindowClose window | 72 | close <- gameIO $ shouldWindowClose window |
| 62 | 73 | ||
| 74 | -- Fixed time step animation. | ||
| 75 | let elapsed = runningTime timer | ||
| 76 | let dt = timeDeltaToSec ddt | ||
| 63 | let timeBudgetThisFrame = timeBudget + deltaTime timer | 77 | let timeBudgetThisFrame = timeBudget + deltaTime timer |
| 78 | let timeBudgetNextFrame = timeBudgetThisFrame `mod` ddt | ||
| 64 | let steps = timeBudgetThisFrame `div` ddt | 79 | let steps = timeBudgetThisFrame `div` ddt |
| 65 | 80 | ||
| 66 | --gameIO . putStrLn $ "Steps: " ++ show steps | ||
| 67 | |||
| 68 | continue <- and <$> forM [1..steps] (\i -> do | 81 | continue <- and <$> forM [1..steps] (\i -> do |
| 69 | let t = timeDeltaToSec $ elapsed + i * ddt | 82 | inputEvents <- gameIO $ pollInputEvents window |
| 70 | let dt = timeDeltaToSec ddt | 83 | let t = timeDeltaToSec $ elapsed + i * ddt |
| 71 | stepApp app t dt inputEvents) | 84 | stepApp app t dt inputEvents) |
| 72 | 85 | ||
| 73 | let elapsedNextFrame = elapsed + steps * ddt | 86 | -- Variable time step game animation. |
| 74 | let timeBudgetNextFrame = timeBudgetThisFrame `mod` ddt | 87 | {-let t = timeDeltaToSec $ runningTime timer |
| 88 | let dt = timeDeltaToSec $ deltaTime timer | ||
| 89 | continue <- stepApp app t dt inputEvents-} | ||
| 75 | 90 | ||
| 76 | when (continue && not close) $ do | 91 | -- Process window events. |
| 77 | resized <- or <$> forM windowEvents (\event -> case event of | 92 | resized <- or <$> forM windowEvents (\event -> case event of |
| 78 | ResizeEvent {} -> resizeApp app event >> return True) | 93 | ResizeEvent {} -> resizeApp app event >> return True) |
| 79 | 94 | ||
| 80 | -- For smoother resizing, render only while not resizing. | 95 | -- For smoother resizing, render only while not resizing. |
| 81 | unless resized $ do | 96 | unless resized $ do |
| 82 | renderApp app | 97 | renderApp app |
| 83 | gameIO $ swapBuffers window | 98 | gameIO $ swapBuffers window |
| 84 | 99 | ||
| 100 | -- Limit frame rate if so requested by the application. | ||
| 101 | when ((maxFPS . options $ app) > 0) $ do | ||
| 85 | frameEnd <- gameIO now | 102 | frameEnd <- gameIO now |
| 86 | let frameTime = timeDiff (lastTick timer) frameEnd | 103 | let frameTime = timeDiff (lastTick timer) frameEnd |
| 87 | when (frameTime < ddt) $ do | 104 | when (frameTime < ddt) $ do |
| 88 | gameIO $ Timer.sleep (ddt - frameTime) | 105 | gameIO $ Timer.sleep (ddt - frameTime) |
| 89 | 106 | ||
| 90 | loop' window ddt timer elapsedNextFrame timeBudgetNextFrame app | 107 | when (continue && not close) $ do |
| 108 | loop' window ddt timeBudgetNextFrame timer app | ||
diff --git a/Spear/Window.hs b/Spear/Window.hs index be52080..caddc5d 100644 --- a/Spear/Window.hs +++ b/Spear/Window.hs | |||
| @@ -127,7 +127,7 @@ setup (w, h) windowTitle = do | |||
| 127 | 127 | ||
| 128 | GLFW.makeContextCurrent maybeWindow | 128 | GLFW.makeContextCurrent maybeWindow |
| 129 | 129 | ||
| 130 | GLFW.swapInterval 1 -- Enable vsync. | 130 | GLFW.swapInterval 0 -- 1 enable vsync. -1 for adaptive vsync. |
| 131 | 131 | ||
| 132 | GLFW.setWindowCloseCallback window . Just $ onWindowClose closeRequest | 132 | GLFW.setWindowCloseCallback window . Just $ onWindowClose closeRequest |
| 133 | GLFW.setWindowSizeCallback window . Just $ onResize windowEvents | 133 | GLFW.setWindowSizeCallback window . Just $ onResize windowEvents |
