Move past/future worlds outside of serialised data structure

appDodge/Main.hs

@@ -118,7 +118,7 @@ updateRenderSplit win u = do
     return $! updateUniverse u
 
 playSoundUnlessRewinding :: Universe -> IO (M.Map SoundOrigin Sound)
-playSoundUnlessRewinding u = case w ^. cWorld . timeFlow of
+playSoundUnlessRewinding u = case w ^. timeFlow of
     NormalTimeFlow -> playSoundAndUpdate (_soundData $ _preloadData u) (_playingSounds w) (_toPlaySounds w)
     _ -> stopAllSounds >> return M.empty
   where

src/Dodge/Data/CWorld.hs

@@ -27,33 +27,12 @@ data CWorld = CWorld
     , _cwCamPos :: CamPos
     , _cwGen :: CWGen
     , _cClock :: Int
-    , _pastWorlds :: [LWorld]
-    , _timeFlow :: TimeFlowStatus
     , _seenWalls :: IS.IntSet
     , _cwTiles :: [Tile]
     , _pathGraph :: Gr Point2 PathEdge
     , _numberFloorVerxs :: Int
     }
 
-data TimeFlowStatus
-    = DeathTime
-        { _deathDelay :: Int }
-    | NormalTimeFlow
-    | ScrollTimeFlow
-        { _scrollSmoothing :: Int 
-        , _reverseAmount :: Int
-        , _futureWorlds :: [LWorld]
-        , _scrollItemLocation :: Int
-        }
-    | RewindLeftClick
-        { _reverseAmount :: Int 
-        , _scrollItemLocation :: Int
-        }
-    | PausedTimeFlow
-        { _timeFlowCharge :: Int 
-        , _scrollItemLocation :: Int
-        }
-
 data CWGen = CWGen
     { _cwgParams :: GenParams
     , _cwgWorldBounds :: Bounds
@@ -67,11 +46,10 @@ data CWGen = CWGen
 
 makeLenses ''CWorld
 makeLenses ''CWGen
-makeLenses ''TimeFlowStatus
 concat
     <$> mapM
         (deriveJSON defaultOptions)
         [ ''CWGen
         , ''CWorld
-        , ''TimeFlowStatus
+--        , ''TimeFlowStatus
         ]

src/Dodge/Data/World.hs

@@ -34,6 +34,8 @@ data WorldEventFlag = InventoryChange
 
 data World = World
     { _cWorld :: CWorld
+    , _pastWorlds :: [LWorld]
+    , _timeFlow :: TimeFlowStatus
     , _randGen :: StdGen
     , _toPlaySounds :: M.Map SoundOrigin Sound
     , _playingSounds :: M.Map SoundOrigin Sound
@@ -50,6 +52,27 @@ data World = World
     , _gsZoning :: IntMap (IntMap IntSet)
     }
 
+data TimeFlowStatus
+    = DeathTime
+        { _deathDelay :: Int }
+    | NormalTimeFlow
+    | ScrollTimeFlow
+        { _scrollSmoothing :: Int 
+        , _reverseAmount :: Int
+        , _futureWorlds :: [LWorld]
+        , _scrollItemLocation :: Int
+        }
+    | RewindLeftClick
+        { _reverseAmount :: Int 
+        , _scrollItemLocation :: Int
+        }
+    | PausedTimeFlow
+        { _timeFlowCharge :: Int 
+        , _scrollItemLocation :: Int
+        }
+
+
 --    deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
+makeLenses ''TimeFlowStatus
 makeLenses ''World

src/Dodge/Default/World.hs

@@ -34,6 +34,8 @@ defaultWorld :: World
 defaultWorld =
     World
         { _cWorld = defaultCWorld
+        , _pastWorlds = mempty
+        , _timeFlow = NormalTimeFlow
         , _input = defaultInput
         , _toPlaySounds = M.empty
         , _playingSounds = M.empty
@@ -81,8 +83,6 @@ defaultCWorld =
         , _lWorld = defaultLWorld
         , _cwGen = defaultCWGen
         , _cClock = 0
-        , _pastWorlds = []
-        , _timeFlow = NormalTimeFlow
         , _seenWalls = mempty
         , _pathGraph = Data.Graph.Inductive.Graph.empty
         , _cwTiles = mempty

src/Dodge/Luse.hs

@@ -23,14 +23,14 @@ useL lu = case lu of
 
 useStopWatch :: Item -> Creature -> World -> World
 useStopWatch itm _ w = w 
-    & cWorld . timeFlow .~ PausedTimeFlow 
+    & timeFlow .~ PausedTimeFlow 
         { _timeFlowCharge = itm ^?! itUse . leftConsumption . wpCharge
         , _scrollItemLocation = _itID itm
         }
 
 
 useTimeScrollGun :: Item -> Creature -> World -> World
-useTimeScrollGun itm _ w = w & cWorld . timeFlow .~ ScrollTimeFlow
+useTimeScrollGun itm _ w = w & timeFlow .~ ScrollTimeFlow
     { _scrollSmoothing = 0
     , _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge
     , _futureWorlds = []
@@ -40,7 +40,7 @@ useTimeScrollGun itm _ w = w & cWorld . timeFlow .~ ScrollTimeFlow
 
 useRewindGun :: Item -> Creature -> World -> World
 useRewindGun itm _ w = w 
-    & cWorld . timeFlow .~ RewindLeftClick 
+    & timeFlow .~ RewindLeftClick 
         { _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge
         , _scrollItemLocation = _itID itm
         }

src/Dodge/Update.hs

@@ -129,17 +129,17 @@ updateUniverseMid u = case _uvScreenLayers u of
     [] -> timeFlowUpdate u
 
 timeFlowUpdate :: Universe -> Universe
-timeFlowUpdate u = case u ^. uvWorld . cWorld . timeFlow of
+timeFlowUpdate u = case u ^. uvWorld . timeFlow of
     NormalTimeFlow -> functionalUpdate u
     ScrollTimeFlow smoothing _ _ _ -> over uvWorld (doTimeScroll smoothing) u
-    RewindLeftClick 0 _ -> u & uvWorld . cWorld . timeFlow .~ NormalTimeFlow
+    RewindLeftClick 0 _ -> u & uvWorld . timeFlow .~ NormalTimeFlow
     RewindLeftClick _ _ -> over uvWorld scrollTimeBack u -- & uvWorld . cWorld . timeFlow .~ NormalTimeFlow
     DeathTime{} -> u
     PausedTimeFlow _ itmloc -> over uvWorld (pauseTime itmloc) u
 
 pauseTime :: Int -> World -> World
 pauseTime itmloc w
-    | justPressedButtonLeft || outofcharge = w & cWorld . timeFlow .~ NormalTimeFlow
+    | justPressedButtonLeft || outofcharge = w & timeFlow .~ NormalTimeFlow
     | otherwise = w & pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix itmloc) . itUse . leftConsumption . wpCharge -~ 1
   where
     justPressedButtonLeft = w ^? input . mouseButtons . ix ButtonLeft == Just False
@@ -148,48 +148,48 @@ pauseTime itmloc w
 
 doTimeScroll :: Int -> World -> World
 doTimeScroll smoothing w = case w ^? input . mouseButtons . ix ButtonLeft of
-    Just False -> w & cWorld . timeFlow .~ NormalTimeFlow
+    Just False -> w & timeFlow .~ NormalTimeFlow
     _ -> doTimeScroll' smoothing w
 
 doTimeScroll' :: Int -> World -> World
 doTimeScroll' smoothing w = case w ^. input . scrollAmount of
-    x | x > 1 -> w & scrollTimeBack & cWorld . timeFlow . scrollSmoothing .~ 20
+    x | x > 1 -> w & scrollTimeBack & timeFlow . scrollSmoothing .~ 20
-    x | x > 0 -> w & scrollTimeBack & cWorld . timeFlow . scrollSmoothing %~ max 0
+    x | x > 0 -> w & scrollTimeBack & timeFlow . scrollSmoothing %~ max 0
-    x | x < (-1) -> w & scrollTimeForward & cWorld . timeFlow . scrollSmoothing .~ negate 20
+    x | x < (-1) -> w & scrollTimeForward & timeFlow . scrollSmoothing .~ negate 20
-    x | x < 0 -> w & scrollTimeForward & cWorld . timeFlow . scrollSmoothing %~ min 0
+    x | x < 0 -> w & scrollTimeForward & timeFlow . scrollSmoothing %~ min 0
-    _ | smoothing > 0 -> scrollTimeBack w & cWorld . timeFlow . scrollSmoothing -~ 1
+    _ | smoothing > 0 -> scrollTimeBack w & timeFlow . scrollSmoothing -~ 1
-    _ | smoothing < 0 -> scrollTimeForward w & cWorld . timeFlow . scrollSmoothing +~ 1
+    _ | smoothing < 0 -> scrollTimeForward w & timeFlow . scrollSmoothing +~ 1
     _ -> w
 
 scrollTimeBack :: World -> World
-scrollTimeBack w = case w ^? cWorld . pastWorlds . _head of
+scrollTimeBack w = case w ^? pastWorlds . _head of
     Nothing -> w
-    Just lw -> case w ^?! cWorld . timeFlow . reverseAmount of
+    Just lw -> case w ^?! timeFlow . reverseAmount of
         x
             | x > 0 ->
-                w & cWorld . pastWorlds %~ tail
+                w & pastWorlds %~ tail
-                    & cWorld . timeFlow . futureWorlds .:~ (w ^. cWorld . lWorld)
+                    & timeFlow . futureWorlds .:~ (w ^. cWorld . lWorld)
-                    & cWorld . timeFlow . reverseAmount -~ 1
+                    & timeFlow . reverseAmount -~ 1
                     & cWorld . lWorld .~ lw
                     & pointituse . leftConsumption . wpCharge .~ (x -1)
                     & pointituse . leftHammer .~ HammerDown
         _ -> w
   where
     pointituse = pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix i) . itUse
-    i = w ^?! cWorld . timeFlow . scrollItemLocation
+    i = w ^?! timeFlow . scrollItemLocation
 
 scrollTimeForward :: World -> World
-scrollTimeForward w = case w ^? cWorld . timeFlow . futureWorlds . _head of
+scrollTimeForward w = case w ^? timeFlow . futureWorlds . _head of
     Nothing -> w
     Just lw ->
-        w & cWorld . timeFlow . futureWorlds %~ tail
+        w & timeFlow . futureWorlds %~ tail
-            & cWorld . pastWorlds .:~ (w ^. cWorld . lWorld)
+            & pastWorlds .:~ (w ^. cWorld . lWorld)
             & cWorld . lWorld .~ lw
-            & cWorld . timeFlow . reverseAmount .~ ramount
+            & timeFlow . reverseAmount .~ ramount
             & pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix i) . itUse . leftConsumption . wpCharge .~ ramount
   where
