Cleanup door placement/auto path generation
This commit is contained in:
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user