Cleanup door placement/auto path generation

This commit is contained in:
2025-10-24 20:51:38 +01:00
parent b0d519c69d
commit f94b914ceb
9 changed files with 83 additions and 155 deletions
+8 -56
View File
@@ -2,35 +2,29 @@ module Dodge.Placement.Instance.Door (
putDoubleDoor,
putAutoDoor,
putDoubleDoorThen,
switchDoor, -- not used 9/3/22
) where
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 ::
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)
putDoubleDoor isauto wl cond a b speed =
putDoubleDoorThen isauto wl cond 1 a b speed (const $ const Nothing)
putDoubleDoorThen ::
Bool ->
S.Set EdgeObstacle ->
Wall ->
WdBl ->
Float ->
@@ -39,17 +33,16 @@ putDoubleDoorThen ::
Float ->
(Placement -> Placement -> Maybe Placement) ->
Placement
putDoubleDoorThen isauto eo wl cond soff a b speed cont =
doorBetween isauto eo wl cond soff a half speed $
putDoubleDoorThen isauto wl cond soff a b speed cont =
doorBetween isauto wl cond soff a half speed $
\pl1 -> Just $
doorBetween isauto eo wl cond soff b half speed $
doorBetween isauto wl cond soff b half speed $
\pl2 -> cont pl1 pl2
where
half = 0.5 *.* (a +.+ b)
doorBetween ::
Bool ->
S.Set EdgeObstacle ->
Wall ->
WdBl ->
Float ->
@@ -58,8 +51,8 @@ doorBetween ::
Float ->
(Placement -> Maybe Placement) ->
Placement
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
doorBetween isauto wl cond soff pa pb speed g = case divideLine 40 pa pb of
[x, y] -> ptCont (PutSlideDr isauto adoor wl 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
@@ -83,7 +76,7 @@ divideDoorPane isauto mid wl cond soff speed ppairs g = case ppairs of
(p : ps) -> ptCont (adoor p) $ \pl -> Just $ divideDoorPane isauto (_plMID pl) wl cond soff speed ps g
_ -> undefined
where
adoor (x, y) = PutSlideDr isauto thedoor wl mempty soff x y
adoor (x, y) = PutSlideDr isauto thedoor wl soff x y
thedoor =
defaultDoor & drUpdate . drLerpSpeed .~ speed & drTrigger .~ cond
& drPushedBy .~ maybe PushesItself PushedBy mid
@@ -96,49 +89,8 @@ putAutoDoor a b = Placement (PS 0 0) (PutCoord a) Nothing Nothing $ \_ apl ->
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) $
-- \bz ->
-- putDoubleDoor
-- AutoDoorObstacle
-- defaultAutoWall
-- (cond az bz)
-- a
-- b
-- 3
-- where
-- cond az bz = WdBlCrFilterNearPoint 40 (0.5 *.* (stripZ az +.+ stripZ bz)) CrIsAnimate
switchDoor :: Point2 -> Float -> Point2 -> Point2 -> Color -> Placement
switchDoor btpos btrot dra drb col = pContID
(PS btpos btrot)
(PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect)
$ \btid ->
jsps0J (doorbetween btid dra drc) $
sps0 (doorbetween btid drb drc)
where
--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
& drTrigger .~ WdBlBtOn btid
& drUpdate . drLerpSpeed .~ 2
drc = 0.5 *.* (dra +.+ drb)
--cond btid w' = _btState (_buttons w' IM.! btid) == BtOn