Make autodoor placements use "ordinary" coordinate placements

src/Dodge/Data/LWorld.hs

@@ -129,7 +129,6 @@ data LWorld = LWorld
     , _oldMagnets :: [Magnet]
     , _magnets :: [Magnet]
     , _blocks :: IM.IntMap Block
-    , _coordinates :: IM.IntMap Point2
     , _triggers :: IM.IntMap Bool
     , _floorItems :: IM.IntMap FloorItem
     , _modifications :: IM.IntMap Modification

src/Dodge/Data/World.hs

@@ -12,6 +12,7 @@ module Dodge.Data.World (
     module Dodge.Data.Input,
 ) where
 
+import qualified Data.IntMap.Strict as IM
 import NewInt
 import Control.Lens
 import Data.IntMap.Strict (IntMap)
@@ -53,6 +54,7 @@ data World = World
     , _gsZoning :: IntMap (IntMap IntSet)
     , _wCam :: Camera
     , _unpauseClock :: Int
+    , _coordinates :: IM.IntMap Point2 -- temporary coordinates for world generation/placement
     }
 
 data TimeFlowStatus

src/Dodge/Default/World.hs

@@ -51,6 +51,7 @@ defaultWorld =
         , _peZoning = mempty
         , _gsZoning = mempty --Zoning IM.empty clZoneSize (zonePos _guPos)
         , _unpauseClock = 0
+        , _coordinates = mempty
         }
 
 defaultCWGen :: CWGen
@@ -128,7 +129,6 @@ defaultLWorld =
         , _machines = IM.empty
         , _terminals = IM.empty
         , _doors = IM.empty
-        , _coordinates = IM.empty
         , _triggers = IM.empty
         , _floorItems = mempty
         , _worldEvents = []

src/Dodge/Placement/Instance/Door.hs

@@ -76,18 +76,30 @@ divideDoorPane mid wl cond soff speed ppairs g = case ppairs of
             & drPushedBy .~ maybe PushesItself PushedBy mid
 
 putAutoDoor :: Point2 -> Point2 -> Placement
-putAutoDoor a b = PlacementUsingPos (addZ 0 a) $
-    \az -> PlacementUsingPos (addZ 0 b) $
-        \bz ->
-            putDoubleDoor
+putAutoDoor a b = Placement 0 (PS 0 0) (PutCoord a) Nothing $ \_ apl ->
+    Just $ Placement 0 (PS 0 0) (PutCoord b) Nothing $ \w bpl ->
+        let x = w ^?! coordinates . ix (apl ^?! plMID . _Just)
+            y = w ^?! coordinates . ix (bpl ^?! plMID . _Just)
+        in Just $ putDoubleDoor
                 AutoDoorObstacle
                 defaultAutoWall
-                (cond az bz)
+                (WdBlCrFilterNearPoint 40 (0.5 *.* (x + y)) CrIsAnimate)
                 a
                 b
                 3
-  where
-    cond az bz = WdBlCrFilterNearPoint 40 (0.5 *.* (stripZ az +.+ stripZ bz)) CrIsAnimate
+--putAutoDoor :: Point2 -> Point2 -> Placement
+--putAutoDoor a b = PlacementUsingPos (addZ 0 a) $
+--    \az -> PlacementUsingPos (addZ 0 b) $
+--        \bz ->
+--            putDoubleDoor
+--                AutoDoorObstacle
+--                defaultAutoWall
+--                (cond az bz)
+--                a
+--                b
+--                3
+--  where
+--    cond az bz = WdBlCrFilterNearPoint 40 (0.5 *.* (stripZ az +.+ stripZ bz)) CrIsAnimate
 
 switchDoor :: Point2 -> Float -> Point2 -> Point2 -> Color -> Placement
 switchDoor btpos btrot dra drb col = pContID

src/Dodge/Placement/PlaceSpot.hs

@@ -121,11 +121,6 @@ placeSpotID' ps pt w = case pt of
                             & itLocation .~ OnFloor
                        )
             )
-    --        plNewUpID
-    --            (cWorld . lWorld . floorItems . unNIntMap)
-    --            (flItID . unNInt)
-    --            (createFlIt p rot itm)
-    --            w
     PutCrit cr -> plNewUpID (cWorld . lWorld . creatures) crID (mvCr p rot cr) w
     PutForeground fs -> plNewUpID (cWorld . lWorld . foregroundShapes) fsID (mvFS p rot fs) w
     PutMachine pps mc wl mitm -> plMachine (map doShift pps) mc wl mitm p rot w
@@ -133,7 +128,7 @@ placeSpotID' ps pt w = case pt of
     PutPPlate pp -> plNewUpID (cWorld . lWorld . pressPlates) ppID (mvPP p rot pp) w
     RandPS rgn -> evaluateRandPS rgn ps w
     PutDoor col eo f pss -> plDoor col eo f (map (bimap doShift doShift) pss) w
-    PutCoord cp -> plNewID (cWorld . lWorld . coordinates) (doShift cp) w
+    PutCoord cp -> plNewID coordinates (doShift cp) w
     PutSlideDr wl dr eo off a b ->
         plSlideDoor wl dr eo off (doShift a) (doShift b) w
     PutBlock bl wl ps' ->