Improve some door placement

src/Dodge/Placement/PlaceSpot/Block.hs

@@ -2,16 +2,18 @@
 module Dodge.Placement.PlaceSpot.Block (
     plBlock,
     plLineBlock,
+    insertWall,
+    insertStructureWalls,
 ) where
 
-import Dodge.Wall.Pathing
-import qualified Data.Set as S
 import Control.Lens
 import qualified Data.IntSet as IS
 import Data.List
+import qualified Data.Set as S
 import Dodge.Base
 import Dodge.Data.GenWorld
 import Dodge.Path
+import Dodge.Wall.Pathing
 import Geometry
 import qualified IntMapHelp as IM
 
@@ -26,15 +28,26 @@ plBlock ps bl wl w =
                     , _blShadows = []
                     , _blFootprint = ps
                     }
-            & gwWorld %~ insertWalls wls
+            & gwWorld %~ insertStructureWalls BlockPart wl ps blid i
   where
     blid = IM.newKey $ w ^. gwWorld . cWorld . lWorld . blocks
     i = IM.newKey $ w ^. gwWorld . cWorld . lWorld . walls
-    is = take (length ps) [i .. ]
+    is = take (length ps) [i ..]
+
+insertStructureWalls ::
+    (Int -> WallStructure) ->
+    Wall ->
+    [Point2] ->
+    Int ->
+    Int ->
+    World ->
+    World
+insertStructureWalls f wl ps sid wid = insertWalls wls
+  where
     wls =
         zipWith
-            (\j ln -> wl & wlLine .~ ln & wlID .~ j & wlStructure .~ BlockPart blid)
-            is
+            (\i xy -> wl & wlLine .~ xy & wlID .~ i & wlStructure .~ f sid)
+            [wid ..]
             (loopPairs ps)
 
 -- | Splits a line into many four cornered blocks.
@@ -107,6 +120,7 @@ insertWalls wls w = foldl' (flip insertWall) w wls
 
 insertWall :: Wall -> World -> World
 insertWall wl =
-    uncurry (obstructPathsCrossing (S.map WallObstacle $ getWallPathing wl))
+    uncurry
+        (obstructPathsCrossing (S.map WallObstacle $ getWallPathing wl))
         (_wlLine wl)
         . (cWorld . lWorld . walls . at (_wlID wl) ?~ wl)

src/Dodge/Placement/PlaceSpot/TriggerDoor.hs

@@ -4,6 +4,7 @@ module Dodge.Placement.PlaceSpot.TriggerDoor (
     updateDoorEdges,
 ) where
 
+import Dodge.Placement.PlaceSpot.Block
 import Data.List
 import qualified Data.Set as S
 import Dodge.Data.GenWorld
@@ -19,7 +20,6 @@ import Linear
 
 plDoor ::
     Bool ->
-    S.Set EdgeObstacle ->
     -- | Opening condition
     WdBl ->
     -- | Door positions, closed to open.
@@ -29,7 +29,7 @@ plDoor ::
     Point2A ->
     GenWorld ->
     (Int, GenWorld)
-plDoor isauto eo cond l p1 p2 gw = (drid, over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors %~ addDoor) -- carefull with the ordering of addWalls
+plDoor isauto cond l p1 p2 gw = (drid, over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors %~ addDoor) -- carefull with the ordering of addWalls
   where
     drid = IM.newKey $ _doors (_lWorld (_cWorld $ _gwWorld gw))
     addDoor =
@@ -43,13 +43,15 @@ plDoor isauto eo cond l p1 p2 gw = (drid, over gwWorld addWalls $ gw & gwWorld .
                 , _drLerp = 0
                 , _drFootPrint = IM.fromList . zip wlids $ wlps'
                 }
-    wlids = take 4 [IM.newKey $ _walls (_lWorld (_cWorld $ _gwWorld gw)) ..]
+    wlids = take 4 [wlid..]
+    wlid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . walls
     wlps' = rectanglePairs 9 0 (V2 l 0)
+    addWalls = insertStructureWalls (`DoorPart` isauto) defaultDoorWall 
+        (map fst wlps' & each %~ shiftPointBy p1) drid wlid
     --addWalls w' = foldl' (addDoorWall eo drid $ switchWallCol col) w' $ zip wlids
-    addWalls w' =
-        foldl' (addDoorWall isauto eo drid defaultDoorWall) w' $
-            zip wlids $
-                wlps' & each . each %~ shiftPointBy p1
+    --    foldl' (addDoorWall isauto eo drid defaultDoorWall) w' $
+    --        zip wlids $
+    --            wlps' & each . each %~ shiftPointBy p1
 
 addDoorWall ::
     Bool ->