justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Attempt to fix some space leaks, general cleanup

Browse Source
This commit is contained in:
justin
2022-08-23 23:00:12 +01:00
parent 9f00e67298
commit e7e20277e4
12 changed files with 71 additions and 263 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/ChainUpdates.hs
+3
View File
@@ -11,3 +11,6 @@ chainCreatureUpdates ::
chainCreatureUpdates ls w cr = foldl' unf cr ls chainCreatureUpdates ls w cr = foldl' unf cr ls
where where
unf cr' g = g w cr' unf cr' g = g w cr'
--chainCreatureUpdates ls w cr = foldr unf cr ls
-- where
-- unf g cr' = g w cr'
src/Dodge/Creature/Update.hs
+3 -18
View File
@@ -1,14 +1,11 @@
module Dodge.Creature.Update where module Dodge.Creature.Update
( updateCreature
) where
import Dodge.Barreloid import Dodge.Barreloid
import Dodge.Creature.ChainUpdates
import Dodge.Creature.Impulse
import Dodge.Creature.State
import Dodge.Data.World import Dodge.Data.World
import Dodge.Humanoid import Dodge.Humanoid
import Dodge.Lampoid import Dodge.Lampoid
import LensHelp
import System.Random
updateCreature :: Creature -> World -> World updateCreature :: Creature -> World -> World
updateCreature cr = case _crType cr of updateCreature cr = case _crType cr of
@@ -16,15 +13,3 @@ updateCreature cr = case _crType cr of
Humanoid{} -> updateHumanoid cr Humanoid{} -> updateHumanoid cr
Barreloid{} -> updateBarreloid cr Barreloid{} -> updateBarreloid cr
NonDrawnCreature -> id NonDrawnCreature -> id
-- bit of a hack to get new random generators after each creature's update
defaultImpulsive ::
[World -> Creature -> Creature] ->
Creature ->
World ->
World
defaultImpulsive = fmap (fmap updateRandGen) . stateUpdate . impulsiveAIBefore . chainCreatureUpdates
where
updateRandGen w =
let (_, g) = randomR (0, 1 :: Int) (_randGen w)
in w & randGen .~ g
src/Dodge/Hammer.hs
+1
View File
@@ -3,5 +3,6 @@ module Dodge.Hammer where
import Dodge.Data.Hammer import Dodge.Data.Hammer
moveHammerUp :: HammerPosition -> HammerPosition moveHammerUp :: HammerPosition -> HammerPosition
{-# INLINE moveHammerUp #-}
moveHammerUp HammerDown = HammerReleased moveHammerUp HammerDown = HammerReleased
moveHammerUp _ = HammerUp moveHammerUp _ = HammerUp
src/Dodge/Humanoid.hs
+2 -1
View File
@@ -187,7 +187,8 @@ defaultImpulsive ::
Creature -> Creature ->
World -> World ->
World World
defaultImpulsive = fmap (fmap updateRandGen) . stateUpdate . impulsiveAIBefore . chainCreatureUpdates defaultImpulsive fs cr = updateRandGen -- . stateUpdate (const id) cr
--fmap (fmap updateRandGen) . stateUpdate . impulsiveAIBefore . chainCreatureUpdates
where where
updateRandGen w = updateRandGen w =
let (_, g) = randomR (0, 1 :: Int) (_randGen w) let (_, g) = randomR (0, 1 :: Int) (_randGen w)
src/Dodge/Placement/PlaceSpot.hs.orig
-203
View File
@@ -1,203 +0,0 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
-- | deals with placement of objects within the world
-- after they have had their coordinates set by the layout
module Dodge.Placement.PlaceSpot
( placeSpot
) where
import Dodge.Placement.Shift
import Dodge.Data
import Dodge.Path
import Dodge.Placement.PlaceSpot.Block
import Dodge.Placement.PlaceSpot.TriggerDoor
import Dodge.Default.Wall
import Dodge.ShiftPoint
import Dodge.Base.NewID
import Geometry
import qualified IntMapHelp as IM
import Color
import Data.Foldable
import Data.Maybe
import System.Random
import Control.Monad.State
import Control.Lens
import qualified Data.IntSet as IS
import Data.Bifunctor
-- when placing a placement, we update the world and the room and assign an id
-- to the placement
placeSpot :: (World,Room) -> Placement -> ( (World,Room), [Placement] )
placeSpot (w,rm) plmnt = case plmnt of
Placement{_plSpot = PSRoomRand i f} -> placeSpotRoomRand rm i f plmnt w
Placement{_plSpot = PSPos extract eff fallback} -> placeSpotUsingLink w rm plmnt extract eff fallback
Placement{} -> placePlainPSSpot w rm plmnt shift
PlacementUsingPos p subpl -> placeSpot (w,rm) (subpl (shiftPoint3By shift p))
RandomPlacement rplmnt -> placeRandomPlacement rplmnt w rm
PickOnePlacement i pl -> ((placePickOne i pl rm w, rm), [])
where
shift = _rmShift rm
placePickOne :: Int -> Placement -> Room -> World -> World
placePickOne i pl rm w = w & genPlacements %~ IM.insertWith (++) i [(pl, fromJust (_rmMID rm))]
placeRandomPlacement :: State StdGen Placement -> World -> Room -> ((World,Room),[Placement])
placeRandomPlacement rplmnt w rm = placeSpot (w & randGen .~ g,rm) plmnt'
where
(plmnt', g) = runState rplmnt (_randGen w)
placePlainPSSpot :: World -> Room -> Placement -> DPoint2 -> ((World,Room),[Placement])
placePlainPSSpot w rm plmnt shift =
let (i,w') = placeSpotID (shiftPSBy shift (_plSpot plmnt)) (_plType plmnt) w
newplmnt = plmnt & plMID ?~ i
in maybe ((w',rm),[newplmnt]) (recrPlace newplmnt w') (_plIDCont plmnt w' newplmnt)
where
recrPlace newplmnt w' pl = let (wr,newplmnts) = placeSpot (w',rm) pl
in (wr,newplmnt:newplmnts)
-- this should be tidied up
placeSpotUsingLink :: World
-> Room
-> Placement
-> (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos))
-> (RoomPos -> Room -> Room)
-> Maybe Placement
-> ((World, Room), [Placement])
placeSpotUsingLink w rm plmnt extract eff fallback = case searchedPoss (_rmPos rm) of
Just (ps,rmposs) -> placeSpot (w, eff (head rmposs) $ rm & rmPos .~ rmposs) (plmnt & plSpot .~ ps)
Nothing -> case fallback of
Nothing -> ((w,rm),[plmnt])
Just plmnt' -> placeSpot (w,rm) plmnt'
where
searchedPoss [] = Nothing
searchedPoss (pos:poss) = case extract pos rm of
Nothing -> second (pos:) <$> searchedPoss poss
Just (ps,rmpos) -> Just ( ps,rmpos:poss)
placeSpotRoomRand :: Room -> Int -> (DPoint2 -> PlacementSpot)
-> Placement -> World -> ((World,Room),[Placement])
placeSpotRoomRand rm i f plmnt w =
let (ps,g) = runState (_rmRandPSs rm !! i) $_randGen w
in placeSpot (w & randGen .~ g,rm) (plmnt & plSpot .~ f ps)
-- the Int here is some id that is assigned when the placement is placed
placeSpotID :: PlacementSpot -> PSType -> World -> (Int, World)
placeSpotID ps pt w = case pt of
PutTrigger cnd -> plNewID triggers cnd w
PutMod mdi -> plNewUpID modifications mdID mdi w
PutProp prp -> plNewUpID props pjID (mvProp p rot prp) w
PutButton bt -> plNewUpID buttons btID (mvButton p rot bt) w
PutTerminal tm -> plNewUpID terminals tmID tm w
PutFlIt itm -> plNewUpID floorItems flItID (createFlIt p rot itm) w
PutCrit cr -> plNewUpID creatures crID (mvCr p rot cr) w
PutForeground fs -> plNewUpID shapes fsID (mvFS p rot fs) w
PutMachine pps mc -> plMachine (map doShift pps) mc p rot w
PutLS ls -> plNewUpID lightSources lsID (mvLS p' rot ls) w
PutPPlate pp -> plNewUpID pressPlates ppID (mvPP p rot pp) w
RandPS rgn -> evaluateRandPS rgn ps w
PutDoor col f pss -> plDoor col f (map (bimap doShift doShift) pss) w
PutCoord cp -> plNewID coordinates (doShift cp) w
PutSlideDr wl dr off a b
-> plSlideDoor wl dr off (doShift a) (doShift b) w
PutBlock bl wl ps' -> plBlock (map doShift ps') (bl & blPos %~ doShift & blDir .~ rot)
wl w
PutLineBlock wl wdth a b -> plLineBlock wl wdth (doShift a) (doShift b) w
PutWall qs wl -> (0,placeWallPoly (map doShift qs) wl w)
PutNothing -> (0,w)
PutID i -> (i, w)
PutWorldUpdate f -> (0, w & f ps)
PutUsingGenParams f -> let (w',pt') = f w
in placeSpotID ps pt' w'
where
p@(V2 px py) = _psPos ps
p' = V3 px py 0
rot = _psRot ps
doShift = shiftPointBy (p,rot)
evaluateRandPS :: State StdGen PSType -> PlacementSpot -> World -> (Int,World)
evaluateRandPS rgen ps w = placeSpotID ps evaluatedType (set randGen g w)
where
(evaluatedType, g) = runState rgen (_randGen w)
placeWallPoly :: [Point2] -> Wall -> World -> World
<<<<<<< HEAD
--placeWallPoly ps wl = over walls (placeWalls ps wl)
placeWallPoly ps wl = rmCrossPaths . over walls (placeWalls ps wl)
where
rmCrossPaths w = foldr (uncurry (addObstacleCrossing' WallObstacle)) w $ loopPairs ps
=======
placeWallPoly ps wl = -- rmCrossPaths .
over walls (placeWalls ps wl)
-- where
-- rmCrossPaths w = foldr (uncurry obstructPathsCrossing) w $ loopPairs ps
>>>>>>> efficientRuntime
placeWalls :: [Point2] -> Wall -> IM.IntMap Wall -> IM.IntMap Wall
placeWalls qs wl wls = foldl' (addPane wl) wls pairs
where
(p:ps) = orderPolygon qs
pairs = zip (ps ++ [p]) (p:ps)
addPane :: Wall -> IM.IntMap Wall -> (Point2,Point2) -> IM.IntMap Wall
addPane wl wls l = IM.insert wlid (wl { _wlLine = l, _wlID = wlid }) wls
where
wlid = IM.newKey wls
---- | place an new object into an intmap and update its id
--plNewUpID :: ALens' World (IM.IntMap a)
-- -> ALens' a Int
-- -> a
-- -> World
-- -> (Int,World)
--plNewUpID l li x w = (i,w & l #%~ IM.insert i (x & li #~ i))
-- where
-- i = IM.newKey $ w ^# l
mvProp :: Point2 -> Float -> Prop -> Prop
mvProp p a = (pjRot +~ a) . (prPos %~ ( (p +.+) . rotateV a ))
mvButton :: Point2 -> Float -> Button -> Button
mvButton p a = (btRot +~ a) . (btPos %~ ( (p +.+) . rotateV a ))
{- Creates a floor item at a given point.-}
createFlIt :: Point2 -> Float -> Item -> FloorItem
createFlIt p rot itm = FlIt { _flItPos = p , _flItRot = rot , _flItID = 0 , _flIt = itm }
mvPP :: Point2 -> Float -> PressPlate -> PressPlate
mvPP p rot pp = pp {_ppPos = p,_ppRot = rot}
mvCr :: Point2 -> Float -> Creature -> Creature
mvCr p rot cr = cr {_crPos = p,_crOldPos = p,_crDir = rot}
mvFS :: Point2 -> Float -> ForegroundShape -> ForegroundShape
mvFS p a = (fsDir +~ a) . (fsPos %~ ( (p +.+) . rotateV a ))
plMachine :: [Point2] -> Machine -> Point2 -> Float -> World -> (Int,World)
plMachine wallpoly mc p rot gw = (mcid
, gw & machines %~ addMc
& walls %~ placeMachineWalls color wallpoly mcid wlid
)
where
color = _mcColor mc
w' = gw
mcid = IM.newKey $ _machines w'
wlid = IM.newKey $ _walls w'
wlids = IS.fromList [wlid .. wlid + length wallpoly - 1]
--addMc = IM.insert mcid (mc {_mcPos = centroid wallpoly,_mcDir = rot,_mcID = mcid, _mcWallIDs = wlids})
addMc = IM.insert mcid (mc {_mcPos = p,_mcDir = rot,_mcID = mcid, _mcWallIDs = wlids})
-- TODO correctly remove/shift pathfinding lines (removePathsCrossing)
placeMachineWalls :: Color -> [Point2] -> Int -> Int -> IM.IntMap Wall -> IM.IntMap Wall
placeMachineWalls col poly mcid wlid = flip (foldr f) $ zip [wlid..] $ loopPairs poly
where
f (wid,l) = IM.insert wid baseWall{_wlID = wid, _wlLine = l}
baseWall = defaultMachineWall
& wlColor .~ col
& wlStructure . wsMachine .~ mcid
& wlTouchThrough .~ True
mvLS :: Point3 -> Float -> LightSource -> LightSource
mvLS (V3 x y z) rot ls = ls & lsParam . lsPos .~ V3 x y z +.+.+ startPos
& lsDir .~ rot
where
startPos = onXY (rotateV rot) $ _lsPos (_lsParam ls)
src/Dodge/Tesla/Arc.hs
+2 -1
View File
@@ -3,6 +3,7 @@ module Dodge.Tesla.Arc
, moveTeslaArc , moveTeslaArc
) where ) where
import Data.Foldable
import Dodge.Data.CrWlID import Dodge.Data.CrWlID
import Dodge.Data.ArcStep import Dodge.Data.ArcStep
import Data.Maybe import Data.Maybe
@@ -30,7 +31,7 @@ moveTeslaArc ::
TeslaArc -> TeslaArc ->
(World, Maybe TeslaArc) (World, Maybe TeslaArc)
moveTeslaArc w pt moveTeslaArc w pt
| _taTimer pt == 2 = (makesparks $ foldr damthings w thearc, Just $ pt & taTimer -~ 1) | _taTimer pt == 2 = (makesparks $ foldl' (flip damthings) w thearc, Just $ pt & taTimer -~ 1)
| _taTimer pt < 1 = (w, Nothing) | _taTimer pt < 1 = (w, Nothing)
| otherwise = (w, Just $ pt & taTimer -~ 1) | otherwise = (w, Just $ pt & taTimer -~ 1)
where where
src/Dodge/Update.hs
+15 -2
View File
@@ -90,7 +90,10 @@ functionalUpdate w =
. over uvWorld (cWorld . cwTime . worldClock +~ 1) . over uvWorld (cWorld . cwTime . worldClock +~ 1)
. over uvWorld updateWorldSelect . over uvWorld updateWorldSelect
. over uvWorld doRewind . over uvWorld doRewind
. over uvWorld (hammers . each %~ moveHammerUp) -- . over uvWorld (hammers . each %~ moveHammerUp)
-- . over (uvWorld . hammers . each) moveHammerUp
-- . over uvWorld (hammers %~ fmap moveHammerUp)
. moveHammersUp
. over uvWorld updateDistortions . over uvWorld updateDistortions
. over uvWorld updateCreatureSoundPositions . over uvWorld updateCreatureSoundPositions
. over uvWorld ppEvents . over uvWorld ppEvents
@@ -138,8 +141,18 @@ functionalUpdate w =
. updateBounds -- where should this go? next to update camera? . updateBounds -- where should this go? next to update camera?
$ over uvWorld updateCloseObjects w $ over uvWorld updateCloseObjects w
moveHammersUp :: Universe -> Universe
--moveHammersUp = uvWorld . hammers .~ M.empty
moveHammersUp = uvWorld . hammers %~ M.map moveHammerUp
--moveHammersUp = uvWorld . hammers . each %~ (moveHammerUp $!)
--moveHammersUp = uvWorld %~ ( (hammers . each %~ (moveHammerUp $!)) $!)
--moveHammersUp uv = uv { _uvWorld = w' }
-- where
-- w = _uvWorld uv
-- w' = w {_hammers = fmap moveHammerUp (_hammers w)}
doWorldEvents :: World -> World doWorldEvents :: World -> World
doWorldEvents w = foldr doWdWd (w & cWorld . worldEvents .~ []) (_worldEvents (_cWorld w)) doWorldEvents w = foldl' (flip doWdWd) (w & cWorld . worldEvents .~ []) (_worldEvents (_cWorld w))
updateLasers :: World -> World updateLasers :: World -> World
updateLasers w = updateLasers w =
src/Dodge/Update/Camera.hs
+1 -1
View File
@@ -79,7 +79,7 @@ moveZoomCamera uv =
wallZoom = min4 (w ^. cWorld . cwCam . cwcBoundDist) wallZoom = min4 (w ^. cWorld . cwCam . cwcBoundDist)
min4 (a, b, c, d) = minimum [hh / maxd a, hh / maxd (- b), hw / maxd c, hw / maxd (- d)] min4 (a, b, c, d) = minimum [hh / maxd a, hh / maxd (- b), hw / maxd c, hw / maxd (- d)]
maxd = max distFromEqmnt maxd = max distFromEqmnt
distFromEqmnt = foldr max 1 $ IM.mapMaybe (_eeViewDist . _equipEffect . _itUse) $ getCrEquipment $ you w distFromEqmnt = foldl' max 1 $ IM.mapMaybe (_eeViewDist . _equipEffect . _itUse) $ getCrEquipment $ you w
hw = halfWidth cfig hw = halfWidth cfig
hh = halfHeight cfig hh = halfHeight cfig
-- = maybe clipZoom zoomFromItem (yourItem w ^? itZoom) wallZoom -- = maybe clipZoom zoomFromItem (yourItem w ^? itZoom) wallZoom
src/Dodge/Update/WallDamage.hs
+4 -3
View File
@@ -5,13 +5,14 @@ import Data.Maybe
import Dodge.Data.World import Dodge.Data.World
import Dodge.Wall.Damage import Dodge.Wall.Damage
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
import Data.Foldable
updateWallDamages :: World -> World updateWallDamages :: World -> World
updateWallDamages w = updateWallDamages w =
w w
& cWorld . wallDamages .~ IM.empty & cWorld . wallDamages .~ IM.empty
& flip (IM.foldrWithKey f) (_wallDamages (_cWorld w)) & flip (IM.foldlWithKey' f) (_wallDamages (_cWorld w))
where where
f k dams w' = fromMaybe w' $ do f w' k dams = fromMaybe w' $ do
wl <- w' ^? cWorld . walls . ix k wl <- w' ^? cWorld . walls . ix k
return $ foldr (`damageWall` wl) w' dams return $ foldl' (flip (`damageWall` wl)) w' dams
src/Dodge/Wall/Delete.hs
+2 -1
View File
@@ -3,6 +3,7 @@ module Dodge.Wall.Delete (
deleteWallID, deleteWallID,
) where ) where
import Data.Foldable
import Control.Lens import Control.Lens
import qualified Data.IntSet as IS import qualified Data.IntSet as IS
import Dodge.Data.World import Dodge.Data.World
@@ -24,4 +25,4 @@ deleteWall wl =
i = _wlID wl i = _wlID wl
deleteWallIDs :: IS.IntSet -> World -> World deleteWallIDs :: IS.IntSet -> World -> World
deleteWallIDs is w = foldr deleteWall w $ IM.restrictKeys (_walls (_cWorld w)) is deleteWallIDs is w = foldl' (flip deleteWall) w $ IM.restrictKeys (_walls (_cWorld w)) is
src/Dodge/Wall/Dust.hs
+3 -2
View File
@@ -1,5 +1,6 @@
module Dodge.Wall.Dust where module Dodge.Wall.Dust where
import Data.Foldable
import Control.Lens import Control.Lens
import Dodge.Data.World import Dodge.Data.World
import Dodge.WorldEvent.Cloud import Dodge.WorldEvent.Cloud
@@ -12,9 +13,9 @@ wlDustAt wl = smokeCloudAt dustcol 20 200 1 . addZ 20
dustcol = _wlColor wl & _4 .~ 1 dustcol = _wlColor wl & _4 .~ 1
muchWlDustAt :: Wall -> Point2 -> World -> World muchWlDustAt :: Wall -> Point2 -> World -> World
muchWlDustAt wl p = flip (foldr f) [10, 20 .. 100] muchWlDustAt wl p = flip (foldl' f) [10, 20 .. 100]
where where
f h w = f w h =
w w
& smokeCloudAt dustcol 20 200 1 (addZ h (p +.+ off)) & smokeCloudAt dustcol 20 200 1 (addZ h (p +.+ off))
& randGen .~ g & randGen .~ g
src/Loop.hs
+35 -31
View File
@@ -1,3 +1,5 @@
{-# LANGUAGE BangPatterns #-}
--{-# LANGUAGE TupleSections #-} --{-# LANGUAGE TupleSections #-}
{- | {- |
@@ -103,7 +105,7 @@ setupConLoop ::
-- | Initial simulation state. -- | Initial simulation state.
IO world -> IO world ->
-- | Concurrent effects. Evaluating 'Nothing' exits the loop -- | Concurrent effects. Evaluating 'Nothing' exits the loop
(world -> Maybe (world -> world,IO (world -> Maybe world))) -> (world -> Maybe (world -> world, IO (world -> Maybe world))) ->
-- | update, called once per frame. Allows for side effects such as rendering. -- | update, called once per frame. Allows for side effects such as rendering.
(world -> IO world) -> (world -> IO world) ->
-- | SDL Event handling, once per frame. Evaluating 'Nothing' exits the loop. -- | SDL Event handling, once per frame. Evaluating 'Nothing' exits the loop.
@@ -134,7 +136,7 @@ doConLoop ::
Window -> Window ->
-- | Concurrent effects, the first function in the pair is applied -- | Concurrent effects, the first function in the pair is applied
-- immediately -- immediately
(world -> Maybe (world->world,IO (world -> Maybe world))) -> (world -> Maybe (world -> world, IO (world -> Maybe world))) ->
-- | simulation update. -- | simulation update.
(world -> IO world) -> (world -> IO world) ->
-- | SDL Event handling. -- | SDL Event handling.
@@ -142,32 +144,34 @@ doConLoop ::
-- | Current simulation state. -- | Current simulation state.
world -> world ->
IO () IO ()
doConLoop themvar spf window coneffs worldSideEffects eventFn startWorld = do doConLoop themvar spf window coneffs worldSideEffects eventFn !startWorld = go startWorld
startTicks <- ticks where
let mconeff = coneffs startWorld go sw = do
case mconeff of startTicks <- ticks
Nothing -> return () let mconeff = coneffs sw
Just (_,acc) -> do case mconeff of
_ <- forkIO $ do Nothing -> return ()
up <- acc Just (_, acc) -> do
putMVar themvar up _ <- forkIO $ do
return () up <- acc
let startWorld'' = maybe id fst mconeff startWorld putMVar themvar up
mconupdate <- tryTakeMVar themvar return ()
let mstartWorld' = case mconupdate of let startWorld'' = maybe id fst mconeff sw
Just conupdate -> conupdate startWorld'' mconupdate <- tryTakeMVar themvar
Nothing -> Just startWorld'' let mstartWorld' = case mconupdate of
case mstartWorld' of Just conupdate -> conupdate startWorld''
Nothing -> return () Nothing -> Just startWorld''
Just startWorld' -> do case mstartWorld' of
worldAfterSimStep <- worldSideEffects startWorld' Nothing -> return ()
glSwapWindow window Just startWorld' -> do
maybeUpdatedWorld <- pollEvents >>= foldM (applyEventIO eventFn) (Just worldAfterSimStep) worldAfterSimStep <- worldSideEffects startWorld'
case maybeUpdatedWorld of glSwapWindow window
Just updatedWorld -> do maybeUpdatedWorld <- pollEvents >>= foldM (applyEventIO eventFn) (Just worldAfterSimStep)
performGC case maybeUpdatedWorld of
endTicks <- ticks -- it might be better to use System.Clock (monotonic) Just updatedWorld -> do
let theDelay = max 0 (spf + fromIntegral startTicks - fromIntegral endTicks) performGC
threadDelay (theDelay * 1000) endTicks <- ticks -- it might be better to use System.Clock (monotonic)
doConLoop themvar spf window coneffs worldSideEffects eventFn updatedWorld let theDelay = max 0 (spf + fromIntegral startTicks - fromIntegral endTicks)
Nothing -> return () threadDelay (theDelay * 1000)
go $! updatedWorld
Nothing -> return ()