Allow for placements to use/update the full GenWorld

src/Dodge/Placement/PlaceSpot/Block.hs

@@ -10,7 +10,7 @@ import Control.Lens
 import qualified Data.IntSet as IS
 import Data.List
 import Dodge.Base
-import Dodge.Data.World
+import Dodge.Data.GenWorld
 import Dodge.Path
 import Geometry
 import qualified IntMapHelp as IM
@@ -21,24 +21,24 @@ plBlock ::
     Block ->
     -- | Base Pane
     Wall ->
-    World ->
-    (Int, World)
+    GenWorld ->
+    (Int, GenWorld)
 plBlock [] _ _ _ = error "Trying to add a block with incomplete polygon"
 plBlock (p : ps) bl wl w =
     (,) blid $
         w
-            & cWorld . lWorld . blocks . at blid
+            & gwWorld . cWorld . lWorld . blocks . at blid
                 ?~ bl
                     { _blID = blid
                     , _blWallIDs = IS.fromList is
                     , _blShadows = []
                     , _blFootprint = p : ps
                     }
-            & insertWalls blid wls
+            & gwWorld %~ insertWalls blid wls
   where
-    blid = IM.newKey $ w ^. cWorld . lWorld . blocks
+    blid = IM.newKey $ w ^. gwWorld . cWorld . lWorld . blocks
     lns = zip (p : ps) (ps ++ [p])
-    i = IM.newKey $ w ^. cWorld . lWorld . walls
+    i = IM.newKey $ w ^. gwWorld . cWorld . lWorld . walls
     is = [i .. i + length lns -1]
     wls =
         zipWith
@@ -55,12 +55,12 @@ plLineBlock ::
     Point2 ->
     -- | End point (symmetric)
     Point2 ->
-    World ->
-    (Int, World)
+    GenWorld ->
+    (Int, GenWorld)
 plLineBlock basePane blwidth a b gw =
     ( 0
     , --    , foldr insertWall (insertBlocks gw) listWalls
-      insertBlocks gw
+      over gwWorld insertBlocks gw
     )
   where
     depth = blwidth
@@ -72,8 +72,8 @@ plLineBlock basePane blwidth a b gw =
     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 $ gw ^. cWorld . lWorld . walls
-    blid = IM.newKey $ gw ^. cWorld . lWorld . blocks
+    wlid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . walls
+    blid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . blocks
     insertBlock (i, p) =
         insertWalls (i + blid) (makeWallAt p i)
             . over

src/Dodge/Placement/PlaceSpot/TriggerDoor.hs

@@ -4,12 +4,12 @@ module Dodge.Placement.PlaceSpot.TriggerDoor (
     maybeClearDoorPaths,
 ) where
 
+import Dodge.Data.GenWorld
 import Data.Set (Set)
 import qualified Data.Graph.Inductive as FGL
 import qualified Data.IntSet as IS
 import Data.List
 import Dodge.Base
-import Dodge.Data.World
 import Dodge.Default.Door
 import Dodge.LevelGen.DoorPane
 import Dodge.Path
@@ -27,11 +27,11 @@ plDoor ::
     -- | Door positions, closed to open.
     -- Bumped out up and down by 9, not widened
     [(Point2, Point2)] ->
-    World ->
-    (Int, World)
-plDoor col eo cond pss gw = (drid, addWalls $ gw & cWorld . lWorld . doors %~ addDoor) -- carefull with the ordering of addWalls
+    GenWorld ->
+    (Int, GenWorld)
+plDoor col eo cond pss gw = (drid, over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors %~ addDoor) -- carefull with the ordering of addWalls
   where
-    drid = IM.newKey $ _doors (_lWorld (_cWorld gw))
+    drid = IM.newKey $ _doors (_lWorld (_cWorld $ _gwWorld gw))
     addDoor =
         IM.insert drid $
             defaultDoor
@@ -46,7 +46,7 @@ plDoor col eo cond pss gw = (drid, addWalls $ gw & cWorld . lWorld . doors %~ ad
                 , _drObstacleType = eo
                 }
     nsteps = length pss - 1
-    wlids = take 4 [IM.newKey $ _walls (_lWorld (_cWorld gw)) ..]
+    wlids = take 4 [IM.newKey $ _walls (_lWorld (_cWorld $ _gwWorld gw)) ..]
     wlps' = uncurry (rectanglePairs 9) $ head pss
     addWalls w' = foldl' (addDoorWall eo drid $ switchWallCol col) w' $ zip wlids wlps'
 
@@ -82,12 +82,12 @@ plSlideDoor ::
     Float ->
     Point2 ->
     Point2 ->
-    World ->
-    (Int, World)
+    GenWorld ->
+    (Int, GenWorld)
 plSlideDoor dr wl eo shiftOffset a b gw =
-    (drid, addDoorWalls $ gw & cWorld . lWorld . doors %~ addDoor)
+    (drid, over gwWorld addDoorWalls $ gw & gwWorld . cWorld . lWorld . doors %~ addDoor)
   where
-    drid = IM.newKey $ _doors (_lWorld (_cWorld gw))
+    drid = IM.newKey $ _doors (_lWorld (_cWorld $ _gwWorld gw))
     addDoor =
         IM.insert drid $
             dr
@@ -103,7 +103,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 (_lWorld (_cWorld gw)) ..]
+    wlids = take 4 [IM.newKey $ _walls (_lWorld (_cWorld $ _gwWorld gw)) ..]
 
 -- old code that may help with pathing
 --import Dodge.LevelGen.Pathing