-    i = w ^?! cWorld . timeFlow . scrollItemLocation
+    i = w ^?! timeFlow . scrollItemLocation
-    ramount = (w ^?! cWorld . timeFlow . reverseAmount) + 1
+    ramount = (w ^?! timeFlow . reverseAmount) + 1
 
 -- | The update step.
 functionalUpdate :: Universe -> Universe
@@ -242,7 +242,7 @@ functionalUpdate w =
         . over uvWorld zoneClouds
         . over uvWorld zoneCreatures
         -- . over uvWorld updateInventorySelectionList
-        $ over (uvWorld . cWorld) updatePastWorlds w
+        $ over uvWorld updatePastWorlds w
 
 updateWheelEvents :: World -> World
 updateWheelEvents w
@@ -257,8 +257,8 @@ advanceScrollAmount u =
         & uvWorld . input . previousScrollAmount .~ _scrollAmount (_input $ _uvWorld u)
         & uvWorld . input . scrollAmount .~ 0
 
-updatePastWorlds :: CWorld -> CWorld
+updatePastWorlds :: World -> World
-updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 100 . ((w ^. lWorld) :))
+updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 100 . ((w ^. cWorld . lWorld) :))
 
 --updatePastWorlds w = w & pastWorlds .~ []
 
@@ -354,8 +354,9 @@ setOldPos cr =
 --    Nothing' -> w & timeFlow .~ NormalTimeFlow
 
 zoneCreatures :: World -> World
