Work on autodoor pathing

src/Dodge/Block/Debris.hs

@@ -35,7 +35,6 @@ makeDoorDebris dr w = w & makeDebris mt p
         return $ wl ^. wlMaterial
 
 makeBlockDebris :: Block -> World -> World
---makeBlockDebris bl w = foldl' (flip $ makeDebris mt col) w ps
 makeBlockDebris bl w = foldl' (flip $ makeDebris mt) w ps
   where
     dsize = debrisSize mt

src/Dodge/Default/Door.hs

@@ -16,12 +16,7 @@ defaultAutoWall =
     defaultDoorWall
 --        & wlColor .~ dim yellow
         & wlOpacity .~ Opaque 9
-
+        & wlPathFlag . at WallNotAutoOpen .~ Nothing
-defaultSwitchWall :: Wall
-defaultSwitchWall =
-    defaultDoorWall
---        & wlColor .~ red
-        & wlOpacity .~ Opaque 0
 
 defaultDoor :: Door
 defaultDoor =

src/Dodge/Default/Wall.hs

@@ -1,6 +1,5 @@
 module Dodge.Default.Wall (
     defaultWall,
-    defaultSensorWall,
     defaultMachineWall,
     defaultWindow,
     defaultCrystalWall,
@@ -35,17 +34,14 @@ defaultWall =
         }
 
 defaultDoorWall :: Wall
-defaultDoorWall =
+defaultDoorWall = defaultWall
-    defaultWall{_wlMaterial = Metal}
         & wlPathFlag . at WallNotDestrucable .~ Nothing
+        & wlMaterial .~ Metal
+        & wlOpacity .~ Opaque 0
 
 {- Indestructible see-through wall.  -}
 defaultCrystalWall :: Wall
 defaultCrystalWall = defaultWall & wlOpacity .~ SeeThrough & wlMaterial .~ Crystal
---        { _wlColor = withAlpha 0.5 aquamarine
---        , _wlOpacity = SeeThrough
---        , _wlMaterial = Crystal
---        }
 
 defaultMachineWall :: Wall
 defaultMachineWall =
@@ -57,9 +53,6 @@ defaultMachineWall =
         , _wlTouchThrough = True
         }
 
-defaultSensorWall :: Wall
-defaultSensorWall = defaultMachineWall
-
 defaultDirtWall :: Wall
 defaultDirtWall =
     defaultWall

src/Dodge/Path.hs

@@ -3,12 +3,9 @@ module Dodge.Path (
     pointTowardsImpulse,
     makePathBetween,
     makePathBetweenPs,
-    --    , removePathsCrossing
     obstructPathsCrossing,
---    pairsToGraph,
     getNodePos,
     walkableNodeNear,
---    bfsNodePoints,
     snapToGrid,
     pairsToIncGraph,
     updateEdge,

src/Dodge/Placement/Instance/Door.hs

@@ -112,7 +112,7 @@ switchDoor btpos btrot dra drb col = pContID
             sps0 (doorbetween btid drb drc)
   where
     --doorbetween btid a b = PutSlideDr thedoor (switchWallCol col) 
-    doorbetween btid a b = PutSlideDr thedoor defaultSwitchWall 
+    doorbetween btid a b = PutSlideDr thedoor defaultDoorWall 
         (S.fromList (WallObstacle <$> [WallNotAutoOpen,WallBlockVisibility])) 1 a b
       where
         thedoor =

src/Dodge/Placement/Instance/Sensor.hs

@@ -29,7 +29,6 @@ damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $
                                 (damageTypeThreshold dt)
                             )
                 )
---                defaultMachineWall
                 Nothing
 
 damageTypeThreshold :: SensorType -> Int

src/Dodge/Placement/Instance/Terminal.hs

@@ -36,7 +36,6 @@ putTerminalFull f col mc tm =
                             ( mc & mcMounts . at OTButton ?~ fromJust (_plMID btpl)
                                 & mcMounts . at OTTerminal .~ _plMID tmpl
                             )
---                            defaultMachineWall
                             Nothing
                         )
                         $ \mcpl -> Just $ pt0 (PutWorldUpdate $ const $ const $ over gwWorld  (setids tmpl btpl mcpl)) (\_ -> f tmpl btpl mcpl)

src/Dodge/Placement/Instance/Wall.hs

@@ -1,10 +1,19 @@
-module Dodge.Placement.Instance.Wall where
+module Dodge.Placement.Instance.Wall 
+    (invisibleWall, crystalLine, blockLine, putBlockRect
+    ,baseBlockPane
+    ,midWall
+    ,windowLine
+    ,putBlockN
+    ,putBlockV
+    ,heightWallPS
+    ,replacePutID
+    ) where
 
