Improve some door placement

src/Dodge/Placement/PlaceSpot.hs

@@ -6,6 +6,7 @@
 -}
 module Dodge.Placement.PlaceSpot (placeSpot) where
 
+import Dodge.Placement.PlaceSpot.Block
 import Control.Monad.State
 import Data.Bifunctor
 import Data.Foldable
@@ -16,7 +17,6 @@ import Dodge.Base.NewID
 import Dodge.Data.GenWorld
 import Dodge.Default.Wall
 import Dodge.Path
-import Dodge.Placement.PlaceSpot.Block
 import Dodge.Placement.PlaceSpot.TriggerDoor
 import Dodge.Placement.Shift
 import Dodge.ShiftPoint
@@ -134,7 +134,7 @@ placeSpotID rid ps pt w = case pt of
     PutMachine pps mc mitm -> plMachine (map doShift pps) mc mitm p rot w
     PutLS ls -> plNewUpID (gwWorld . cWorld . lWorld . lightSources) lsID (mvLS p' rot ls) w
     RandPS _ -> error "RandPS should not be reachable here" --evaluateRandPS rid rgn ps w
-    PutDoor isauto eo f l p1 p2 -> plDoor isauto eo f l (pashift p1) (pashift p2) w
+    PutDoor isauto f l p1 p2 -> plDoor isauto f l (pashift p1) (pashift p2) w
     PutCoord cp -> plNewID (gwWorld . coordinates) (doShift cp) w
     PutSlideDr isauto wl dr eo off a b ->
         plSlideDoor isauto wl dr eo off (doShift a) (doShift b) w
@@ -180,9 +180,9 @@ placeWallPoly qs wl w
     | otherwise = error "tried to place wall poly with too few points"
 
 addPane :: Wall -> World -> (Point2, Point2) -> World
-addPane wl w l =
-    w & plNew (cWorld . lWorld . walls) wlID (wl & wlLine .~ l)
-        & uncurry (obstructPathsCrossing (S.fromList [WallObstacle WallNotAutoOpen])) l
+addPane wl w l = insertWall (wl & wlLine .~ l & wlID .~ i) w
+  where
+    i = IM.newKey $ w ^. cWorld . lWorld . walls
 
 mvProp :: Point2 -> Float -> Prop -> Prop
 mvProp p a = (prRot +~ a) . (prPos %~ ((p +.+) . rotateV a))
@@ -211,7 +211,7 @@ plMachine ::
 plMachine wallpoly mc mitm p rot gw =
     ( mcid
     , gw & tolw . machines . at mcid ?~ themc
-        & tolw . walls %~ placeMachineWalls wallpoly mcid wlid
+        & gwWorld %~ placeMachineWalls wallpoly mcid wlid
         & tolw %~ maybe id placeturretitm mitm
     )
   where
@@ -227,15 +227,10 @@ plMachine wallpoly mc mitm p rot gw =
         itid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . items
         itm' = itm & itID .~ NInt itid & itLocation .~ OnTurret mcid
 
--- TODO correctly remove/shift pathfinding lines (removePathsCrossing)
-placeMachineWalls :: [Point2] -> Int -> Int -> IM.IntMap Wall -> IM.IntMap Wall
-placeMachineWalls poly mcid wlid = flip (foldr f) $ zip [wlid ..] $ loopPairs poly
+placeMachineWalls :: [Point2] -> Int -> Int -> World -> World
+placeMachineWalls poly mcid = insertStructureWalls MachinePart baseWall poly mcid
   where
-    f (wid, l) = IM.insert wid baseWall{_wlID = wid, _wlLine = l}
-    baseWall =
-        defaultMachineWall
-            & wlStructure . wsMachine .~ mcid
-            & wlTouchThrough .~ True
+    baseWall = defaultMachineWall & wlStructure . wsMachine .~ mcid
 
 mvLS :: Point3 -> Float -> LightSource -> LightSource
 mvLS (V3 x y z) rot ls = ls & lsParam . lsPos .~ V3 x y z +.+.+ startPos