justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Automatically determine automatic doors

Browse Source
This commit is contained in:
justin
2025-10-24 21:08:41 +01:00
parent f94b914ceb
commit 6457f00ba7
8 changed files with 100 additions and 105 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/GenWorld.hs
+2 -2
View File
@@ -52,8 +52,8 @@ data PSType
, _putEndPoint :: Point2
}
| PutWall {_pwPoly :: [Point2], _pwWall :: Wall}
| PutSlideDr Bool Door Wall Float Point2 Point2
| PutDoor Bool WdBl Float Point2A Point2A
| PutSlideDr Door Wall Float Point2 Point2
| PutDoor WdBl Float Point2A Point2A
| RandPS (State StdGen PSType)
| PutForeground ForegroundShape
| PutWorldUpdate (Int -> PlacementSpot -> GenWorld -> GenWorld)
src/Dodge/Placement/Instance/Door.hs
+6 -4
View File
@@ -4,6 +4,7 @@ module Dodge.Placement.Instance.Door (
putDoubleDoorThen,
) where
import Linear
import Control.Lens
import Dodge.Data.CreatureEffect
import Dodge.Data.GenWorld
@@ -52,7 +53,7 @@ doorBetween ::
(Placement -> Maybe Placement) ->
Placement
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] -> ptCont (PutSlideDr 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
@@ -76,7 +77,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 soff x y
adoor (x, y) = PutSlideDr thedoor wl soff x y
thedoor =
defaultDoor & drUpdate . drLerpSpeed .~ speed & drTrigger .~ cond
& drPushedBy .~ maybe PushesItself PushedBy mid
@@ -88,9 +89,10 @@ putAutoDoor a b = Placement (PS 0 0) (PutCoord a) Nothing Nothing $ \_ apl ->
let x = w ^?! gwWorld . coordinates . ix (apl ^?! plMID . _Just)
y = w ^?! gwWorld . coordinates . ix (bpl ^?! plMID . _Just)
in Just $
putDoubleDoor True
putDoubleDoor
True
defaultAutoWall
(WdBlCrFilterNearPoint 40 (0.5 *.* (x + y)) CrIsAnimate)
(WdBlCrFilterNearPoint 40 (0.5 *^ (x + y)) CrIsAnimate)
a
b
3
src/Dodge/Placement/PlaceSpot.hs
+3 -3
View File
@@ -134,10 +134,10 @@ placeSpotID rid ps pt w = case pt of
PutMachine pps mc mitm -> plMachine (map doShift pps) mc mitm p rot w
PutLS ls -> plNewUpID (gwWorld . cWorld . lWorld . lightSources) lsID (mvLS p' rot ls) w
RandPS _ -> error "RandPS should not be reachable here" --evaluateRandPS rid rgn ps w
PutDoor isauto f l p1 p2 -> plDoor isauto f l (pashift p1) (pashift p2) w
PutDoor f l p1 p2 -> plDoor f l (pashift p1) (pashift p2) w
PutCoord cp -> plNewID (gwWorld . coordinates) (doShift cp) w
PutSlideDr isauto wl dr off a b ->
plSlideDoor isauto wl dr off (doShift a) (doShift b) w
PutSlideDr wl dr off a b ->
plSlideDoor wl dr off (doShift a) (doShift b) w
PutBlock bl wl ps' ->
plBlock
(map doShift ps')
src/Dodge/Placement/PlaceSpot/TriggerDoor.hs
+8 -7
View File
@@ -3,12 +3,10 @@ module Dodge.Placement.PlaceSpot.TriggerDoor (
plSlideDoor,
) where
--import Data.List
import Dodge.Data.GenWorld
import Dodge.Default.Door
import Dodge.Default.Wall
import Dodge.LevelGen.DoorPane
--import Dodge.Path
import Dodge.Placement.PlaceSpot.Block
import Dodge.ShiftPoint
import Geometry
@@ -17,8 +15,6 @@ import LensHelp
import Linear
plDoor ::
-- | Is door automatic?
Bool ->
-- | Opening condition
WdBl ->
-- | Door positions, closed to open.
@@ -28,12 +24,15 @@ plDoor ::
Point2A ->
GenWorld ->
(Int, GenWorld)
plDoor isauto cond l p1 p2 gw =
plDoor cond l p1 p2 gw =
( drid
, over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors . at drid ?~ addDoor
-- carefull with the ordering of addWalls
)
where
isauto = case cond of
WdBlCrFilterNearPoint{} -> True
_ -> False
drid = IM.newKey $ _doors (_lWorld (_cWorld $ _gwWorld gw))
addDoor =
defaultDoor
@@ -83,7 +82,6 @@ plDoor isauto cond l p1 p2 gw =
-- w' = uncurry (obstructPathsCrossing eo) wlps w
plSlideDoor ::
Bool ->
Door ->
Wall ->
Float ->
@@ -91,10 +89,13 @@ plSlideDoor ::
Point2 ->
GenWorld ->
(Int, GenWorld)
plSlideDoor isauto dr wl shiftOffset a b gw =
plSlideDoor dr wl shiftOffset a b gw =
--(drid, over gwWorld addDoorWalls $ gw & gwWorld . cWorld . lWorld . doors %~ addDoor)
(drid, over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors %~ addDoor)
where
isauto = case dr ^. drTrigger of
WdBlCrFilterNearPoint{} -> True
_ -> False
drid = IM.newKey $ _doors (_lWorld (_cWorld $ _gwWorld gw))
addDoor =
IM.insert drid $
src/Dodge/Room/Airlock.hs
+4 -7
View File
@@ -95,9 +95,6 @@ airlock0 =
]
col = dim $ dim $ bright red
airlockDoor :: WdBl -> Float -> Point2A -> Point2A -> PSType
airlockDoor = PutDoor False
airlockDoubleDoor ::
Point2 ->
Point2 ->
@@ -110,8 +107,8 @@ airlockDoubleDoor ::
Point2A ->
Maybe Placement
airlockDoubleDoor p1 p2 cond l1 x1 y1 l2 x2 y2 =
jspsJ p1 0 (airlockDoor cond l1 x1 y1) $
sPS p2 0 (airlockDoor cond l2 x2 y2)
jspsJ p1 0 (PutDoor cond l1 x1 y1) $
sPS p2 0 (PutDoor cond l2 x2 y2)
airlockSimple :: Room
airlockSimple =
@@ -217,7 +214,7 @@ airlock90 =
[ pContID
(PS (V2 120 120) (3 * pi / 4))
(PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect)
$ \btid -> jsps (V2 5 5) 0 $ airlockDoor (WdBlBtOn btid) l1 x1 y1
$ \btid -> jsps (V2 5 5) 0 $ PutDoor (WdBlBtOn btid) l1 x1 y1
, mntLS vShape (V2 35 35) (V3 70 70 50)
]
, _rmBound =
@@ -251,7 +248,7 @@ airlockCrystal =
[ pContID
(PS (V2 145 70) (pi / 2))
(PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect)
$ \btid -> jsps (V2 40 70) 0 $ airlockDoor (WdBlBtOn btid) l1 x1 y1
$ \btid -> jsps (V2 40 70) 0 $ PutDoor (WdBlBtOn btid) l1 x1 y1
, crystalLine (V2 0 70) (V2 40 70)
, mntLS vShape (V2 150 70) (V3 110 70 70)
]
src/Dodge/Room/LongDoor.hs
+2 -2
View File
@@ -48,8 +48,8 @@ twinSlowDoorRoom w h x =
, _rmPath = mempty
, _rmPmnts =
[ pContID (PS (V2 0 (h -5)) pi) (PutButton $ makeButton col NoWorldEffect) $
\btid -> jsps0J (PutSlideDr False (thedoor btid) thewall 1 (V2 x 1) (V2 x h)) $
ps0 (PutSlideDr False (thedoor btid) thewall 1 (V2 (- x) 1) (V2 (- x) h)) $
\btid -> jsps0J (PutSlideDr (thedoor btid) thewall 1 (V2 x 1) (V2 x h)) $
ps0 (PutSlideDr (thedoor btid) thewall 1 (V2 (- x) 1) (V2 (- x) h)) $
\did -> jps0' (PutLS (lsColPos (V3 0.75 0 0) (V3 0 (h -1) lampheight))) $
\lspl -> jsps0 $ PutProp $ addColorChange (fromJust $ _plMID lspl) did $ lampCoverWhen (WdBlDoorMoving did) (V2 0 (h -1)) lampheight
]
src/Dodge/Room/Procedural.hs
+2 -2
View File
@@ -328,8 +328,8 @@ centerVaultRoom w h d =
theDoor =
[ pContID (PS (V2 35 (d + 4)) 0) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
\btid ->
jspsJ (V2 0 (d -10)) 0 (PutSlideDr False (thedoor btid) thewall 1 (V2 (-21) 0) (V2 0 0)) $
sPS (V2 0 (d -10)) 0 (PutSlideDr False (thedoor btid) thewall 1 (V2 21 0) (V2 0 0))
jspsJ (V2 0 (d -10)) 0 (PutSlideDr (thedoor btid) thewall 1 (V2 (-21) 0) (V2 0 0)) $
sPS (V2 0 (d -10)) 0 (PutSlideDr (thedoor btid) thewall 1 (V2 21 0) (V2 0 0))
]
--thewall = switchWallCol col
thewall = defaultDoorWall