Simplify the main loop, events only perform functional update

appDodge/Main.hs

@@ -41,7 +41,7 @@ main = do
         sizey = floor $ _windowY con
         posx = _windowPosX con
         posy = _windowPosY con
-    setupConLoop
+    setupConLoop'
         20
         (T.pack "Simple Game Loop")
         (winConfig sizex sizey (Just (posx, posy)))

src/Dodge/Concurrent.hs

@@ -25,6 +25,9 @@ conEffects u = case u ^? uvSideEffects . _head of
 addSideEffect :: IO (Universe -> Maybe Universe) -> String -> Universe -> Universe
 addSideEffect f s = uvSideEffects %~ (|> NewSideEffect f s)
 
+hardQuit :: Universe -> Universe
+hardQuit = addSideEffect (return $ const Nothing) "QUITTING"
+
 --tryConcEffect :: Bool -> String -> IO (Universe -> Maybe Universe) -> Universe -> Universe
 --tryConcEffect bl str eff u = case u ^. uvConcEffects of
 --    NoConcEffect -> u & uvConcEffects .~ NewConcEffect (ConcurrentEffect setstr (clearConcEff eff)) str bl

src/Dodge/Event.hs

@@ -15,46 +15,32 @@ module Dodge.Event (
     handleEvent,
 ) where
 
+import Dodge.Concurrent
 import LensHelp
 import Dodge.Data.Universe
-import Dodge.Event.Keyboard
+import Dodge.Event.Input
 import Dodge.PreloadData
 import SDL
 
-handleEvent :: Event -> Universe -> IO (Maybe Universe)
+handleEvent :: Event -> Universe -> Universe
-handleEvent e = case eventPayload e of
+handleEvent e u = case eventPayload e of
-    TextInputEvent tev -> return . Just . handleTextInput (textInputEventText tev)
+    TextInputEvent tev -> inputpoint (handleTextInput (textInputEventText tev)) u
-    KeyboardEvent kev -> return . Just . handleKeyboardEvent kev
+    KeyboardEvent kev -> inputpoint (handleKeyboardEvent kev) u
-    MouseMotionEvent mmev -> return . handleMouseMotionEvent mmev
+    MouseMotionEvent mmev -> inputpoint (handleMouseMotionEvent mmev cfig) u
-    MouseButtonEvent mbev -> return . Just . over uvWorld (handleMouseButtonEvent mbev)
+    MouseButtonEvent mbev -> inputpoint (handleMouseButtonEvent mbev) u
-    MouseWheelEvent mwev -> return . handleMouseWheelEvent mwev
+    MouseWheelEvent mwev -> inputpoint (handleMouseWheelEvent mwev) u
-    WindowSizeChangedEvent sev -> handleResizeEvent sev
+    WindowSizeChangedEvent sev -> handleResizeEvent sev u
-    WindowMovedEvent mev -> return . handleWindowMoveEvent mev
+    WindowMovedEvent mev -> handleWindowMoveEvent mev u
-    _ -> return . Just
+    QuitEvent -> hardQuit u
-
+    WindowClosedEvent _ -> hardQuit u
-handleMouseMotionEvent :: MouseMotionEventData -> Universe -> Maybe Universe
+    _ -> u
-handleMouseMotionEvent mmev u =
-    Just $
-        u & uvWorld . input . mousePos
-            .~ V2
-                (fromIntegral x - 0.5 * _windowX cfig)
-                (0.5 * _windowY cfig - fromIntegral y)
   where
+    inputpoint = over (uvWorld . input)
     cfig = _uvConfig u
-    P (V2 x y) = mouseMotionEventPos mmev
-
-handleMouseButtonEvent :: MouseButtonEventData -> World -> World
-handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of
-    Released -> input . mouseButtons . at thebutton .~ Nothing
-    Pressed -> input . mouseButtons . at thebutton ?~ False
-  where
-    thebutton = mouseButtonEventButton mbev
 
 -- | Sets window position in config.
