Nest fields in CWorld

src/Dodge/Data/CWorld.hs

@@ -184,15 +184,11 @@ data CWorld = CWorld
     , _seenLocations :: IM.IntMap (WdP2, String)
     , _selLocation :: Int
     , _distortions :: [Distortion]
-    , _worldBounds :: Bounds
-    , _gameRooms :: [GameRoom] -- consider using an IntMap
-    , _roomClipping :: [ConvexPoly]
     , _maybeWorld :: Maybe' CWorld
     , _rewindWorlds :: [CWorld]
     , _worldClock :: Int
-    , _genParams :: GenParams
     , _deathDelay :: Maybe Int
-    , _cwSeed :: Int
+    , _cwGen :: CWGen
     }
 
 data CWGen = CWGen
@@ -200,6 +196,7 @@ data CWGen = CWGen
     , _cwgWorldBounds :: Bounds
     , _cwgGameRooms :: [GameRoom] -- consider using an IntMap
     , _cwgRoomClipping :: [ConvexPoly]
+    , _cwgSeed :: Int
     }
 
 data WorldBeams = WorldBeams
@@ -213,9 +210,11 @@ data WorldBeams = WorldBeams
 deriveJSON defaultOptions ''CWorld
 deriveJSON defaultOptions ''WorldBeams
 deriveJSON defaultOptions ''CWCam
+deriveJSON defaultOptions ''CWGen
 makeLenses ''CWorld
 makeLenses ''WorldBeams
 makeLenses ''CWCam
+makeLenses ''CWGen
 -- $($(derive [d|
 --     instance Deriving (Store CWorld)
 --     |]))

src/Dodge/Default/World.hs

@@ -1,6 +1,5 @@
 module Dodge.Default.World where
 
-import MaybeHelp
 import Data.Graph.Inductive.Graph hiding ((&))
 import qualified Data.Map as M
 import qualified Data.Set as S
@@ -8,6 +7,7 @@ import Dodge.Data.World
 import Geometry.Data
 import Geometry.Polygon
 import qualified IntMapHelp as IM
+import MaybeHelp
 import System.Random
 
 --import Data.Graph.Inductive.NodeMap
@@ -33,8 +33,19 @@ defaultWorld =
         , _rbOptions = NoRightButtonOptions
         }
 
+defaultCWGen :: CWGen
+defaultCWGen =
+    CWGen
+        { _cwgParams = GenParams M.empty
+        , _cwgSeed = 0
+        , _cwgWorldBounds = defaultBounds
+        , _cwgGameRooms = []
+        , _cwgRoomClipping = []
+        }
+
 defaultCWCam :: CWCam
-defaultCWCam = CWCam
+defaultCWCam =
+    CWCam
         { _cwcCenter = V2 0 0
         , _cwcRot = 0
         , _cwcZoom = 1
@@ -45,12 +56,12 @@ defaultCWCam = CWCam
         , _cwcBoundBox = square 100
         , _cwcBoundDist = (100, -100, 100, -100)
         }
-    
 
 defaultCWorld :: CWorld
 defaultCWorld =
     CWorld
         { _cwCam = defaultCWCam
+        , _cwGen = defaultCWGen
         , _magnets = IM.empty
         , _modifications = IM.empty
         , _creatures = IM.empty
@@ -120,15 +131,10 @@ defaultCWorld =
         , _selLocation = 0
         , _foregroundShapes = mempty
         , _distortions = []
-        , _gameRooms = []
-        , _roomClipping = []
         , _worldClock = 0
-        , _worldBounds = defaultBounds
         , _maybeWorld = Nothing'
         , _rewindWorlds = []
-        , _genParams = GenParams M.empty
         , _deathDelay = Nothing
-        , _cwSeed = 0
         }
 
 defaultWorldHammers :: M.Map WorldHammer HammerPosition

src/Dodge/Layout.hs

@@ -43,7 +43,7 @@ generateLevelFromRoomList gr' w =
         . setFloors
         . worldToGenWorld rs'
         $ w & cWorld . walls .~ wallsFromRooms rs
