Single source of truth for wall pathing

src/Dodge/Placement/Instance/Block.hs

@@ -16,8 +16,8 @@ decoratedBlock decf mat col h ps = PutBlock bl wl $ reverse ps
             & blHeight .~ h
     wl =
         defaultWall
-            & wlPathFlag . at WallNotDestrucable .~ Nothing
-            & wlPathFlag . at WallBlockVisibility .~ Nothing
+--            & wlPathFlag . at WallNotDestrucable .~ Nothing
+--            & wlPathFlag . at WallBlockVisibility .~ Nothing
             & wlRotateTo .~ False
             & wlOpacity .~ SeeAbove
             & wlMaterial .~ mat

src/Dodge/Placement/Instance/Door.hs

@@ -5,23 +5,31 @@ module Dodge.Placement.Instance.Door (
     switchDoor, -- not used 9/3/22
 ) where
 
-import Dodge.Default.Wall
-import Dodge.Default.Door
-import qualified Data.Set as S
 import Color
 import Control.Lens
+import qualified Data.Set as S
 import Dodge.Data.CreatureEffect
 import Dodge.Data.GenWorld
+import Dodge.Default.Door
+import Dodge.Default.Wall
 import Dodge.LevelGen.PlacementHelper
 import Dodge.LevelGen.Switch
 import Geometry
 
-putDoubleDoor :: S.Set EdgeObstacle 
-    -> Wall -> WdBl -> Point2 -> Point2 -> Float -> Placement
-putDoubleDoor eo wl cond a b speed =
-    putDoubleDoorThen eo wl cond 1 a b speed (const $ const Nothing)
+putDoubleDoor ::
+    Bool ->
+    S.Set EdgeObstacle ->
+    Wall ->
+    WdBl ->
+    Point2 ->
+    Point2 ->
+    Float ->
+    Placement
+putDoubleDoor isauto eo wl cond a b speed =
+    putDoubleDoorThen isauto eo wl cond 1 a b speed (const $ const Nothing)
 
 putDoubleDoorThen ::
+    Bool ->
     S.Set EdgeObstacle ->
     Wall ->
     WdBl ->
@@ -31,15 +39,16 @@ putDoubleDoorThen ::
     Float ->
     (Placement -> Placement -> Maybe Placement) ->
     Placement
-putDoubleDoorThen eo wl cond soff a b speed cont =
-    doorBetween eo wl cond soff a half speed $
+putDoubleDoorThen isauto eo wl cond soff a b speed cont =
+    doorBetween isauto eo wl cond soff a half speed $
         \pl1 -> Just $
-            doorBetween eo wl cond soff b half speed $
+            doorBetween isauto eo wl cond soff b half speed $
                 \pl2 -> cont pl1 pl2
   where
     half = 0.5 *.* (a +.+ b)
 
 doorBetween ::
+    Bool ->
     S.Set EdgeObstacle ->
     Wall ->
     WdBl ->
@@ -49,9 +58,9 @@ doorBetween ::
     Float ->
     (Placement -> Maybe Placement) ->
     Placement