-handleWindowMoveEvent :: WindowMovedEventData -> Universe -> Maybe Universe
+handleWindowMoveEvent :: WindowMovedEventData -> Universe -> Universe
-handleWindowMoveEvent mev =
+handleWindowMoveEvent mev = (uvConfig . windowPosX .~ fromIntegral x)
-    Just
-        . (uvConfig . windowPosX .~ fromIntegral x)
         . (uvConfig . windowPosY .~ fromIntegral y)
   where
     P (V2 x y) = windowMovedEventPosition mev
@@ -63,9 +49,8 @@ handleWindowMoveEvent mev =
 
 -- using a sideeffect here for the io change seems to work better, more testing
 -- later may be a good idea
-handleResizeEvent :: WindowSizeChangedEventData -> Universe -> IO (Maybe Universe)
+handleResizeEvent :: WindowSizeChangedEventData -> Universe -> Universe
 handleResizeEvent sev u =
-    return . Just $
         u
             & uvConfig . windowX .~ fromIntegral x
             & uvConfig . windowY .~ fromIntegral y
@@ -75,10 +60,3 @@ handleResizeEvent sev u =
     y = fromIntegral y'
     V2 x' y' = windowSizeChangedEventSize sev
     divRes = resFactorNum $ u ^. uvConfig . graphics_resolution_factor
-
-handleMouseWheelEvent :: MouseWheelEventData -> Universe -> Maybe Universe
-handleMouseWheelEvent mwev w = case _uvScreenLayers w of
-    [] -> case mouseWheelEventPos mwev of
-        V2 _ y -> Just $ w -- & uvWorld %~ wheelEvent (fromIntegral y)
-            & uvWorld . input . scrollAmount +~ fromIntegral y
-    _ -> Just w

src/Dodge/Event/Input.hs

@@ -0,0 +1,51 @@
+-- | Deals with events that only affect Input.
+module Dodge.Event.Input (
+    handleKeyboardEvent,
+    handleTextInput,
+    handleMouseMotionEvent,
+    handleMouseButtonEvent,
+    handleMouseWheelEvent,
+) where
+
+import qualified Data.Text as T
+import Dodge.Data.Input
+import Dodge.Data.Config
+import LensHelp
+import SDL
+
+-- annoyingly, the text input event doesn't register backspace, so deletion has to be
+-- dealt with separately
+handleTextInput :: T.Text -> Input -> Input
+handleTextInput text = textInput %~ (`T.append` text)
+
+{- | Handles keyboard press and release.
+-}
+handleKeyboardEvent :: KeyboardEventData -> Input -> Input
+handleKeyboardEvent kev = case keyboardEventKeyMotion kev of
+    Released -> pressedKeys . at scode .~ Nothing
+    Pressed -> pressedKeys . at scode ?~ val
+  where
+    val | keyboardEventRepeat kev = LongPress
+        | otherwise = InitialPress
+    scode = (keysymScancode . keyboardEventKeysym) kev
+
+handleMouseMotionEvent :: MouseMotionEventData -> Configuration -> Input -> Input
+handleMouseMotionEvent mmev cfig inp =
+        inp & mousePos
+            .~ V2
+                (fromIntegral x - 0.5 * _windowX cfig)
+                (0.5 * _windowY cfig - fromIntegral y)
+  where
+    P (V2 x y) = mouseMotionEventPos mmev
+
+handleMouseWheelEvent :: MouseWheelEventData -> Input -> Input
+handleMouseWheelEvent mwev = scrollAmount +~ fromIntegral y
+  where
+    V2 _ y = mouseWheelEventPos mwev
+
+handleMouseButtonEvent :: MouseButtonEventData -> Input -> Input
+handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of
+    Released -> mouseButtons . at thebutton .~ Nothing
+    Pressed -> mouseButtons . at thebutton ?~ False
+  where
+    thebutton = mouseButtonEventButton mbev

src/Dodge/Event/Keyboard.hs