-            & cWorld . gameRooms .~ gameRoomsFromRooms (IM.elems rs')
+            & cWorld . cwGen . cwgGameRooms .~ gameRoomsFromRooms (IM.elems rs')
             & cWorld . pathGraph .~ path
             & cWorld . pnZoning .~ foldl' (flip zonePn) mempty (labNodes path)
             & cWorld . peZoning .~ foldl' (flip zonePe) mempty (labEdges path)
@@ -129,7 +129,7 @@ doRoomPlacements w rm = foldl' (\wr -> fst . placeSpot wr) (w, rm) $ _rmPmnts rm
 
 setupWorldBounds :: World -> World
 setupWorldBounds w =
-    w & cWorld . worldBounds
+    w & cWorld . cwGen . cwgWorldBounds
         %~ ( (bdMinX .~ f minx)
                 . (bdMaxX .~ f maxx)
                 . (bdMinY .~ f miny)

src/Dodge/LevelGen.hs

@@ -27,8 +27,8 @@ generateWorldFromSeed i = do
     return $
         postGenerationProcessing $
             _gwWorld (generateLevelFromRoomList roomList initialWorld{_randGen = mkStdGen i})
-                & cWorld . roomClipping .~ bounds
-                & cWorld . cwSeed .~ i
+                & cWorld . cwGen . cwgRoomClipping .~ bounds
+                & cWorld . cwGen . cwgSeed .~ i
 
 postGenerationProcessing :: World -> World
 postGenerationProcessing w = foldl' assignPushDoors w (_doors (_cWorld w))

src/Dodge/LevelGen/LevelStructure.hs

@@ -14,7 +14,7 @@ import RandomHelp
 worldToGenWorld :: IM.IntMap Room -> World -> GenWorld
 worldToGenWorld rms w =
     GenWorld
-        { _gwWorld = w & cWorld . genParams .~ evalState generateGenParams (_randGen w)
+        { _gwWorld = w & cWorld . cwGen . cwgParams .~ evalState generateGenParams (_randGen w)
         , _genRooms = rms
         , _genPlacements = mempty
         }

src/Dodge/Picture/SizeInvariant.hs

@@ -83,4 +83,4 @@ absClamp ::
     Float ->
     Float ->
     Float
-absClamp maxVal x = max (negate maxVal) $ min maxVal x
+absClamp maxVal = max (negate maxVal) . min maxVal

src/Dodge/Placement/Instance/Sensor.hs

@@ -35,7 +35,7 @@ damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $
                                 False
                                 0
                                 dt
-                                (_sensorCoding (_genParams (_cWorld gw)) M.! dt)
+                                (_sensorCoding (_cwgParams $ _cwGen (_cWorld gw)) M.! dt)
                                 (damageTypeThreshold dt)
                             )
                 )

src/Dodge/Render/ShapePicture.hs

@@ -449,14 +449,14 @@ viewBoundaries w =
             <> color yellow (foldMap (\q -> line [p, q]) $ farWallPoints p w)
   where
     p = _crPos $ you w
-    grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms (_cWorld w))
+    grs = filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen (_cWorld w))
 
 viewClipBounds :: Configuration -> World -> Picture
 viewClipBounds cfig w
     | _debug_view_clip_bounds cfig == AllRoomClipBoundaries =
-        setLayer DebugLayer $ color green $ foldMap (polygonWire . _cpPoints) (_roomClipping (_cWorld w))
+        setLayer DebugLayer $ color green $ foldMap (polygonWire . _cpPoints) (_cwgRoomClipping $ _cwGen (_cWorld w))
     | _debug_view_clip_bounds cfig == IntersectingRoomClipBoundaries =
-        setLayer DebugLayer $ f (_roomClipping (_cWorld w))
+        setLayer DebugLayer $ f (_cwgRoomClipping $ _cwGen (_cWorld w))
     | otherwise = mempty
   where
     f (x : xs) = g x xs <> f xs

src/Dodge/Terminal.hs

@@ -170,7 +170,7 @@ guardDisconnected tm w w' = case _tmStatus tm of
     TerminalReady -> w'
 
 getDamageCoding :: World -> M.Map String [TerminalLine]
-getDamageCoding = decodedtmap . _sensorCoding . _genParams . _cWorld
+getDamageCoding = decodedtmap . _sensorCoding . _cwgParams . _cwGen . _cWorld
 
 sensorInfoMap :: Terminal -> World -> M.Map String [TerminalLine]
 sensorInfoMap tm w =

src/Dodge/Update/Camera.hs

@@ -230,7 +230,7 @@ streamViewpoints :: Monad m => Point2 -> World -> Stream (Of Point2) m ()
 {-# INLINE streamViewpoints #-}
 streamViewpoints p w =
     flip S.for (gameRoomViewpoints p) $
-        S.filter (pointInOrOnPolygon p . _grBound) $ S.each (_gameRooms (_cWorld w))
+        S.filter (pointInOrOnPolygon p . _grBound) $ S.each (_cwgGameRooms $ _cwGen (_cWorld w))
 
 gameRoomViewpoints :: Monad m => Point2 -> GameRoom -> Stream (Of Point2) m ()
 gameRoomViewpoints p gr =
@@ -264,7 +264,7 @@ extendedViewPoints p grs =
 farWallPoints :: Point2 -> World -> [Point2]
 farWallPoints p w = concatMap _grViewpoints grs ++ extendedViewPoints p grs
   where
-    grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms (_cWorld w))
+    grs = filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen (_cWorld w))
 
 maxViewDistance :: Float
 maxViewDistance = 800