Separate out concrete part of world

src/Dodge/Placement/PlaceSpot/Block.hs

@@ -23,7 +23,7 @@ plBlock
     -> (Int,World)
 plBlock [] _ _ _ = error "Trying to add a block with incomplete polygon"
 plBlock (p:ps) bl wl w = (,) blid $ w
-    & blocks . at blid ?~ bl 
+    & cWorld . blocks . at blid ?~ bl 
         { _blID = blid
         , _blWallIDs = IS.fromList is
         , _blShadows = []
@@ -31,9 +31,9 @@ plBlock (p:ps) bl wl w = (,) blid $ w
         }
     & insertWalls blid wls
   where 
-    blid = IM.newKey $ _blocks w
+    blid = IM.newKey $ _blocks (_cWorld w)
     lns = zip (p:ps) (ps ++ [p])
-    i = IM.newKey $ _walls w
+    i = IM.newKey $ _walls (_cWorld w)
     is = [i.. i + length lns-1]
     wls = zipWith 
         (\j ln -> wl & wlLine .~ ln & wlID .~ j & wlStructure .~ BlockPart blid) 
@@ -62,11 +62,11 @@ plLineBlock basePane blwidth a b gw = ( 0
     cornerPoints = reverse $ rectWH halfBlockWidth depth -- goes clockwise around the block
     cornersAt p = fmap ( (p +.+) . rotateV (argV (b -.- a)) ) cornerPoints
     linesAt p = loopPairs $ cornersAt p
-    wlid = IM.newKey $ _walls gw
-    blid = IM.newKey $ _blocks gw
+    wlid = IM.newKey $ _walls (_cWorld gw)
+    blid = IM.newKey $ _blocks (_cWorld gw)
     insertBlock (i,p) = 
         insertWalls (i + blid) (makeWallAt p i)
-        . over blocks (IM.insert (i+blid) Block 
+        . over (cWorld . blocks) (IM.insert (i+blid) Block 
         { _blID = i + blid, _blWallIDs = IS.fromList $ ksAtI i
         , _blHP = 1000, _blShadows = shadowsAt i
         , _blDir = 0    -- THIS IS NOT SENSIBLE. TODO rethink block positioning
@@ -96,10 +96,10 @@ plLineBlock basePane blwidth a b gw = ( 0
 
 -- | Must be done after inserting the block
 insertWalls :: Int -> [Wall] -> World -> World
-insertWalls blid wls w = w' & blocks . ix blid . blObstructs .~ concat paths
+insertWalls blid wls w = w' & cWorld . blocks . ix blid . blObstructs .~ concat paths
   where
     (w',paths) = mapAccumR (flip insertWall) w wls
 
 insertWall :: Wall -> World -> (World,[(Int,Int,PathEdge)])
 insertWall wl = uncurry (obstructPathsCrossing BlockObstacle) (_wlLine wl)
-    . (walls . at (_wlID wl) ?~ wl)
+    . (cWorld . walls . at (_wlID wl) ?~ wl)

src/Dodge/Placement/PlaceSpot/TriggerDoor.hs

@@ -27,9 +27,9 @@ plDoor :: Color
                     -- Bumped out up and down by 9, not widened
     -> World
     -> (Int,World)
-plDoor col eo cond pss gw = (drid, addWalls $ gw & doors %~ addDoor) -- carefull with the ordering of addWalls
+plDoor col eo cond pss gw = (drid, addWalls $ gw & cWorld . doors %~ addDoor) -- carefull with the ordering of addWalls
   where
-    drid = IM.newKey $ _doors gw
+    drid = IM.newKey $ _doors (_cWorld gw)
     addDoor = IM.insert drid $ defaultDoor
         { _drID = drid
         , _drWallIDs = IS.fromList wlids
@@ -42,18 +42,18 @@ plDoor col eo cond pss gw = (drid, addWalls $ gw & doors %~ addDoor) -- carefull
         , _drObstacleType = eo
         }
     nsteps = length pss - 1
-    wlids = take 4 [IM.newKey $ _walls gw ..]
+    wlids = take 4 [IM.newKey $ _walls (_cWorld gw) ..]
     wlps' = uncurry (rectanglePairs 9) $ head pss
     addWalls w' = foldl' (addDoorWall eo drid $ switchWallCol col) w' $ zip wlids wlps'
 
 addDoorWall :: EdgeObstacle -> Int -> Wall -> World -> (Int,(Point2,Point2)) -> World
 addDoorWall eo drid wl w (wlid,wlps) = w' 
-    & walls %~ IM.insert wlid wl
+    & cWorld . walls %~ IM.insert wlid wl
         { _wlLine = wlps
         , _wlID = wlid
         , _wlStructure = DoorPart drid
         }
-    & doors . ix drid . drObstructs .++~ es
+    & cWorld . doors . ix drid . drObstructs .++~ es
   where
     (w',es) = uncurry (obstructPathsCrossing eo) wlps w
 
@@ -63,9 +63,9 @@ maybeClearDoorPaths eo es w = foldl' (maybeClearDoorPath eo) w es
 maybeClearDoorPath :: EdgeObstacle -> World -> (Int,Int,PathEdge) -> World
 maybeClearDoorPath eo w (x,y,pe)
     | not . null $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w 
-        = w & pathGraph %~ FGL.insEdge (x,y,pe & peObstacles . at eo ?~ ()) . FGL.delEdge (x,y)
+        = w & cWorld . pathGraph %~ FGL.insEdge (x,y,pe & peObstacles . at eo ?~ ()) . FGL.delEdge (x,y)
     | otherwise 
-        = w & pathGraph %~ FGL.insEdge (x,y,pe & peObstacles . at eo .~ Nothing) . FGL.delEdge (x,y) 
+        = w & cWorld . pathGraph %~ FGL.insEdge (x,y,pe & peObstacles . at eo .~ Nothing) . FGL.delEdge (x,y) 
 
 plSlideDoor 
     :: Door 
@@ -77,9 +77,9 @@ plSlideDoor
     -> World
     -> (Int, World)
 plSlideDoor dr wl eo shiftOffset a b gw 
-    = (drid, addDoorWalls $ gw & doors %~ addDoor)
+    = (drid, addDoorWalls $ gw & cWorld . doors %~ addDoor)
   where
-    drid = IM.newKey $ _doors gw
+    drid = IM.newKey $ _doors (_cWorld gw)
     addDoor = IM.insert drid $ dr
         { _drID = drid
         , _drWallIDs = IS.fromList wlids
@@ -93,7 +93,7 @@ plSlideDoor dr wl eo shiftOffset a b gw
     addDoorWalls w' = foldl' (addDoorWall eo drid wl) w' $ zip wlids pairs
     pairs = rectanglePairs 9 a b
     shiftLeft  = (+.+ (a -.- b +.+ shiftOffset *.* normalizeV (b -.- a)))
-    wlids = take 4 [IM.newKey $ _walls gw ..]
+    wlids = take 4 [IM.newKey $ _walls (_cWorld gw) ..]
 -- old code that may help with pathing
 --import Dodge.LevelGen.Pathing
 --import Data.Graph.Inductive hiding ((&))