Automatically determine automatic doors

src/Dodge/Placement/Instance/Door.hs

@@ -4,6 +4,7 @@ module Dodge.Placement.Instance.Door (
     putDoubleDoorThen,
 ) where
 
+import Linear
 import Control.Lens
 import Dodge.Data.CreatureEffect
 import Dodge.Data.GenWorld
@@ -52,7 +53,7 @@ doorBetween ::
     (Placement -> Maybe Placement) ->
     Placement
 doorBetween isauto wl cond soff pa pb speed g = case divideLine 40 pa pb of
-    [x, y] -> ptCont (PutSlideDr isauto adoor wl soff x y) g
+    [x, y] -> ptCont (PutSlideDr adoor wl soff x y) g
     (x : y : zs) -> divideDoorPane isauto Nothing wl cond (soff - dist y pb) speed (zip (x : y : zs) (y : zs)) g
     _ -> undefined
   where
@@ -76,7 +77,7 @@ divideDoorPane isauto mid wl cond soff speed ppairs g = case ppairs of
     (p : ps) -> ptCont (adoor p) $ \pl -> Just $ divideDoorPane isauto (_plMID pl) wl cond soff speed ps g
     _ -> undefined
   where
-    adoor (x, y) = PutSlideDr isauto thedoor wl soff x y
+    adoor (x, y) = PutSlideDr thedoor wl soff x y
     thedoor =
         defaultDoor & drUpdate . drLerpSpeed .~ speed & drTrigger .~ cond
             & drPushedBy .~ maybe PushesItself PushedBy mid
@@ -88,9 +89,10 @@ putAutoDoor a b = Placement (PS 0 0) (PutCoord a) Nothing Nothing $ \_ apl ->
             let x = w ^?! gwWorld . coordinates . ix (apl ^?! plMID . _Just)
                 y = w ^?! gwWorld . coordinates . ix (bpl ^?! plMID . _Just)
              in Just $
-                    putDoubleDoor True
+                    putDoubleDoor
+                        True
                         defaultAutoWall
-                        (WdBlCrFilterNearPoint 40 (0.5 *.* (x + y)) CrIsAnimate)
+                        (WdBlCrFilterNearPoint 40 (0.5 *^ (x + y)) CrIsAnimate)
                         a
                         b
                         3

src/Dodge/Placement/PlaceSpot.hs

@@ -134,10 +134,10 @@ 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 f l p1 p2 -> plDoor isauto f l (pashift p1) (pashift p2) w
+    PutDoor f l p1 p2 -> plDoor f l (pashift p1) (pashift p2) w
     PutCoord cp -> plNewID (gwWorld . coordinates) (doShift cp) w
-    PutSlideDr isauto wl dr off a b ->
-        plSlideDoor isauto wl dr off (doShift a) (doShift b) 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

@@ -3,12 +3,10 @@ module Dodge.Placement.PlaceSpot.TriggerDoor (
     plSlideDoor,
 ) where
 
---import Data.List
 import Dodge.Data.GenWorld
 import Dodge.Default.Door
 import Dodge.Default.Wall
 import Dodge.LevelGen.DoorPane
---import Dodge.Path
 import Dodge.Placement.PlaceSpot.Block
 import Dodge.ShiftPoint
 import Geometry
@@ -17,8 +15,6 @@ import LensHelp
 import Linear
 
 plDoor ::
-    -- | Is door automatic?
-    Bool ->
     -- | Opening condition
     WdBl ->
     -- | Door positions, closed to open.
@@ -28,12 +24,15 @@ plDoor ::
     Point2A ->
     GenWorld ->
     (Int, GenWorld)
-plDoor isauto cond l p1 p2 gw =
+plDoor cond l p1 p2 gw =
     ( drid
     , over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors . at drid ?~ addDoor
     -- carefull with the ordering of addWalls
     )
   where
+    isauto = case cond of
+        WdBlCrFilterNearPoint{} -> True
+        _ -> False
     drid = IM.newKey $ _doors (_lWorld (_cWorld $ _gwWorld gw))
     addDoor =
         defaultDoor
@@ -83,7 +82,6 @@ plDoor isauto cond l p1 p2 gw =
 --    w' = uncurry (obstructPathsCrossing eo) wlps w
 
 plSlideDoor ::
-    Bool ->
     Door ->
     Wall ->
     Float ->
@@ -91,10 +89,13 @@ plSlideDoor ::
     Point2 ->
     GenWorld ->
     (Int, GenWorld)
-plSlideDoor isauto dr wl shiftOffset a b gw =
+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
+        WdBlCrFilterNearPoint{} -> True
+        _ -> False
     drid = IM.newKey $ _doors (_lWorld (_cWorld $ _gwWorld gw))
     addDoor =
         IM.insert drid $