@@ -1,86 +0,0 @@
--- | Deals with keyboard events.
-module Dodge.Event.Keyboard (
-    handleKeyboardEvent,
-    handleTextInput,
-    guardDisconnectedID,
-) where
-
---import Data.Maybe
---import Data.Text (unpack)
-import qualified Data.Text as T
-import Dodge.Data.Universe
-import Dodge.Event.Menu
-import Dodge.InputFocus
-import Dodge.Save
-import Dodge.Terminal.LeftButton
-import LensHelp
-import SDL
---import qualified Data.Map.Strict as M
-
--- annoyingly, the text input event doesn't register backspace, so deletion has to be
--- dealt with using key presses (handlePressedKey)
--- also, note that this currently "doubles" the inputs to both terminals if both
--- are open
-handleTextInput :: T.Text -> Universe -> Universe
-handleTextInput text = uvWorld . input . textInput %~ T.append text
---handleTextInput text u = u
---        & uvScreenLayers . ix 0 . scInput %~ updateText
---        & updateTerminalText
---  where
---    updateTerminalText = case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of
---        Just (DisplayTerminal tmid)
---            | hasfocus tmid ->
---                uvWorld %~ \w -> guardDisconnectedID tmid w (w & cWorld . lWorld . terminals . ix tmid . tmInput . tiText %~ updateText)
---        _ -> id
---    hasfocus tmid = fromMaybe False $ u ^? uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus
---    updateText s = case T.unpack text of
---        ";" -> s
---        _ -> s `T.append` T.toUpper text
-
-guardDisconnectedID :: Int -> World -> World -> World
-guardDisconnectedID tmid w w' = case w ^? cWorld . lWorld . terminals . ix tmid . tmStatus of
-    Just TerminalReady -> w'
-    _ -> w
-
-{- | Handles keyboard press and release.
-On release, remove scancode from the 'Set' of pressed keys.
-On press, adds the scancode, and perhaps applies a direct effect:
-see 'handlePressedKeyInGame'.
--}
-handleKeyboardEvent :: KeyboardEventData -> Universe -> Universe
-handleKeyboardEvent kev u = case keyboardEventKeyMotion kev of
-    Released -> u & uvWorld . input . pressedKeys . at scode .~ Nothing
-    Pressed ->
-        handlePressedKey
-            (keyboardEventRepeat kev)
-            scode
-            --(u & uvWorld . input . pressedKeys %~ M.insertWith f scode val)
-            (u & uvWorld . input . pressedKeys . at scode ?~ val)
-  where
-    val | keyboardEventRepeat kev = LongPress
-        | otherwise = InitialPress
-    scode = (keysymScancode . keyboardEventKeysym) kev
-
-handlePressedKey :: Bool -> Scancode -> Universe -> Universe
-handlePressedKey True _ u = u
-handlePressedKey _ scode u = case scode of
-    ScancodeF5 -> doQuicksave u
-    ScancodeF9 -> loadSaveSlot QuicksaveSlot u
-    ScancodeSemicolon -> gotoTerminal u
-    _ | null (_uvScreenLayers u) -> case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of
-        Just (DisplayTerminal tmid)
-            | inTermFocus (_uvWorld u) ->
-                over uvWorld (handlePressedKeyTerminal tmid scode) u
-        _ -> u
-    _ -> handlePressedKeyInMenu (head $ _uvScreenLayers u) scode u
-
-handlePressedKeyTerminal :: Int -> Scancode -> World -> World
-handlePressedKeyTerminal tmid scode w = case scode of
-    ScancodeEscape -> w & cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const False
-    ScancodeReturn -> w & terminalReturnEffect (w ^?! cWorld . lWorld . terminals . ix tmid)
-    _ -> w
-
-gotoTerminal :: Universe -> Universe
-gotoTerminal w = case _uvScreenLayers w of
-    (InputScreen{} : _) -> w
-    _ -> w & uvScreenLayers .:~ InputScreen T.empty "Enter command"

src/Dodge/Event/Menu.hs

@@ -1,5 +1,4 @@
 module Dodge.Event.Menu (
-    handlePressedKeyInMenu,
     optionListToEffects,
 ) where
 
@@ -9,12 +8,6 @@ import Dodge.Data.Universe
 import Dodge.WindowLayout
 import SDL
 
-handlePressedKeyInMenu :: ScreenLayer -> Scancode -> Universe -> Universe
-handlePressedKeyInMenu mState scode = case mState of
-    OptionScreen{_scOptions = mos, _scDefaultEff = defeff} ->
-        optionListToEffects defeff scode mos
-    _ -> id
-
 optionListToEffects ::
     (Universe -> Universe) ->
     Scancode ->

