78 lines
3.0 KiB
Haskell
78 lines
3.0 KiB
Haskell
--{-# LANGUAGE TupleSections #-}
|
|
{- |
|
|
Module : Loop
|
|
Description : Simple game loop
|
|
|
|
This module sets up an SDL window which may be updated using a simple game loop.
|
|
-}
|
|
module Loop
|
|
( setupLoop
|
|
) where
|
|
import qualified Data.Text as T
|
|
import Control.Concurrent
|
|
import Control.Exception
|
|
import Control.Monad
|
|
import System.Mem
|
|
import SDL
|
|
import qualified Graphics.Rendering.OpenGL as GL
|
|
-- | Create a game loop with an SDL window.
|
|
setupLoop
|
|
:: Int -- ^ Target seconds per frame
|
|
-> T.Text -- ^ Window title
|
|
-> WindowConfig
|
|
-> (world -> IO ()) -- ^ Function for cleaning up parameters, applied when exiting loop.
|
|
-> IO world -- ^ Initial simulation state.
|
|
-> (world -> IO world) -- ^ update, called once per frame. Allows for side effects such as rendering.
|
|
-> (world -> Event -> IO (Maybe world))
|
|
-- ^ SDL Event handling, once per frame. Evaluating 'Nothing' exits the loop.
|
|
-> IO ()
|
|
setupLoop spf title winconfig paramCleanup ioStartWorld sideEffects eventFn = do
|
|
initializeAll
|
|
bracket
|
|
(createWindow title winconfig)
|
|
destroyWindow
|
|
$ \window -> bracket
|
|
(glCreateContext window)
|
|
( \con -> GL.finish >> glDeleteContext con)
|
|
$ \_ -> bracket
|
|
ioStartWorld
|
|
paramCleanup
|
|
(doLoop spf window sideEffects eventFn)
|
|
-- | The internal loop.
|
|
doLoop
|
|
:: Int -- ^ target msec per frame
|
|
-> Window -- ^ The SDL window.
|
|
-> (world -> IO world) -- ^ simulation update.
|
|
-> (world -> Event -> IO (Maybe world)) -- ^ SDL Event handling.
|
|
-> world -- ^ Current simulation state.
|
|
-> IO ()
|
|
doLoop spf window worldSideEffects eventFn startWorld = do
|
|
startTicks <- ticks
|
|
worldAfterSimStep <- worldSideEffects startWorld
|
|
glSwapWindow window
|
|
maybeUpdatedWorld <- pollEvents >>= foldM (applyEventIO eventFn) (Just worldAfterSimStep)
|
|
case maybeUpdatedWorld of
|
|
Just updatedWorld -> do
|
|
performGC
|
|
endTicks <- ticks -- it might be better to use System.Clock (monotonic)
|
|
|
|
let theDelay = max 0 (spf + fromIntegral startTicks - fromIntegral endTicks)
|
|
threadDelay (theDelay * 1000 )
|
|
|
|
doLoop spf window worldSideEffects eventFn updatedWorld
|
|
Nothing -> return ()
|
|
|
|
-- | Handle quit events in a manner to exit the loop. Other events handled as
|
|
-- determined by the custom function, although resize events also change the viewport.
|
|
applyEventIO :: (world -> Event -> IO (Maybe world)) -> Maybe world -> Event -> IO (Maybe world)
|
|
applyEventIO fn mw e = case eventPayload e of
|
|
QuitEvent -> return Nothing
|
|
WindowClosedEvent _ -> return Nothing
|
|
WindowSizeChangedEvent WindowSizeChangedEventData {windowSizeChangedEventSize = V2 x y}
|
|
-> (GL.viewport $= (GL.Position 0 0,GL.Size x y)) >> mupdate
|
|
_ -> mupdate
|
|
where
|
|
mupdate = case mw of
|
|
Nothing -> return Nothing
|
|
Just w -> fn w e
|