Start unifying door placement types

src/Dodge/Placement/PlaceSpot.hs

@@ -135,9 +135,9 @@ placeSpotID rid ps pt w = case pt of
     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 f l p1 p2 -> plDoor f l (pashift p1) (pashift p2) w
+    PutDoor' dr wl -> plDoor' (dr & drZeroPos %~ pashift & drOnePos %~ pashift) wl w
+    PutSlideDr wl dr off a b -> plSlideDoor wl dr off (doShift a) (doShift b) w
     PutCoord cp -> plNewID (gwWorld . coordinates) (doShift cp) w
-    PutSlideDr wl dr off a b ->
-        plSlideDoor wl dr off (doShift a) (doShift b) w
     PutBlock bl wl ps' ->
         plBlock
             (map doShift ps')

src/Dodge/Placement/PlaceSpot/TriggerDoor.hs

@@ -1,8 +1,10 @@
 module Dodge.Placement.PlaceSpot.TriggerDoor (
+    plDoor',
     plDoor,
     plSlideDoor,
 ) where
 
+import Dodge.Door.DoorLerp
 import Dodge.Data.GenWorld
 import Dodge.Default.Door
 import Dodge.Default.Wall
@@ -14,11 +16,35 @@ import qualified IntMapHelp as IM
 import LensHelp
 import Linear
 
+plDoor' ::
+    Door ->
+    Wall ->
+    GenWorld ->
+    (Int, GenWorld)
+plDoor' dr wl gw = 
+    ( drid
+    , over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors . at drid ?~ newdr
+    -- carefull with the ordering of addWalls
+    )
+  where
+    isauto = case dr ^. drTrigger of
+        WdBlCrFilterNearPoint{} -> True
+        _ -> False
+    drid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . doors
+    wlid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . walls
+    pps = IM.elems $ dr ^. drFootPrint
+    newdr = dr & drID .~ drid & drFootPrint .~ IM.fromList (zip [wlid ..] pps)
+    lerposa = doDoorLerp dr (dr ^. drLerp)
+    addWalls =
+        insertStructureWalls
+            (`DoorPart` isauto)
+            wl
+            (map fst pps & each %~ shiftPointBy lerposa)
+            drid
+            wlid
+
 plDoor ::
-    -- | Opening condition
     WdBl ->
-    -- | Door positions, closed to open.
-    -- Bumped out up and down by 9, not widened
     Float ->
     Point2A ->
     Point2A ->
@@ -55,32 +81,6 @@ plDoor cond l p1 p2 gw =
             drid
             wlid
 
---addWalls w' = foldl' (addDoorWall eo drid $ switchWallCol col) w' $ zip wlids
---    foldl' (addDoorWall isauto eo drid defaultDoorWall) w' $
---        zip wlids $
---            wlps' & each . each %~ shiftPointBy p1
-
---addDoorWall ::
---    Bool ->
---    S.Set EdgeObstacle ->
---    Int ->
---    Wall ->
---    World ->
---    (Int, (Point2, Point2)) ->
---    World
---addDoorWall isauto eo drid wl w (wlid, wlps) =
---    w'
---        & cWorld . lWorld . walls
---            %~ IM.insert
---                wlid
---                wl
---                    { _wlLine = wlps
---                    , _wlID = wlid
---                    , _wlStructure = DoorPart drid isauto
---                    }
---  where
---    w' = uncurry (obstructPathsCrossing eo) wlps w
-
 plSlideDoor ::
     Door ->
     Wall ->
@@ -90,7 +90,6 @@ plSlideDoor ::
     GenWorld ->
     (Int, GenWorld)
 plSlideDoor dr wl shiftOffset a b gw =
-    --(drid, over gwWorld addDoorWalls $ gw & gwWorld . cWorld . lWorld . doors %~ addDoor)
     (drid, over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors %~ addDoor)
   where
     isauto = case dr ^. drTrigger of
@@ -118,4 +117,3 @@ plSlideDoor dr wl shiftOffset a b gw =
             (map fst pairs)
             drid
             wlid
---    addDoorWalls w' = foldl' (addDoorWall isauto eo drid wl) w' $ zip wlids pairs