src/Dodge/Menu.hs

@@ -70,8 +70,6 @@ pauseMenuOptions =
 saveQuit :: Universe -> Universe
 saveQuit u = u & addSideEffect (saveQuitConc u) "SAVING"
 
-hardQuit :: Universe -> Universe
-hardQuit = addSideEffect (return $ const Nothing) "QUITTING"
 
 saveQuitConc :: Universe -> IO (Universe -> Maybe Universe)
 saveQuitConc u = do

src/Dodge/PreloadData.hs

@@ -1,11 +1,14 @@
 module Dodge.PreloadData where
 
+--import qualified Graphics.Rendering.OpenGL as GL
 import Control.Lens
 import Dodge.Data.Universe
 import Preload.Update
+--import SDL
 
 sideEffectUpdatePreload :: Int -> Int -> Int -> (Universe -> IO Universe) -> Universe -> IO Universe
 sideEffectUpdatePreload divRes x y f u = do
+--    GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral x) (fromIntegral y))
     pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData u)
     f $ u & preloadData .~ pdata
 

src/Dodge/Render/List.hs

@@ -16,6 +16,12 @@ listPicturesAt tx ty cfig = listPicturesAtOff tx ty cfig 0
 listPicturesAtOff :: Float -> Float -> Configuration -> Int -> [Picture] -> Picture
 listPicturesAtOff tx ty cfig i = mconcat . zipWith (listTextPictureAt tx ty cfig) [i ..]
 
+stackPicturesAt :: Float -> Float -> Configuration -> [Picture] -> Picture
+stackPicturesAt tx ty cfig = stackPicturesAtOff tx ty cfig 0
+
+stackPicturesAtOff :: Float -> Float -> Configuration -> Int -> [Picture] -> Picture
+stackPicturesAtOff tx ty cfig i = mconcat . zipWith (listTextPictureAt tx ty cfig) [i, i-1 ..]
+
 -- displays a cursor that should match up to list text pictures
 -- the width of a character appears to be 9(?!)
 -- this is probably because it is 8 pixels plus one for the border

src/Dodge/Render/Picture.hs

@@ -26,17 +26,28 @@ fixedCoordPictures u =
     cfig = _uvConfig u
 
 drawConcurrentMessage :: Universe -> Picture
-drawConcurrentMessage u = case u ^? uvSideEffects . _head of
+drawConcurrentMessage u =
-    --Just (BlockingConcEffect str) -> fillWidthText cfig str
+    stackPicturesAt
-    Just (RunningSideEffect str) ->
-        listPicturesAt
         (halfWidth cfig)
         (_windowY cfig - 50)
         cfig
-            [centerText str]
+        (map (centerText . f) $ u ^.. uvSideEffects . each)
-    _ -> mempty
   where
     cfig = _uvConfig u
+    f (RunningSideEffect ce) = ce ++ " IN PROGRESS"
+    f x = _ceString x ++ " QUEUED"
+
+--    = case u ^? uvSideEffects . _head of
+--    --Just (BlockingConcEffect str) -> fillWidthText cfig str
+--    Just (RunningSideEffect str) ->
+--        stackPicturesAt
+--            (halfWidth cfig)
+--            (_windowY cfig - 50)
+--            cfig
+--            [centerText str]
+--    _ -> mempty
+--  where
+--    cfig = _uvConfig u
 
 customMouseCursor :: Configuration -> World -> Picture
 customMouseCursor cfig w =

src/Dodge/Update.hs

@@ -6,6 +6,7 @@ Description : Simulation update
 -}
 module Dodge.Update (updateUniverse) where
 
+import Dodge.InputFocus
 import Dodge.Event.Menu
 import Color
 import Control.Applicative
@@ -62,10 +63,12 @@ import LensHelp
 import SDL
 import Sound.Data
 import StrictHelp
+import qualified Data.Text as T
 
 updateUniverse :: Universe -> Universe
 updateUniverse u =
     updateUniverseLast
+        . maybeOpenTerminal
         . over (uvWorld . input . textInput) (const mempty)
         . updateUniverseMid
         . updateUseInput
@@ -75,15 +78,24 @@ updateUniverse u =
   where
     cfig = u ^. uvConfig
 
