Apply side effects to universe not world

appDodge/Main.hs

@@ -47,21 +47,26 @@ main = do
         theUpdateStep
         (flip handleEvent)
 
-theCleanup :: World -> IO ()
-theCleanup w = SDL.cursorVisible $= True >> cleanUpPreload (_preloadData w)
+theCleanup :: Universe -> IO ()
+theCleanup uv = let w = _uvWorld uv
+    in SDL.cursorVisible $= True >> cleanUpPreload (_preloadData w)
 
-firstWorldLoad :: Configuration -> IO World
+firstWorldLoad :: Configuration -> IO Universe
 firstWorldLoad theConfig = do
     SDL.cursorVisible $= False
     theKeyConfig <- loadKeyConfig
     pdata <- doPreload >>= applyWorldConfig theConfig
     w <- generateWorldFromSeed 0
-    return $ w & preloadData .~ pdata
+    return $ Universe ( w & preloadData .~ pdata
         & keyConfig .~ theKeyConfig
         & config .~ theConfig
+        )
 
-theUpdateStep :: World -> IO World
-theUpdateStep = doSideEffects <=< updateRenderSplit
+theUpdateStep :: Universe -> IO Universe
+theUpdateStep = doSideEffects <=< traverseOf uvWorld theUpdateStep'
+
+theUpdateStep' :: World -> IO World
+theUpdateStep' = updateRenderSplit
 
 updateRenderSplit :: World -> IO World
 updateRenderSplit w = do
@@ -74,12 +79,13 @@ playSoundUnlessRewinding w
     | _rewinding w = return M.empty
     | otherwise = playSoundAndUpdate (_soundData $ _preloadData w) (_playingSounds w) (_toPlaySounds w)
 
-doSideEffects :: World -> IO World
-doSideEffects w = do
+doSideEffects :: Universe -> IO Universe
+doSideEffects u = do
+    let w = _uvWorld u
     let preData = _preloadData w
     --newPlayingSounds <- playSoundAndUpdate (_soundData preData) (_playingSounds w) (_toPlaySounds w)
     newPlayingSounds <- playSoundUnlessRewinding w
-    w' <- _sideEffects w w
+    u' <- _sideEffects w u
     endTicks <- SDL.ticks
     let lastFrameTicks = _frameTimer preData
     when (_debug_seconds_frame $ _config w) $ void $ renderFoldable
@@ -88,11 +94,13 @@ doSideEffects w = do
             . translate (-0.5) (-0.8) . scale 0.0005 0.0005
             . text $ "ms/frame " ++ show (endTicks - lastFrameTicks)
         )
-    return $ w' & preloadData . frameTimer .~ endTicks
-        & playingSounds .~ newPlayingSounds
-        & toPlaySounds  .~ M.empty
-        & sideEffects   .~ return
-        & rewinding .~ False  -- this is probably not the best place for this
+    return $ u' 
+        & uvWorld . preloadData . frameTimer .~ endTicks
+        & uvWorld . playingSounds .~ newPlayingSounds
+        & uvWorld . toPlaySounds  .~ M.empty
+        & uvWorld . sideEffects   .~ return
+        & uvWorld . rewinding .~ False  -- this is probably not the best place for this
+        
 
 doPreload :: IO PreloadData
 doPreload = do

src/Dodge/Data.hs

@@ -52,6 +52,9 @@ import qualified Data.Map.Strict as M
 import SDL (Scancode, MouseButton)
 import Data.Monoid
 type CRUpdate = Creature -> World -> (Endo World, Maybe Creature)