-doorBetween eo wl cond soff pa pb speed g = case divideLine 40 pa pb of
-    [x, y] -> ptCont (PutSlideDr adoor wl eo soff x y) g
-    (x : y : zs) -> divideDoorPane Nothing wl cond (soff - dist y pb) speed (zip (x : y : zs) (y : zs)) g
+doorBetween isauto eo wl cond soff pa pb speed g = case divideLine 40 pa pb of
+    [x, y] -> ptCont (PutSlideDr isauto adoor wl eo 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
     adoor =
@@ -60,6 +69,7 @@ doorBetween eo wl cond soff pa pb speed g = case divideLine 40 pa pb of
             & drUpdate . drLerpSpeed .~ speed
 
 divideDoorPane ::
+    Bool ->
     Maybe Int ->
     Wall ->
     WdBl ->
@@ -68,28 +78,31 @@ divideDoorPane ::
     [(Point2, Point2)] ->
     (Placement -> Maybe Placement) ->
     Placement
-divideDoorPane mid wl cond soff speed ppairs g = case ppairs of
+divideDoorPane isauto mid wl cond soff speed ppairs g = case ppairs of
     [p] -> ptCont (adoor p) g
-    (p : ps) -> ptCont (adoor p) $ \pl -> Just $ divideDoorPane (_plMID pl) wl cond soff speed ps g
+    (p : ps) -> ptCont (adoor p) $ \pl -> Just $ divideDoorPane isauto (_plMID pl) wl cond soff speed ps g
     _ -> undefined
   where
-    adoor (x, y) = PutSlideDr thedoor wl mempty soff x y
+    adoor (x, y) = PutSlideDr isauto thedoor wl mempty soff x y
     thedoor =
         defaultDoor & drUpdate . drLerpSpeed .~ speed & drTrigger .~ cond
             & drPushedBy .~ maybe PushesItself PushedBy mid
 
 putAutoDoor :: Point2 -> Point2 -> Placement
 putAutoDoor a b = Placement (PS 0 0) (PutCoord a) Nothing Nothing $ \_ apl ->
-    Just $ Placement (PS 0 0) (PutCoord b) Nothing Nothing $ \w bpl ->
-        let x = w ^?! gwWorld . coordinates . ix (apl ^?! plMID . _Just)
-            y = w ^?! gwWorld . coordinates . ix (bpl ^?! plMID . _Just)
-        in Just $ putDoubleDoor
-                (S.fromList [WallObstacle WallBlockVisibility])
-                defaultAutoWall
-                (WdBlCrFilterNearPoint 40 (0.5 *.* (x + y)) CrIsAnimate)
-                a
-                b
-                3
+    Just $
+        Placement (PS 0 0) (PutCoord b) Nothing Nothing $ \w bpl ->
+            let x = w ^?! gwWorld . coordinates . ix (apl ^?! plMID . _Just)
+                y = w ^?! gwWorld . coordinates . ix (bpl ^?! plMID . _Just)
+             in Just $
+                    putDoubleDoor True
+                        (S.fromList [WallObstacle WallBlockVisibility])
+                        defaultAutoWall
+                        (WdBlCrFilterNearPoint 40 (0.5 *.* (x + y)) CrIsAnimate)
+                        a
+                        b
+                        3
+
 --putAutoDoor :: Point2 -> Point2 -> Placement
 --putAutoDoor a b = PlacementUsingPos (addZ 0 a) $
 --    \az -> PlacementUsingPos (addZ 0 b) $
@@ -112,9 +125,15 @@ switchDoor btpos btrot dra drb col = pContID
         jsps0J (doorbetween btid dra drc) $
             sps0 (doorbetween btid drb drc)
   where
-    --doorbetween btid a b = PutSlideDr thedoor (switchWallCol col) 
-    doorbetween btid a b = PutSlideDr thedoor defaultDoorWall 
-        (S.fromList (WallObstacle <$> [WallNotAutoOpen,WallBlockVisibility])) 1 a b
+    --doorbetween btid a b = PutSlideDr thedoor (switchWallCol col)
+    doorbetween btid a b =
+        PutSlideDr False
+            thedoor
+            defaultDoorWall
+            (S.fromList (WallObstacle <$> [WallNotAutoOpen, WallBlockVisibility]))
+            1
+            a
+            b
       where
         thedoor =
             defaultDoor

src/Dodge/Placement/Instance/Wall.hs

@@ -95,7 +95,7 @@ crystalLine a b = sps0 $ PutLineBlock defaultCrystalWall 7 a b
 
 baseBlockPane :: Wall
 baseBlockPane = defaultWall & wlOpacity .~ Opaque 17
-    & wlPathFlag .~ S.fromList [WallBlockVisibility, WallNotAutoOpen]
+--    & wlPathFlag .~ S.fromList [WallBlockVisibility, WallNotAutoOpen]
 
 -- TODO find home for this
 {- Replaces instances of a given 'PutID' with 'PSType's drawn from a list.  -}