Cleanup: broken pathfinding

2021-11-16 18:05:47 +00:00
parent cb8cbe03a4
commit ebe9ad6b90
42 changed files with 491 additions and 301 deletions
@@ -0,0 +1,40 @@
+module Dodge.Placement.Instance.Door where
+import Dodge.Data
+import Dodge.Base
+import Color
+import Geometry
+import Geometry.Vector3D
+import Dodge.LevelGen.Data
+import Dodge.Creature.Property
+import Dodge.LevelGen.Switch
+
+import qualified Data.IntMap.Strict as IM
+
+putDoubleDoor :: Bool -> Color -> (World -> Bool)  -> Point2 -> Point2 -> Float -> Placement
+putDoubleDoor pathing col cond a b speed = putDoubleDoorThen pathing col cond a b speed Nothing
+
+putDoubleDoorThen :: Bool -> Color -> (World -> Bool) 
+    -> Point2 -> Point2 -> Float -> Maybe Placement -> Placement
+putDoubleDoorThen pathing col cond a b speed mayp = ps0j (PutSlideDoor pathing col cond a half speed)
+    $ Placement (PS (V2 0 0) 0) ( PutSlideDoor pathing col cond b half speed) Nothing $ const mayp
+  where
+    half = 0.5 *.* (a +.+ b)
+
+    
+
+putAutoDoor :: Point2 -> Point2 -> Placement
+putAutoDoor a b = PlacementUsingPos (addZ 0 a)
+    $ \az -> PlacementUsingPos (addZ 0 b)
+    $ \bz -> putDoubleDoor True (dim yellow) (cond az bz) a b 3
+  where
+    --cond az bz = any (crNearSeg 40 (stripZ az) (stripZ bz)) . IM.filter isAnimate . _creatures
+    cond az bz = any (crNearPoint 40 (0.5 *.* (stripZ az +.+ stripZ bz))) 
+        . IM.filter isAnimate . _creatures
+
+switchDoor :: Point2 -> Float -> Point2 -> Point2 -> Color -> Placement
+switchDoor btpos btrot dra drb col = pContID (PS btpos btrot) (PutButton $ makeSwitch col red id id)
+    $ \btid -> jsps0J (PutSlideDoor False col (cond btid) dra drc 2)
+    $          sps0   (PutSlideDoor False col (cond btid) drb drc 2)
+  where
+    drc = 0.5 *.* (dra +.+ drb)
+    cond btid w' = _btState (_buttons w' IM.! btid) == BtOn