+maybeOpenTerminal :: Universe -> Universe
+maybeOpenTerminal u = case u ^. uvWorld . input . pressedKeys . at ScancodeSemicolon of
+    Just InitialPress -> gotoTerminal u
+    _ -> u
+
+gotoTerminal :: Universe -> Universe
+gotoTerminal w = case _uvScreenLayers w of
+    (InputScreen{} : _) -> w
+    _ -> w & uvScreenLayers .:~ InputScreen T.empty "Enter command"
+
 updateUseInput :: Universe -> Universe
 updateUseInput u = case u ^? uvScreenLayers . _head of
     Just (InputScreen thetext _) -> doInputScreenInput thetext u
---    Just OptionScreen{} -> --{_scOptions = mos, _scDefaultEff = defeff} -> u
---        u
---
     Just OptionScreen{_scOptions = mos, _scDefaultEff = defeff} ->
         foldl' (\u' scode -> optionListToEffects defeff scode mos u') u (M.keys $ M.filter (== InitialPress) pkeys)
     Just ColumnsScreen{} -> u & uvScreenLayers %~ tail
+    _ -> case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of
+        Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u-- M.foldlWithKey' (updateKeyInTerminal tmid) u pkeys
         _ -> M.foldlWithKey' updateKeyInGame u pkeys
   where
     pkeys = u ^. uvWorld . input . pressedKeys

src/Dodge/Update/Input.hs

@@ -1,8 +1,11 @@
 module Dodge.Update.Input 
     ( updateKeyInGame
+    , updateKeysInTerminal
     , doInputScreenInput
     ) where
 
+import Dodge.Terminal.LeftButton
+import Dodge.Save
 import Dodge.Debug.Terminal
 import Dodge.WorldPos
 import Dodge.Button.Event