-zoneCreatures w = w & crZoning 
+zoneCreatures w =
-    .~ foldl' (flip zoneCreature) mempty (w ^. cWorld . lWorld . creatures)
+    w & crZoning
+        .~ foldl' (flip zoneCreature) mempty (w ^. cWorld . lWorld . creatures)
 
 --        foldl' (flip $ updateZoning (\cr -> IM.insert (_crID cr) cr))
 --            zn (_creatures w)
@@ -567,12 +568,12 @@ markWallSeen w i = w & cWorld . seenWalls . at i ?~ ()
 --markSeen wl = wl{_wlSeen = True}
 
 checkEndGame :: Universe -> Universe
-checkEndGame uv = case w ^? cWorld . timeFlow . deathDelay of
+checkEndGame uv = case w ^? timeFlow . deathDelay of
     Just x
         | x < 0 ->
             uv & uvScreenLayers .~ [gameOverMenu uv]
-    Just _ -> uv & uvWorld . cWorld . timeFlow . deathDelay -~ 1
+    Just _ -> uv & uvWorld . timeFlow . deathDelay -~ 1
-    _ | _crHP (you w) < 1 -> uv & uvWorld . cWorld . timeFlow .~ DeathTime 50
+    _ | _crHP (you w) < 1 -> uv & uvWorld . timeFlow .~ DeathTime 50
     _ -> uv
   where
     w = _uvWorld uv