Improve door pathing update
This commit is contained in:
@@ -15,25 +15,25 @@ import Dodge.LevelGen.Switch
|
|||||||
import Control.Lens
|
import Control.Lens
|
||||||
import qualified Data.IntMap.Strict as IM
|
import qualified Data.IntMap.Strict as IM
|
||||||
|
|
||||||
putDoubleDoor :: Wall -> (World -> Bool) -> Point2 -> Point2 -> Float -> Placement
|
putDoubleDoor :: EdgeObstacle -> Wall -> (World -> Bool) -> Point2 -> Point2 -> Float -> Placement
|
||||||
putDoubleDoor wl cond a b speed
|
putDoubleDoor eo wl cond a b speed
|
||||||
= putDoubleDoorThen wl cond 1 a b speed (const $ const Nothing)
|
= putDoubleDoorThen eo wl cond 1 a b speed (const $ const Nothing)
|
||||||
|
|
||||||
putDoubleDoorThen :: Wall -> (World -> Bool)
|
putDoubleDoorThen ::EdgeObstacle -> Wall -> (World -> Bool)
|
||||||
-> Float -> Point2 -> Point2 -> Float
|
-> Float -> Point2 -> Point2 -> Float
|
||||||
-> (Placement -> Placement -> Maybe Placement)
|
-> (Placement -> Placement -> Maybe Placement)
|
||||||
-> Placement
|
-> Placement
|
||||||
putDoubleDoorThen wl cond soff a b speed cont
|
putDoubleDoorThen eo wl cond soff a b speed cont
|
||||||
= doorBetween wl cond soff a half speed
|
= doorBetween eo wl cond soff a half speed
|
||||||
$ \pl1 -> Just $ doorBetween wl cond soff b half speed
|
$ \pl1 -> Just $ doorBetween eo wl cond soff b half speed
|
||||||
$ \pl2 -> cont pl1 pl2
|
$ \pl2 -> cont pl1 pl2
|
||||||
where
|
where
|
||||||
half = 0.5 *.* (a +.+ b)
|
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
|
(Placement -> Maybe Placement) -> Placement
|
||||||
doorBetween wl cond soff pa pb speed g = case divideLine 40 pa pb of
|
doorBetween eo wl cond soff pa pb speed g = case divideLine 40 pa pb of
|
||||||
[x,y] -> ptCont (PutSlideDr adoor wl DoorObstacle soff x y) g
|
[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
|
(x:y:zs) -> divideDoorPane Nothing wl cond (soff - dist y pb) speed (zip (x:y:zs) (y:zs)) g
|
||||||
_ -> undefined
|
_ -> undefined
|
||||||
where
|
where
|
||||||
@@ -55,7 +55,7 @@ divideDoorPane mid wl cond soff speed ppairs g = case ppairs of
|
|||||||
putAutoDoor :: Point2 -> Point2 -> Placement
|
putAutoDoor :: Point2 -> Point2 -> Placement
|
||||||
putAutoDoor a b = PlacementUsingPos (addZ 0 a)
|
putAutoDoor a b = PlacementUsingPos (addZ 0 a)
|
||||||
$ \az -> PlacementUsingPos (addZ 0 b)
|
$ \az -> PlacementUsingPos (addZ 0 b)
|
||||||
$ \bz -> putDoubleDoor defaultAutoWall
|
$ \bz -> putDoubleDoor AutoDoorObstacle defaultAutoWall
|
||||||
(cond az bz) a b 3
|
(cond az bz) a b 3
|
||||||
where
|
where
|
||||||
--cond az bz = any (crNearSeg 40 (stripZ az) (stripZ bz)) . IM.filter isAnimate . _creatures
|
--cond az bz = any (crNearSeg 40 (stripZ az) (stripZ bz)) . IM.filter isAnimate . _creatures
|
||||||
|
|||||||
@@ -27,8 +27,8 @@ airlock0 = defaultRoom
|
|||||||
, _rmPath = foldMap doublePairSet [(V2 20 95,V2 20 45) ,(V2 20 45,V2 20 5) ]
|
, _rmPath = foldMap doublePairSet [(V2 20 95,V2 20 45) ,(V2 20 45,V2 20 5) ]
|
||||||
, _rmPmnts =
|
, _rmPmnts =
|
||||||
[pContID (PS (V2 (-35) 50) (negate $ pi/2)) (PutButton $ makeSwitch col red id id)
|
[pContID (PS (V2 (-35) 50) (negate $ pi/2)) (PutButton $ makeSwitch col red id id)
|
||||||
$ \btid -> Just $ putDoubleDoorThen thewall (not . cond' btid) 1 (V2 0 20) (V2 40 20) 2
|
$ \btid -> Just $ putDoubleDoorThen DoorObstacle thewall (not . cond' btid) 1 (V2 0 20) (V2 40 20) 2
|
||||||
$ \_ _ -> Just $ putDoubleDoor thewall (cond' btid) (V2 0 80) (V2 40 80) 2
|
$ \_ _ -> Just $ putDoubleDoor DoorObstacle thewall (cond' btid) (V2 0 80) (V2 40 80) 2
|
||||||
, invisibleWall $ rectNSWE 60 40 (-40) (-30)
|
, invisibleWall $ rectNSWE 60 40 (-40) (-30)
|
||||||
,spanLightI (V2 (-2) 30) (V2 (-2) 70)
|
,spanLightI (V2 (-2) 30) (V2 (-2) 70)
|
||||||
,sps0 $ putShape $ thinHighBar 75 (V2 40 50) (V2 (-1) 50)
|
,sps0 $ putShape $ thinHighBar 75 (V2 40 50) (V2 (-1) 50)
|
||||||
|
|||||||
@@ -40,6 +40,6 @@ triggerDoorRoom inplid = defaultRoom
|
|||||||
-- note no bounds
|
-- note no bounds
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
f (pmnt:_) = putDoubleDoor (switchWallCol red) (cond pmnt) (V2 0 20) (V2 40 20) 2
|
f (pmnt:_) = putDoubleDoor DoorObstacle (switchWallCol red) (cond pmnt) (V2 0 20) (V2 40 20) 2
|
||||||
f _ = error "tried to put a door using an empty placement list"
|
f _ = error "tried to put a door using an empty placement list"
|
||||||
cond pmnt w = w & _triggers w IM.! fromJust (_plMID pmnt)
|
cond pmnt w = w & _triggers w IM.! fromJust (_plMID pmnt)
|
||||||
|
|||||||
@@ -118,7 +118,7 @@ addButtonSlowDoor x h rm = do
|
|||||||
thewall = switchWallCol red
|
thewall = switchWallCol red
|
||||||
butDoor = putLitButOnPos col
|
butDoor = putLitButOnPos col
|
||||||
(rprBool (isUnusedLnkType InLink))
|
(rprBool (isUnusedLnkType InLink))
|
||||||
$ \btplmnt -> Just $ putDoubleDoorThen thewall (cond' $ fromJust $ _plMID btplmnt)
|
$ \btplmnt -> Just $ putDoubleDoorThen DoorObstacle thewall (cond' $ fromJust $ _plMID btplmnt)
|
||||||
30 (V2 0 h) (V2 x h) 2
|
30 (V2 0 h) (V2 x h) 2
|
||||||
$ \dr1 dr2 ->
|
$ \dr1 dr2 ->
|
||||||
amountedlight dr1 50
|
amountedlight dr1 50
|
||||||
|
|||||||
Reference in New Issue
Block a user