+import qualified Data.Set as S
 import Dodge.Material.Color
 import Control.Lens
 import Data.List
 import Dodge.Data.GenWorld
-import Dodge.Default.Block
 import Dodge.Default.Wall
 import Dodge.LevelGen.PlacementHelper
 import Dodge.Placement.Instance.Block
@@ -27,13 +36,13 @@ invisibleWall ps =
 midWall :: [Point2] -> Placement
 midWall = heightWallPS (PS 0 0) 50
 
-singleBlock :: Point2 -> [Placement]
+--singleBlock :: Point2 -> [Placement]
-singleBlock a =
+--singleBlock a =
-    [ sPS a 0 $
+--    [ sPS a 0 $
-        PutBlock defaultBlock baseBlockPane $
+--        PutBlock defaultBlock baseBlockPane $
-            reverse $
+--            reverse $
-                square 10
+--                square 10
-    ]
+--    ]
 
 {-
 Places a line of blocks between two points.
@@ -65,35 +74,28 @@ crystalLine a b = sps0 $ PutLineBlock defaultCrystalWall 7 a b
 --        ]
 --    left = 7 *.* normalizeV (a-.-b)
 --    up   = vNormal left
-{- Places an unbreakable wall between two points.
+--
-Depth 15, does not extend wider than points.
+--{- Places an unbreakable wall between two points.
- -}
+--Depth 15, does not extend wider than points.
-wallLine :: Point2 -> Point2 -> Placement
+-- -}
-wallLine a b = sps0 $ PutWall ps defaultWall
+--wallLine :: Point2 -> Point2 -> Placement
-  where
+--wallLine a b = sps0 $ PutWall ps defaultWall
-    ps =
+--  where
-        [ a +.+ up
+--    ps =
-        , a -.- up
+--        [ a +.+ up
-        , b -.- up
+--        , a -.- up
-        , b +.+ up
+--        , b -.- up
-        ]
+--        , b +.+ up
-    left = 15 *.* normalizeV (a -.- b)
+--        ]
-    up = vNormal left
+--    left = 15 *.* normalizeV (a -.- b)
+--    up = vNormal left
 
-windowLineType :: Point2 -> Point2 -> PSType
+--windowLineType :: Point2 -> Point2 -> PSType
-windowLineType = PutLineBlock defaultWindow 8
+--windowLineType = PutLineBlock defaultWindow 8
 
 baseBlockPane :: Wall
-baseBlockPane =
+baseBlockPane = defaultWall & wlOpacity .~ Opaque 17
-    defaultWall
+    & wlPathFlag .~ S.fromList [WallBlockVisibility, WallNotAutoOpen]
-        { _wlLine = (V2 0 0, V2 50 0)
-        , _wlID = 0
-        --, _wlColor = greyN 0.5
---        , _wlColor = dark $ dark orange
-        --, _wlOpacity = Opaque 10
-        , _wlOpacity = Opaque 17
-        , _wlUnshadowed = True
-        }
 
 -- TODO find home for this
 {- Replaces instances of a given 'PutID' with 'PSType's drawn from a list.  -}
@@ -127,18 +129,18 @@ subZipWith f g xs ys =
 isPutID :: Int -> Placement -> Bool
 isPutID i ps = Just i == ps ^? plType . putID
 
-putBlockRect' :: Float -> Float -> Placement
+--putBlockRect' :: Float -> Float -> Placement
-putBlockRect' w h =
+--putBlockRect' w h =
-    ps0jPushPS (aline tl tr) $
+--    ps0jPushPS (aline tl tr) $
-        ps0jPushPS (aline tr br) $
+--        ps0jPushPS (aline tr br) $
-            ps0jPushPS (aline br bl) $
+--            ps0jPushPS (aline br bl) $
-                sps0 (aline bl tl)
+--                sps0 (aline bl tl)
-  where
+--  where
-    tl = V2 (- w) h
+--    tl = V2 (- w) h
-    tr = V2 w h
+--    tr = V2 w h
-    br = V2 w (- h)
+--    br = V2 w (- h)
-    bl = V2 (- w) (- h)
+--    bl = V2 (- w) (- h)
-    aline = PutLineBlock baseBlockPane 9
+--    aline = PutLineBlock baseBlockPane 9
 
 putBlockRect :: Float -> Float -> Float -> Float -> [Placement]
 putBlockRect a x b y =
@@ -154,12 +156,12 @@ putBlockV a x b y =
     , blockLine (V2 x b) (V2 a b)
     ]
 