+data Universe = Universe
+    { _uvWorld :: World
+    }
 data World = World 
     { _keys                 :: !(S.Set Scancode)
     , _mouseButtons         :: !(S.Set MouseButton)
@@ -105,7 +108,7 @@ data World = World
     , _closeActiveObjects   :: [Either FloorItem Button]
     , _seenLocations        :: IM.IntMap (World -> Point2,String)
     , _selLocation          :: Int
-    , _sideEffects          :: World -> IO World
+    , _sideEffects          :: Universe -> IO Universe
     , _inventoryMode        :: InventoryMode
     , _distortions          :: [Distortion]
     , _worldBounds          :: Bounds
@@ -900,3 +903,4 @@ makeLenses ''ItemDimension
 makeLenses ''Vocalization
 makeLenses ''UseDelay
 makeLenses ''AimParams
+makeLenses ''Universe

src/Dodge/Event.hs

@@ -18,11 +18,12 @@ import Dodge.Event.Keyboard
 import Dodge.Data
 import Dodge.Base
 import Dodge.Base.Window
+import Dodge.PreloadData
 --import Dodge.Creature.Action
 import Dodge.SoundLogic
 import Dodge.Inventory
 --import Geometry
-import Preload.Update
+--import Preload.Update
 import qualified IntMapHelp as IM
 
 import Control.Lens
@@ -33,8 +34,14 @@ import Control.Lens
 import qualified Data.Set as S
 import SDL
 
-handleEvent :: Event -> World -> Maybe World
-handleEvent e = case eventPayload e of
+
+handleEvent :: Event -> Universe -> Maybe Universe
+handleEvent e uv = case handleEvent' e (_uvWorld uv) of
+    Nothing -> Nothing
+    Just w -> Just $ uv & uvWorld .~ w
+
+handleEvent' :: Event -> World -> Maybe World
+handleEvent' e = case eventPayload e of
     KeyboardEvent kev           -> handleKeyboardEvent kev
     MouseMotionEvent mmev       -> handleMouseMotionEvent mmev
     MouseButtonEvent mbev       -> handleMouseButtonEvent mbev
@@ -70,13 +77,13 @@ handleResizeEvent :: WindowSizeChangedEventData -> World -> Maybe World
 handleResizeEvent sev w = Just 
     . set (config . windowX) (fromIntegral x)
     . set (config . windowY) (fromIntegral y)
-    $ over sideEffects up
+    $ over sideEffects (sideEffectUpdatePreload divRes x y)
     w
   where 
-    up :: (World -> IO World) -> World -> IO World
-    up f w' = do
-        pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData w')
-        f $ w' & preloadData .~ pdata
+--    up :: (World -> IO World) -> World -> IO World
+--    up f w' = do
+--        pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData w')
+--        f $ w' & preloadData .~ pdata
     x = fromIntegral x'
     y = fromIntegral y'
     V2 x' y' = windowSizeChangedEventSize sev

src/Dodge/Menu.hs

@@ -159,11 +159,16 @@ pauseMenuOptions =
 startNewGame :: World -> Maybe World
 startNewGame w = Just $ w
     & menuLayers .~ [WaitScreen (const "GENERATING...") 1]
-    & sideEffects .~ const (generateWorldFromSeed i <&> keyConfig .~ _keyConfig w <&> config .~ _config w
-        <&> preloadData .~ _preloadData w) -- this kills save games etc...
+    & sideEffects .~  uvWorld (uvWorldSideEffects i w)
   where
     i = fst $ random (_randGen w)
 
+uvWorldSideEffects :: Int -> World -> b -> IO World
+uvWorldSideEffects i w = const (generateWorldFromSeed i <&> keyConfig .~ _keyConfig w <&> config .~ _config w
+        <&> preloadData .~ _preloadData w)
+-- this kills save games etc...
+
+
 -- | hacky
 scodeToChar :: Scancode -> Char
 scodeToChar = toEnum . (+ 61) . fromIntegral . toNumber
@@ -176,10 +181,10 @@ updateFramebufferSize w = w & sideEffects %~ up
   where 
     (x,y) = (round $ getWindowX w, round $ getWindowY w)
     divRes = w ^. config . resolution_factor
-    up :: (World -> IO World) -> World -> IO World
+    up :: (Universe -> IO Universe) -> Universe -> IO Universe
     up f w' = do
-        pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData w')
-        f $ w' & preloadData .~ pdata
+        pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData (_uvWorld w'))
+        f $ w' & uvWorld . preloadData .~ pdata
     
 --levelMenu :: Int -> ScreenLayer
 --levelMenu x = OptionScreen