@@ -41,9 +44,30 @@ doBackspace t = case T.unsnoc t of
     Nothing -> t
     Just (t', _) -> t'
 
+updateKeysInTerminal :: Int -> Universe -> Universe
+updateKeysInTerminal tmid u= u & tmpoint %~ (`T.append` T.toUpper thetext)
+    & checkBackspace
+    & checkEndStatus
+  where
+    tmpoint = uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiText
+    thetext = u ^. uvWorld . input . textInput
+    checkBackspace = case u ^. uvWorld . input . pressedKeys . at ScancodeBackspace of
+        Just InitialPress -> f
+        Just LongPress -> f
+        _ -> id
+    f = tmpoint %~ doBackspace
+    pkeys = u ^. uvWorld . input . pressedKeys
+    checkEndStatus
+        | pkeys ^. at ScancodeReturn == Just InitialPress 
+            = over uvWorld (\w -> terminalReturnEffect (w ^?! cWorld . lWorld . terminals . ix tmid) w)
+--        | pkeys ^. at ScancodeEscape == Just InitialPress 
+--            = uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const False
+        | otherwise = id
 
 updateKeyInGame :: Universe -> Scancode -> PressType -> Universe
 updateKeyInGame  uv sc InitialPress = case sc of
+    ScancodeF5 -> doQuicksave uv
+    ScancodeF9 -> loadSaveSlot QuicksaveSlot uv
     ScancodeEscape -> pauseGame uv
     ScancodeSpace -> over uvWorld spaceAction uv
     ScancodeP -> pauseGame uv

src/Dodge/Update/Scroll.hs

@@ -6,7 +6,6 @@ import qualified Data.Text as T
 import Dodge.Base
 import Dodge.Combine
 import Dodge.Data.Universe
-import Dodge.Event.Keyboard
 import Dodge.HeldScroll
 import Dodge.InputFocus
 import Dodge.Inventory
@@ -75,6 +74,11 @@ updateWheelEvent yi w = case w ^. cWorld . lWorld . hud . hudElement of
     lbDown = ButtonLeft `M.member` _mouseButtons (_input w)
     invKeyDown = ScancodeCapsLock `M.member` _pressedKeys (_input w)
 
+guardDisconnectedID :: Int -> World -> World -> World
+guardDisconnectedID tmid w w' = case w ^? cWorld . lWorld . terminals . ix tmid . tmStatus of
+    Just TerminalReady -> w'
+    _ -> w
+
 scrollRBOption :: Float -> World -> World
 scrollRBOption y w
     | y < 0 = w & rbOptions . opSel %~ (min (length (_opEquip (_rbOptions w)) -1) . (+ 1))

src/Loop.hs

@@ -11,6 +11,7 @@ This module sets up an SDL window which may be updated using a simple game loop.
 module Loop (
     setupLoop,
     setupConLoop,
+    setupConLoop',
 ) where
 
 import Loop.Data
@@ -21,6 +22,7 @@ import qualified Data.Text as T
 import qualified Graphics.Rendering.OpenGL as GL
 import SDL
 import System.Mem
+import Data.Foldable
 
 -- | Create a game loop with an SDL window.
 setupLoop ::
@@ -180,3 +182,86 @@ doConLoop themvar spf window coneffs worldSideEffects eventFn !startWorld = go s
                         threadDelay (theDelay * 1000)
                         go $! updatedWorld
                     Nothing -> return ()
+
+-- | Create a game loop with an SDL window.
+setupConLoop' ::
+    -- | Target seconds per frame
+    Int ->
+    -- | Window title
+    T.Text ->
+    WindowConfig ->
+    -- | Function for cleaning up parameters, applied when exiting loop.
+    (world -> IO ()) ->
+    -- | Initial simulation state.
+    IO world ->
+    ---- | Concurrent effects. Evaluating 'Nothing' exits the loop
+    (world -> ConcurrentEffect world) ->
+    -- | update, called once per frame. Allows for side effects such as rendering.
+    (world -> IO world) ->
+    -- | SDL Event handling, once per frame. Note no side effects.
+    (world -> Event ->  world) ->
+    IO ()
+setupConLoop' spf title winconfig paramCleanup ioStartWorld coneffs sideEffects eventFn = do
+    initializeAll
+    themvar <- newEmptyMVar
+    bracket
+        (createWindow title winconfig)
+        destroyWindow
+        $ \window -> bracket
+            (glCreateContext window)
+            (\con -> GL.finish >> glDeleteContext con)
+            $ \_ ->
+                bracket
+                    ioStartWorld
+                    paramCleanup
+                    (doConLoop' themvar spf window coneffs sideEffects eventFn)
+
+-- | The internal loop.
+doConLoop' ::
+    -- | The mvar for concurrency
+    MVar (world -> Maybe world) ->
+    -- | target msec per frame
+    Int ->
+    -- | The SDL window.
+    Window ->
+    ---- | Concurrent effects, the first function in the pair is applied
+    ---- immediately
+    (world -> ConcurrentEffect world) ->
+    -- | simulation update. Allows for side effects such as rendering.
+    (world -> IO world) ->
+    -- | SDL Event handling. Note no side effects.
+    (world -> Event -> world) ->
+    -- | Current simulation state.
+    world ->
+    IO ()
+doConLoop' themvar spf window coneffs worldSideEffects eventFn !startWorld = go startWorld
+  where
+    go sw = do
+        startTicks <- ticks
+        es <- pollEvents
+        let mconeff = coneffs sw
+        case mconeff of
+            NoConcurrentEffect -> return ()
+            ConcurrentEffect _ acc -> do
+                _ <- forkIO $ do
+                    up <- acc
+                    putMVar themvar up
+                return ()
+        let startWorld'' = case mconeff of
+                NoConcurrentEffect -> sw
+                ConcurrentEffect immediatef _ -> immediatef
+        mconupdate <- tryTakeMVar themvar
+        let mstartWorld' = case mconupdate of
+                Just conupdate -> conupdate startWorld''
+                Nothing -> Just startWorld''
+        case mstartWorld' of
+            Nothing -> return ()
+            Just startWorld' -> do
+                worldAfterSimStep <- worldSideEffects startWorld'
+                glSwapWindow window
+                let updatedWorld = foldl' eventFn worldAfterSimStep es
+                performGC
+                endTicks <- ticks -- it might be better to use System.Clock (monotonic)
+                let theDelay = max 0 (spf + fromIntegral startTicks - fromIntegral endTicks)
+                threadDelay (theDelay * 1000)
+                go $! updatedWorld