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

Single source of truth for wall pathing

Browse Source
This commit is contained in:
justin
2025-10-24 14:25:19 +01:00
parent 0eeae7e6bc
commit 488428b1ef
19 changed files with 156 additions and 121 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/GenWorld.hs
+2 -2
View File
@@ -52,9 +52,9 @@ data PSType
, _putEndPoint :: Point2
}
| PutWall {_pwPoly :: [Point2], _pwWall :: Wall}
| PutSlideDr Door Wall (S.Set EdgeObstacle) Float Point2 Point2
| PutSlideDr Bool Door Wall (S.Set EdgeObstacle) Float Point2 Point2
-- | PutDoor Color EdgeObstacle WdBl [(Point2, Point2)]
| PutDoor (S.Set EdgeObstacle) WdBl Float Point2A Point2A -- [(Point2, Point2)]
| PutDoor Bool (S.Set EdgeObstacle) WdBl Float Point2A Point2A -- [(Point2, Point2)]
| RandPS (State StdGen PSType)
| PutForeground ForegroundShape
| PutWorldUpdate (Int -> PlacementSpot -> GenWorld -> GenWorld)
src/Dodge/Data/Wall.hs
+1 -1
View File
@@ -19,7 +19,7 @@ data Wall = Wall
{ _wlLine :: (Point2, Point2)
, _wlID :: Int
, _wlOpacity :: Opacity
, _wlPathFlag :: S.Set WallFlag
-- , _wlPathFlag :: S.Set WallFlag
, _wlTouchThrough :: Bool
, _wlUnshadowed :: Bool
, _wlRotateTo :: Bool
src/Dodge/Data/Wall/Structure.hs
+1 -1
View File
@@ -9,7 +9,7 @@ import Data.Aeson.TH
data WallStructure
= StandaloneWall
| DoorPart {_wsDoor :: Int}
| DoorPart {_wsDoor :: Int, _wsIsAutoDoor :: Bool}
| MachinePart {_wsMachine :: Int}
| BlockPart {_wsBlock :: Int}
| CreaturePart {_wlStCreature :: Int}
src/Dodge/Default/Wall.hs
+10 -10
View File
@@ -19,8 +19,8 @@ defaultWall =
Wall
{ _wlLine = (V2 0 0, V2 50 0)
, _wlID = 0
, _wlPathFlag =
S.fromList [minBound .. maxBound]
-- , _wlPathFlag =
-- S.fromList [minBound .. maxBound]
, _wlOpacity = Opaque 11
, _wlUnshadowed = True
, _wlRotateTo = True
@@ -33,7 +33,7 @@ defaultWall =
defaultDoorWall :: Wall
defaultDoorWall =
defaultWall
& wlPathFlag . at WallNotDestrucable .~ Nothing
-- & wlPathFlag . at WallNotDestrucable .~ Nothing
& wlMaterial .~ Metal
& wlOpacity .~ Opaque 0
@@ -41,13 +41,13 @@ defaultAutoWall :: Wall
defaultAutoWall =
defaultDoorWall
& wlOpacity .~ Opaque 9
& wlPathFlag . at WallNotAutoOpen .~ Nothing
-- & wlPathFlag . at WallNotAutoOpen .~ Nothing
{- Indestructible see-through wall. -}
defaultCrystalWall :: Wall
defaultCrystalWall =
defaultWall & wlOpacity .~ SeeThrough & wlMaterial .~ Crystal
& wlPathFlag . at WallBlockVisibility .~ Nothing
-- & wlPathFlag . at WallBlockVisibility .~ Nothing
defaultMachineWall :: Wall
defaultMachineWall =
@@ -58,8 +58,8 @@ defaultMachineWall =
, _wlMaterial = Metal
, _wlTouchThrough = True
}
& wlPathFlag . at WallBlockVisibility .~ Nothing
& wlPathFlag . at WallNotDestrucable .~ Nothing
-- & wlPathFlag . at WallBlockVisibility .~ Nothing
-- & wlPathFlag . at WallNotDestrucable .~ Nothing
defaultDirtWall :: Wall
defaultDirtWall =
@@ -70,7 +70,7 @@ defaultDirtWall =
, _wlRotateTo = False
, _wlMaterial = Dirt
}
& wlPathFlag . at WallNotDestrucable .~ Nothing
-- & wlPathFlag . at WallNotDestrucable .~ Nothing
defaultWindow :: Wall
defaultWindow =
@@ -80,5 +80,5 @@ defaultWindow =
, _wlOpacity = SeeThrough
, _wlMaterial = Glass
}
& wlPathFlag . at WallNotDestrucable .~ Nothing
& wlPathFlag . at WallBlockVisibility .~ Nothing
-- & wlPathFlag . at WallNotDestrucable .~ Nothing
-- & wlPathFlag . at WallBlockVisibility .~ Nothing
src/Dodge/Item/BackgroundEffect.hs
+2 -2
View File
@@ -82,6 +82,6 @@ shieldWall crid =
, _wlMaterial = Metal
, _wlRotateTo = False
, _wlStructure = CreaturePart crid -- shieldWallDamage
, _wlPathFlag = mempty
-- , _wlPathFlag = mempty
}
& wlPathFlag .~ mempty
-- & wlPathFlag .~ mempty
src/Dodge/Placement/Instance/Block.hs
+2 -2
View File
@@ -16,8 +16,8 @@ decoratedBlock decf mat col h ps = PutBlock bl wl $ reverse ps
& blHeight .~ h
wl =
defaultWall
& wlPathFlag . at WallNotDestrucable .~ Nothing
& wlPathFlag . at WallBlockVisibility .~ Nothing
-- & wlPathFlag . at WallNotDestrucable .~ Nothing
-- & wlPathFlag . at WallBlockVisibility .~ Nothing
& wlRotateTo .~ False
& wlOpacity .~ SeeAbove
& wlMaterial .~ mat
src/Dodge/Placement/Instance/Door.hs
+48 -29
View File
@@ -5,23 +5,31 @@ module Dodge.Placement.Instance.Door (
switchDoor, -- not used 9/3/22
) where
import Dodge.Default.Wall
import Dodge.Default.Door
import qualified Data.Set as S
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 :: S.Set EdgeObstacle
-> Wall -> WdBl -> Point2 -> Point2 -> Float -> Placement
putDoubleDoor eo wl cond a b speed =
putDoubleDoorThen eo wl cond 1 a b speed (const $ const Nothing)
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)
putDoubleDoorThen ::
Bool ->
S.Set EdgeObstacle ->
Wall ->
WdBl ->
@@ -31,15 +39,16 @@ putDoubleDoorThen ::
Float ->
(Placement -> Placement -> Maybe Placement) ->
Placement
putDoubleDoorThen eo wl cond soff a b speed cont =
doorBetween eo wl cond soff a half speed $
putDoubleDoorThen isauto eo wl cond soff a b speed cont =
doorBetween isauto eo wl cond soff a half speed $
\pl1 -> Just $
doorBetween eo wl cond soff b half speed $
doorBetween isauto eo wl cond soff b half speed $
\pl2 -> cont pl1 pl2
where
half = 0.5 *.* (a +.+ b)
doorBetween ::
Bool ->
S.Set EdgeObstacle ->
Wall ->
WdBl ->
@@ -49,9 +58,9 @@ doorBetween ::
Float ->
(Placement -> Maybe Placement) ->
Placement
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
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
(x : y : zs) -> divideDoorPane isauto Nothing wl cond (soff - dist y pb) speed (zip (x : y : zs) (y : zs)) g
_ -> undefined
where
adoor =
@@ -60,6 +69,7 @@ doorBetween eo wl cond soff pa pb speed g = case divideLine 40 pa pb of
& drUpdate . drLerpSpeed .~ speed
divideDoorPane ::
Bool ->
Maybe Int ->
Wall ->
WdBl ->
@@ -68,28 +78,31 @@ divideDoorPane ::
[(Point2, Point2)] ->
(Placement -> Maybe Placement) ->
Placement
divideDoorPane mid wl cond soff speed ppairs g = case ppairs of
divideDoorPane isauto mid wl cond soff speed ppairs g = case ppairs of
[p] -> ptCont (adoor p) g
(p : ps) -> ptCont (adoor p) $ \pl -> Just $ divideDoorPane (_plMID pl) wl cond soff speed ps g
(p : ps) -> ptCont (adoor p) $ \pl -> Just $ divideDoorPane isauto (_plMID pl) wl cond soff speed ps g
_ -> undefined
where
adoor (x, y) = PutSlideDr thedoor wl mempty soff x y
adoor (x, y) = PutSlideDr isauto thedoor wl mempty soff x y
thedoor =
defaultDoor & drUpdate . drLerpSpeed .~ speed & drTrigger .~ cond
& drPushedBy .~ maybe PushesItself PushedBy mid
putAutoDoor :: Point2 -> Point2 -> Placement
putAutoDoor a b = Placement (PS 0 0) (PutCoord a) Nothing Nothing $ \_ apl ->
Just $ Placement (PS 0 0) (PutCoord b) Nothing Nothing $ \w bpl ->
let x = w ^?! gwWorld . coordinates . ix (apl ^?! plMID . _Just)
y = w ^?! gwWorld . coordinates . ix (bpl ^?! plMID . _Just)
in Just $ putDoubleDoor
(S.fromList [WallObstacle WallBlockVisibility])
defaultAutoWall
(WdBlCrFilterNearPoint 40 (0.5 *.* (x + y)) CrIsAnimate)
a
b
3
Just $
Placement (PS 0 0) (PutCoord b) Nothing Nothing $ \w bpl ->
let x = w ^?! gwWorld . coordinates . ix (apl ^?! plMID . _Just)
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) $
@@ -112,9 +125,15 @@ switchDoor btpos btrot dra drb col = pContID
jsps0J (doorbetween btid dra drc) $
sps0 (doorbetween btid drb drc)
where
--doorbetween btid a b = PutSlideDr thedoor (switchWallCol col)
doorbetween btid a b = PutSlideDr thedoor defaultDoorWall
(S.fromList (WallObstacle <$> [WallNotAutoOpen,WallBlockVisibility])) 1 a b
--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
src/Dodge/Placement/Instance/Wall.hs
+1 -1
View File
@@ -95,7 +95,7 @@ crystalLine a b = sps0 $ PutLineBlock defaultCrystalWall 7 a b
baseBlockPane :: Wall
baseBlockPane = defaultWall & wlOpacity .~ Opaque 17
& wlPathFlag .~ S.fromList [WallBlockVisibility, WallNotAutoOpen]
-- & wlPathFlag .~ S.fromList [WallBlockVisibility, WallNotAutoOpen]
-- TODO find home for this
{- Replaces instances of a given 'PutID' with 'PSType's drawn from a list. -}
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 eo f l p1 p2 -> plDoor eo f l (pashift p1) (pashift p2) w
PutDoor isauto eo f l p1 p2 -> plDoor isauto eo f l (pashift p1) (pashift p2) w
PutCoord cp -> plNewID (gwWorld . coordinates) (doShift cp) w
PutSlideDr wl dr eo off a b ->
plSlideDoor wl dr eo off (doShift a) (doShift b) w
PutSlideDr isauto wl dr eo off a b ->
plSlideDoor isauto wl dr eo off (doShift a) (doShift b) w
PutBlock bl wl ps' ->
plBlock
(map doShift ps')
src/Dodge/Placement/PlaceSpot/Block.hs
+2 -1
View File
@@ -4,6 +4,7 @@ module Dodge.Placement.PlaceSpot.Block (
plLineBlock,
) where
import Dodge.Wall.Pathing
import qualified Data.Set as S
import Control.Lens
import qualified Data.IntSet as IS
@@ -115,6 +116,6 @@ insertWalls wls w = foldl' (flip insertWall) w wls
insertWall :: Wall -> World -> World
insertWall wl =
uncurry (obstructPathsCrossing (S.map WallObstacle $ wl ^. wlPathFlag))
uncurry (obstructPathsCrossing (S.map WallObstacle $ getWallPathing wl))
(_wlLine wl)
. (cWorld . lWorld . walls . at (_wlID wl) ?~ wl)
src/Dodge/Placement/PlaceSpot/TriggerDoor.hs
+28 -17
View File
@@ -4,20 +4,21 @@ module Dodge.Placement.PlaceSpot.TriggerDoor (
updateDoorEdges,
) where
import Dodge.Default.Wall
import qualified Data.Set as S
import Dodge.ShiftPoint
import Linear
import Dodge.Data.GenWorld
import Data.List
import qualified Data.Set as S
import Dodge.Data.GenWorld
import Dodge.Default.Door
import Dodge.Default.Wall
import Dodge.LevelGen.DoorPane
import Dodge.Path
import Dodge.ShiftPoint
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import Linear
plDoor ::
Bool ->
S.Set EdgeObstacle ->
-- | Opening condition
WdBl ->
@@ -28,7 +29,7 @@ plDoor ::
Point2A ->
GenWorld ->
(Int, GenWorld)
plDoor eo cond l p1 p2 gw = (drid, over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors %~ addDoor) -- carefull with the ordering of addWalls
plDoor isauto eo cond l p1 p2 gw = (drid, over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors %~ addDoor) -- carefull with the ordering of addWalls
where
drid = IM.newKey $ _doors (_lWorld (_cWorld $ _gwWorld gw))
addDoor =
@@ -45,12 +46,20 @@ plDoor eo cond l p1 p2 gw = (drid, over gwWorld addWalls $ gw & gwWorld . cWorld
wlids = take 4 [IM.newKey $ _walls (_lWorld (_cWorld $ _gwWorld gw)) ..]
wlps' = rectanglePairs 9 0 (V2 l 0)
--addWalls w' = foldl' (addDoorWall eo drid $ switchWallCol col) w' $ zip wlids
addWalls w' = foldl' (addDoorWall eo drid defaultDoorWall) w' $ zip wlids
$ wlps' & each . each %~ shiftPointBy p1
addWalls w' =
foldl' (addDoorWall isauto eo drid defaultDoorWall) w' $
zip wlids $
wlps' & each . each %~ shiftPointBy p1
addDoorWall :: S.Set EdgeObstacle
-> Int -> Wall -> World -> (Int, (Point2, Point2)) -> World
addDoorWall eo drid wl w (wlid, wlps) =
addDoorWall ::
Bool ->
S.Set EdgeObstacle ->
Int ->
Wall ->
World ->
(Int, (Point2, Point2)) ->
World
addDoorWall isauto eo drid wl w (wlid, wlps) =
w'
& cWorld . lWorld . walls
%~ IM.insert
@@ -58,23 +67,25 @@ addDoorWall eo drid wl w (wlid, wlps) =
wl
{ _wlLine = wlps
, _wlID = wlid
, _wlStructure = DoorPart drid
, _wlStructure = DoorPart drid isauto
}
where
w' = uncurry (obstructPathsCrossing eo) wlps w
updateDoorEdges :: EdgeObstacle -> [(Int,Int)] -> World -> World
updateDoorEdges :: EdgeObstacle -> [(Int, Int)] -> World -> World
updateDoorEdges eo es w = foldl' (updateDoorEdge eo) w es
updateDoorEdge :: EdgeObstacle -> World -> (Int,Int) -> World
updateDoorEdge :: EdgeObstacle -> World -> (Int, Int) -> World
--updateDoorEdge eo w (i,j) = w
updateDoorEdge _ w _ = w
-- | not . null $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w =
-- w & cWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles . at eo ?~ ()) . FGL.delEdge (x, y)
-- | otherwise =
-- w & cWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles . at eo .~ Nothing) . FGL.delEdge (x, y)
plSlideDoor ::
Bool ->
Door ->
Wall ->
S.Set EdgeObstacle ->
@@ -83,7 +94,7 @@ plSlideDoor ::
Point2 ->
GenWorld ->
(Int, GenWorld)
plSlideDoor dr wl eo shiftOffset a b gw =
plSlideDoor isauto dr wl eo shiftOffset a b gw =
(drid, over gwWorld addDoorWalls $ gw & gwWorld . cWorld . lWorld . doors %~ addDoor)
where
drid = IM.newKey $ _doors (_lWorld (_cWorld $ _gwWorld gw))
@@ -95,9 +106,9 @@ plSlideDoor dr wl eo shiftOffset a b gw =
, _drZeroPos = (a, 0)
, _drOnePos = (shiftLeft a, 0)
, _drLerp = 0
, _drFootPrint = IM.fromList $ zip wlids $ rectanglePairs 9 0 (b-a)
, _drFootPrint = IM.fromList $ zip wlids $ rectanglePairs 9 0 (b - a)
}
addDoorWalls w' = foldl' (addDoorWall eo drid wl) w' $ zip wlids pairs
addDoorWalls w' = foldl' (addDoorWall isauto eo drid wl) w' $ zip wlids pairs
pairs = rectanglePairs 9 a b
shiftLeft = (+.+ (a -.- b +.+ shiftOffset *.* normalizeV (b -.- a)))
wlids = take 4 [IM.newKey $ _walls (_lWorld (_cWorld $ _gwWorld gw)) ..]
src/Dodge/Room/Airlock.hs
+6 -6
View File
@@ -35,8 +35,8 @@ decontamRoom i =
& rmPmnts
.~ [ pContID (PS (V2 (-35) 50) (negate $ pi / 2)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
\btid -> Just $
putDoubleDoorThen switchWallObs thewall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $
\_ _ -> Just $ putDoubleDoor switchWallObs thewall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
putDoubleDoorThen False switchWallObs thewall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $
\_ _ -> Just $ putDoubleDoor False switchWallObs thewall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
, invisibleWall $ rectNSWE 60 40 (-40) (-30)
, spanLightI (V2 (-20) 30) (V2 (-20) 70)
, analyser (NoItemZone ps) (PS 50 0) (PS mcpos 0) & plExternalID ?~ i
@@ -49,7 +49,7 @@ decontamRoom i =
f gw = fromMaybe (error "tried to put a door using an empty placement list") $ do
pmnt <- gw ^? genPmnt . ix i
return $
putDoubleDoor
putDoubleDoor False
switchWallObs
defaultDoorWall
(cond pmnt)
@@ -79,8 +79,8 @@ airlock0 =
, _rmPmnts =
[ pContID (PS (V2 (-35) 50) (negate $ pi / 2)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
\btid -> Just $
putDoubleDoorThen switchWallObs thewall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $
\_ _ -> Just $ putDoubleDoor switchWallObs thewall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
putDoubleDoorThen False switchWallObs thewall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $
\_ _ -> Just $ putDoubleDoor False switchWallObs thewall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
, invisibleWall $ rectNSWE 60 40 (-40) (-30)
, spanLightI (V2 (-2) 30) (V2 (-2) 70)
, sps0 $ putShape $ thinHighBar 75 (V2 40 50) (V2 (-1) 50)
@@ -98,7 +98,7 @@ airlock0 =
--airlockDoor :: Color -> WdBl -> [(Point2, Point2)] -> PSType
airlockDoor :: WdBl -> Float -> Point2A -> Point2A -> PSType
airlockDoor = PutDoor switchWallObs
airlockDoor = PutDoor False switchWallObs
airlockDoubleDoor ::
Point2 ->
src/Dodge/Room/Door.hs
+1 -1
View File
@@ -41,6 +41,6 @@ triggerDoorRoom i =
where
f gw = fromMaybe (error "tried to put a door using an empty placement list") $ do
pmnt <- gw ^? genPmnt . ix i
return $ putDoubleDoor
return $ putDoubleDoor False
switchWallObs defaultDoorWall (cond pmnt) (V2 0 20) (V2 40 20) 2
cond pmnt = WdTrig $ fromJust (_plMID pmnt)
src/Dodge/Room/LongDoor.hs
+3 -3
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 (thedoor btid) thewall switchWallObs 1 (V2 x 1) (V2 x h)) $
ps0 (PutSlideDr (thedoor btid) thewall switchWallObs 1 (V2 (- x) 1) (V2 (- x) h)) $
\btid -> jsps0J (PutSlideDr False (thedoor btid) thewall switchWallObs 1 (V2 x 1) (V2 x h)) $
ps0 (PutSlideDr False (thedoor btid) thewall switchWallObs 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
]
@@ -137,7 +137,7 @@ addButtonSlowDoor x h rm = do
col
(rprBool (isUnusedLnkType InLink))
$ \btplmnt -> Just $
putDoubleDoorThen
putDoubleDoorThen False
switchWallObs
thewall
(WdBlBtOn $ fromJust $ _plMID btplmnt)
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 (thedoor btid) thewall switchWallObs 1 (V2 (-21) 0) (V2 0 0)) $
sPS (V2 0 (d -10)) 0 (PutSlideDr (thedoor btid) thewall switchWallObs 1 (V2 21 0) (V2 0 0))
jspsJ (V2 0 (d -10)) 0 (PutSlideDr False (thedoor btid) thewall switchWallObs 1 (V2 (-21) 0) (V2 0 0)) $
sPS (V2 0 (d -10)) 0 (PutSlideDr False (thedoor btid) thewall switchWallObs 1 (V2 21 0) (V2 0 0))
]
--thewall = switchWallCol col
thewall = defaultDoorWall
src/Dodge/Update/WallDamage.hs
+3 -1
View File
@@ -1,5 +1,6 @@
module Dodge.Update.WallDamage (updateWallDamages, updateEdgesWall) where
import Dodge.Wall.Pathing
import Geometry.Data
import Control.Lens
import Data.Foldable
@@ -35,7 +36,8 @@ updateEdgeWallObs :: World -> (Int, Int) -> World
updateEdgeWallObs w (i, j) = fromMaybe w $ do
s <- getNodePos i w
e <- getNodePos j w
let wlflags = foldMap (^. _2 . wlPathFlag) $ wlsHitUnsorted s e w
--let wlflags = foldMap (^. _2 . wlPathFlag) $ wlsHitUnsorted s e w
let wlflags = foldMap (getWallPathing . (^. _2)) $ wlsHitUnsorted s e w
return $ w & cWorld . incGraph %~ updateEdge (f wlflags) (i, j)
where
f x _ = S.map WallObstacle x
src/Dodge/Wall/Damage.hs
+1 -1
View File
@@ -17,7 +17,7 @@ damageWall dt wl (is,w) = case _wlStructure wl of
BlockPart blid ->
w' & cWorld . lWorld . blocks . ix blid . blHP -~ dmam
& maybeDestroyBlock is blid
DoorPart drid ->
DoorPart drid _ ->
f $ w' & cWorld . lWorld . doors . ix drid . drHP -~ dmam
-- & maybeDestroyDoor drid
_ -> f w'
src/Dodge/WorldEvent/ThingsHit.hs
+2 -1
View File
@@ -17,6 +17,7 @@ module Dodge.WorldEvent.ThingsHit (
isWalkable,
) where
import Dodge.Wall.Pathing
import Data.Monoid
import qualified Data.Set as S
import Linear
@@ -163,7 +164,7 @@ isFlyable :: Point2 -> Point2 -> World -> Bool
{-# INLINE isFlyable #-}
isFlyable p1 p2 =
not . (WallNotAutoOpen `S.member`)
. foldMap (^. _2 . wlPathFlag)
. foldMap (getWallPathing . (^. _2))
. wlsHitUnsorted p1 p2
isWalkable :: Point2 -> Point2 -> World -> Bool