-putBlockC :: Float -> Float -> Float -> Float -> [Placement]
+--putBlockC :: Float -> Float -> Float -> Float -> [Placement]
-putBlockC a x b y =
+--putBlockC a x b y =
-    [ blockLine (V2 a b) (V2 a y)
+--    [ blockLine (V2 a b) (V2 a y)
-    , blockLine (V2 x b) (V2 a b)
+--    , blockLine (V2 x b) (V2 a b)
-    , blockLine (V2 a y) (V2 x y)
+--    , blockLine (V2 a y) (V2 x y)
-    ]
+--    ]
 
 putBlockN :: Float -> Float -> Float -> Float -> [Placement]
 putBlockN a x b y =

src/Dodge/Placement/PlaceSpot/TriggerDoor.hs

@@ -44,7 +44,7 @@ plDoor eo cond l p1 p2 gw = (drid, over gwWorld addWalls $ gw & gwWorld . cWorld
     wlids = take 4 [IM.newKey $ _walls (_lWorld (_cWorld $ _gwWorld gw)) ..]
     wlps' = rectanglePairs 9 0 (V2 l 0)
     --addWalls w' = foldl' (addDoorWall eo drid $ switchWallCol col) w' $ zip wlids
-    addWalls w' = foldl' (addDoorWall eo drid defaultSwitchWall) w' $ zip wlids
+    addWalls w' = foldl' (addDoorWall eo drid defaultDoorWall) w' $ zip wlids
         $ wlps' & each . each %~ shiftPointBy p1
 
 addDoorWall :: S.Set EdgeObstacle 

src/Dodge/Room/Airlock.hs

@@ -51,8 +51,7 @@ decontamRoom i =
         return $
             putDoubleDoor
                 switchWallObs
-                --(switchWallCol red)
+                defaultDoorWall
-                defaultSwitchWall
                 (cond pmnt)
                 (V2 (-10) 35)
                 (V2 (-10) 65)
@@ -62,7 +61,7 @@ decontamRoom i =
     cutps = [rectNSWE 100 0 0 40, switchcut]
     ps = (\p -> p - mcpos) <$> orderPolygon (concat cutps)
     --thewall = switchWallCol col
-    thewall = defaultSwitchWall
+    thewall = defaultDoorWall
     switchcut = rectNSWE 65 35 (-40) 80
     lnks =
         [ (V2 20 95, 0)
@@ -89,8 +88,7 @@ airlock0 =
         , _rmBound = [rectNSWE 75 15 0 40, switchcut]
         }
   where
-    --thewall = switchWallCol col
+    thewall = defaultDoorWall
-    thewall = defaultSwitchWall
     switchcut = rectNSWE 65 35 (-40) 20
     lnks =
         [ (V2 20 95, 0)

src/Dodge/Room/Door.hs

@@ -42,6 +42,5 @@ triggerDoorRoom i =
     f gw = fromMaybe (error "tried to put a door using an empty placement list") $ do
         pmnt <- gw ^? genPmnt . ix i
         return $ putDoubleDoor 
-            --switchWallObs (switchWallCol red) (cond pmnt) (V2 0 20) (V2 40 20) 2
+            switchWallObs defaultDoorWall (cond pmnt) (V2 0 20) (V2 40 20) 2
-            switchWallObs defaultSwitchWall (cond pmnt) (V2 0 20) (V2 40 20) 2
     cond pmnt = WdTrig $ fromJust (_plMID pmnt)

src/Dodge/Room/LongDoor.hs

@@ -58,7 +58,7 @@ twinSlowDoorRoom w h x =
         }
   where
     --thewall = switchWallCol red
-    thewall = defaultSwitchWall
+    thewall = defaultDoorWall
     wlSpeed = 0.5
     addColorChange lsid drid =
         over prUpdate $
@@ -131,7 +131,7 @@ addButtonSlowDoor x h rm = do
     -- TODO make the height of this light source and of other mounted lights
     -- be taken from a single consistent source
     --thewall = switchWallCol red
-    thewall = defaultSwitchWall
+    thewall = defaultDoorWall
     butDoor = putLitButOnPos
         col
         (rprBool (isUnusedLnkType InLink))

src/Dodge/Room/Procedural.hs

@@ -331,7 +331,7 @@ centerVaultRoom w h d =
                     sPS (V2 0 (d -10)) 0 (PutSlideDr (thedoor btid) thewall switchWallObs 1 (V2 21 0) (V2 0 0))
         ]
     --thewall = switchWallCol col
-    thewall = defaultSwitchWall
+    thewall = defaultDoorWall
     thedoor btid =
         defaultDoor
             & drTrigger .~ WdBlBtOn btid