Improve door pathing update

This commit is contained in:
2022-07-03 12:56:24 +01:00
parent 67b612fe60
commit 757ffad1ad
4 changed files with 15 additions and 15 deletions
+11 -11
View File
@@ -15,25 +15,25 @@ import Dodge.LevelGen.Switch
import Control.Lens
import qualified Data.IntMap.Strict as IM
putDoubleDoor :: Wall -> (World -> Bool) -> Point2 -> Point2 -> Float -> Placement
putDoubleDoor wl cond a b speed
= putDoubleDoorThen wl cond 1 a b speed (const $ const Nothing)
putDoubleDoor :: EdgeObstacle -> Wall -> (World -> Bool) -> Point2 -> Point2 -> Float -> Placement
putDoubleDoor eo wl cond a b speed
= putDoubleDoorThen eo wl cond 1 a b speed (const $ const Nothing)
putDoubleDoorThen :: Wall -> (World -> Bool)
putDoubleDoorThen ::EdgeObstacle -> Wall -> (World -> Bool)
-> Float -> Point2 -> Point2 -> Float
-> (Placement -> Placement -> Maybe Placement)
-> Placement
putDoubleDoorThen wl cond soff a b speed cont
= doorBetween wl cond soff a half speed
$ \pl1 -> Just $ doorBetween wl cond soff b half speed
putDoubleDoorThen eo wl cond soff a b speed cont
= doorBetween eo wl cond soff a half speed
$ \pl1 -> Just $ doorBetween eo wl cond soff b half speed
$ \pl2 -> cont pl1 pl2
where
half = 0.5 *.* (a +.+ b)
doorBetween :: Wall -> (World -> Bool) -> Float -> Point2 -> Point2 -> Float ->
doorBetween :: EdgeObstacle -> Wall -> (World -> Bool) -> Float -> Point2 -> Point2 -> Float ->
(Placement -> Maybe Placement) -> Placement
doorBetween wl cond soff pa pb speed g = case divideLine 40 pa pb of
[x,y] -> ptCont (PutSlideDr adoor wl DoorObstacle soff x y) g
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
_ -> undefined
where
@@ -55,7 +55,7 @@ divideDoorPane mid wl cond soff speed ppairs g = case ppairs of
putAutoDoor :: Point2 -> Point2 -> Placement
putAutoDoor a b = PlacementUsingPos (addZ 0 a)
$ \az -> PlacementUsingPos (addZ 0 b)
$ \bz -> putDoubleDoor defaultAutoWall
$ \bz -> putDoubleDoor AutoDoorObstacle defaultAutoWall
(cond az bz) a b 3
where
--cond az bz = any (crNearSeg 40 (stripZ az) (stripZ bz)) . IM.filter isAnimate . _creatures