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

Work on autodoor pathing

Browse Source
This commit is contained in:
justin
2025-10-24 13:19:21 +01:00
parent 7b622c8e31
commit 9eed2706b0
13 changed files with 68 additions and 87 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Block/Debris.hs
-1
View File
@@ -35,7 +35,6 @@ makeDoorDebris dr w = w & makeDebris mt p
return $ wl ^. wlMaterial
makeBlockDebris :: Block -> World -> World
--makeBlockDebris bl w = foldl' (flip $ makeDebris mt col) w ps
makeBlockDebris bl w = foldl' (flip $ makeDebris mt) w ps
where
dsize = debrisSize mt
src/Dodge/Default/Door.hs
+1 -6
View File
@@ -16,12 +16,7 @@ defaultAutoWall =
defaultDoorWall
-- & wlColor .~ dim yellow
& wlOpacity .~ Opaque 9
defaultSwitchWall :: Wall
defaultSwitchWall =
defaultDoorWall
-- & wlColor .~ red
& wlOpacity .~ Opaque 0
& wlPathFlag . at WallNotAutoOpen .~ Nothing
defaultDoor :: Door
defaultDoor =
src/Dodge/Default/Wall.hs
+3 -10
View File
@@ -1,6 +1,5 @@
module Dodge.Default.Wall (
defaultWall,
defaultSensorWall,
defaultMachineWall,
defaultWindow,
defaultCrystalWall,
@@ -35,17 +34,14 @@ defaultWall =
}
defaultDoorWall :: Wall
defaultDoorWall =
defaultWall{_wlMaterial = Metal}
defaultDoorWall = defaultWall
& wlPathFlag . at WallNotDestrucable .~ Nothing
& wlMaterial .~ Metal
& wlOpacity .~ Opaque 0
{- Indestructible see-through wall. -}
defaultCrystalWall :: Wall
defaultCrystalWall = defaultWall & wlOpacity .~ SeeThrough & wlMaterial .~ Crystal
-- { _wlColor = withAlpha 0.5 aquamarine
-- , _wlOpacity = SeeThrough
-- , _wlMaterial = Crystal
-- }
defaultMachineWall :: Wall
defaultMachineWall =
@@ -57,9 +53,6 @@ defaultMachineWall =
, _wlTouchThrough = True
}
defaultSensorWall :: Wall
defaultSensorWall = defaultMachineWall
defaultDirtWall :: Wall
defaultDirtWall =
defaultWall
src/Dodge/Path.hs
-3
View File
@@ -3,12 +3,9 @@ module Dodge.Path (
pointTowardsImpulse,
makePathBetween,
makePathBetweenPs,
-- , removePathsCrossing
obstructPathsCrossing,
-- pairsToGraph,
getNodePos,
walkableNodeNear,
-- bfsNodePoints,
snapToGrid,
pairsToIncGraph,
updateEdge,
src/Dodge/Placement/Instance/Door.hs
+1 -1
View File
@@ -112,7 +112,7 @@ switchDoor btpos btrot dra drb col = pContID
sps0 (doorbetween btid drb drc)
where
--doorbetween btid a b = PutSlideDr thedoor (switchWallCol col)
doorbetween btid a b = PutSlideDr thedoor defaultSwitchWall
doorbetween btid a b = PutSlideDr thedoor defaultDoorWall
(S.fromList (WallObstacle <$> [WallNotAutoOpen,WallBlockVisibility])) 1 a b
where
thedoor =
src/Dodge/Placement/Instance/Sensor.hs
-1
View File
@@ -29,7 +29,6 @@ damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $
(damageTypeThreshold dt)
)
)
-- defaultMachineWall
Nothing
damageTypeThreshold :: SensorType -> Int
src/Dodge/Placement/Instance/Terminal.hs
-1
View File
@@ -36,7 +36,6 @@ putTerminalFull f col mc tm =
( mc & mcMounts . at OTButton ?~ fromJust (_plMID btpl)
& mcMounts . at OTTerminal .~ _plMID tmpl
)
-- defaultMachineWall
Nothing
)
$ \mcpl -> Just $ pt0 (PutWorldUpdate $ const $ const $ over gwWorld (setids tmpl btpl mcpl)) (\_ -> f tmpl btpl mcpl)
src/Dodge/Placement/Instance/Wall.hs
+55 -53
View File
@@ -1,10 +1,19 @@
module Dodge.Placement.Instance.Wall where
module Dodge.Placement.Instance.Wall
(invisibleWall, crystalLine, blockLine, putBlockRect
,baseBlockPane
,midWall
,windowLine
,putBlockN
,putBlockV
,heightWallPS
,replacePutID
) where
import qualified Data.Set as S
import Dodge.Material.Color
import Control.Lens
import Data.List
import Dodge.Data.GenWorld
import Dodge.Default.Block
import Dodge.Default.Wall
import Dodge.LevelGen.PlacementHelper
import Dodge.Placement.Instance.Block
@@ -27,13 +36,13 @@ invisibleWall ps =
midWall :: [Point2] -> Placement
midWall = heightWallPS (PS 0 0) 50
singleBlock :: Point2 -> [Placement]
singleBlock a =
[ sPS a 0 $
PutBlock defaultBlock baseBlockPane $
reverse $
square 10
]
--singleBlock :: Point2 -> [Placement]
--singleBlock a =
-- [ sPS a 0 $
-- PutBlock defaultBlock baseBlockPane $
-- reverse $
-- square 10
-- ]
{-
Places a line of blocks between two points.
@@ -65,35 +74,28 @@ crystalLine a b = sps0 $ PutLineBlock defaultCrystalWall 7 a b
-- ]
-- left = 7 *.* normalizeV (a-.-b)
-- up = vNormal left
{- Places an unbreakable wall between two points.
Depth 15, does not extend wider than points.
-}
wallLine :: Point2 -> Point2 -> Placement
wallLine a b = sps0 $ PutWall ps defaultWall
where
ps =
[ a +.+ up
, a -.- up
, b -.- up
, b +.+ up
]
left = 15 *.* normalizeV (a -.- b)
up = vNormal left
--
--{- Places an unbreakable wall between two points.
--Depth 15, does not extend wider than points.
-- -}
--wallLine :: Point2 -> Point2 -> Placement
--wallLine a b = sps0 $ PutWall ps defaultWall
-- where
-- ps =
-- [ a +.+ up
-- , a -.- up
-- , b -.- up
-- , b +.+ up
-- ]
-- left = 15 *.* normalizeV (a -.- b)
-- up = vNormal left
windowLineType :: Point2 -> Point2 -> PSType
windowLineType = PutLineBlock defaultWindow 8
--windowLineType :: Point2 -> Point2 -> PSType
--windowLineType = PutLineBlock defaultWindow 8
baseBlockPane :: Wall
baseBlockPane =
defaultWall
{ _wlLine = (V2 0 0, V2 50 0)
, _wlID = 0
--, _wlColor = greyN 0.5
-- , _wlColor = dark $ dark orange
--, _wlOpacity = Opaque 10
, _wlOpacity = Opaque 17
, _wlUnshadowed = True
}
baseBlockPane = defaultWall & wlOpacity .~ Opaque 17
& wlPathFlag .~ S.fromList [WallBlockVisibility, WallNotAutoOpen]
-- TODO find home for this
{- Replaces instances of a given 'PutID' with 'PSType's drawn from a list. -}
@@ -127,18 +129,18 @@ subZipWith f g xs ys =
isPutID :: Int -> Placement -> Bool
isPutID i ps = Just i == ps ^? plType . putID
putBlockRect' :: Float -> Float -> Placement
putBlockRect' w h =
ps0jPushPS (aline tl tr) $
ps0jPushPS (aline tr br) $
ps0jPushPS (aline br bl) $
sps0 (aline bl tl)
where
tl = V2 (- w) h
tr = V2 w h
br = V2 w (- h)
bl = V2 (- w) (- h)
aline = PutLineBlock baseBlockPane 9
--putBlockRect' :: Float -> Float -> Placement
--putBlockRect' w h =
-- ps0jPushPS (aline tl tr) $
-- ps0jPushPS (aline tr br) $
-- ps0jPushPS (aline br bl) $
-- sps0 (aline bl tl)
-- where
-- tl = V2 (- w) h
-- tr = V2 w h
-- br = V2 w (- h)
-- bl = V2 (- w) (- h)
-- aline = PutLineBlock baseBlockPane 9
putBlockRect :: Float -> Float -> Float -> Float -> [Placement]
putBlockRect a x b y =
@@ -154,12 +156,12 @@ putBlockV a x b y =
, blockLine (V2 x b) (V2 a b)
]
putBlockC :: Float -> Float -> Float -> Float -> [Placement]
putBlockC a x b y =
[ blockLine (V2 a b) (V2 a y)
, blockLine (V2 x b) (V2 a b)
, blockLine (V2 a y) (V2 x y)
]
--putBlockC :: Float -> Float -> Float -> Float -> [Placement]
--putBlockC a x b y =
-- [ blockLine (V2 a b) (V2 a y)
-- , blockLine (V2 x b) (V2 a b)
-- , blockLine (V2 a y) (V2 x y)
-- ]
putBlockN :: Float -> Float -> Float -> Float -> [Placement]
putBlockN a x b y =
src/Dodge/Placement/PlaceSpot/TriggerDoor.hs
+1 -1
View File
@@ -44,7 +44,7 @@ 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 defaultSwitchWall) w' $ zip wlids
addWalls w' = foldl' (addDoorWall eo drid defaultDoorWall) w' $ zip wlids
$ wlps' & each . each %~ shiftPointBy p1
addDoorWall :: S.Set EdgeObstacle
src/Dodge/Room/Airlock.hs
+3 -5
View File
@@ -51,8 +51,7 @@ decontamRoom i =
return $
putDoubleDoor
switchWallObs
--(switchWallCol red)
defaultSwitchWall
defaultDoorWall
(cond pmnt)
(V2 (-10) 35)
(V2 (-10) 65)
@@ -62,7 +61,7 @@ decontamRoom i =
cutps = [rectNSWE 100 0 0 40, switchcut]
ps = (\p -> p - mcpos) <$> orderPolygon (concat cutps)
--thewall = switchWallCol col
thewall = defaultSwitchWall
thewall = defaultDoorWall
switchcut = rectNSWE 65 35 (-40) 80
lnks =
[ (V2 20 95, 0)
@@ -89,8 +88,7 @@ airlock0 =
, _rmBound = [rectNSWE 75 15 0 40, switchcut]
}
where
--thewall = switchWallCol col
thewall = defaultSwitchWall
thewall = defaultDoorWall
switchcut = rectNSWE 65 35 (-40) 20
lnks =
[ (V2 20 95, 0)
src/Dodge/Room/Door.hs
+1 -2
View File
@@ -42,6 +42,5 @@ triggerDoorRoom i =
f gw = fromMaybe (error "tried to put a door using an empty placement list") $ do
pmnt <- gw ^? genPmnt . ix i
return $ putDoubleDoor
--switchWallObs (switchWallCol red) (cond pmnt) (V2 0 20) (V2 40 20) 2
switchWallObs defaultSwitchWall (cond pmnt) (V2 0 20) (V2 40 20) 2
switchWallObs defaultDoorWall (cond pmnt) (V2 0 20) (V2 40 20) 2
cond pmnt = WdTrig $ fromJust (_plMID pmnt)
src/Dodge/Room/LongDoor.hs
+2 -2
View File
@@ -58,7 +58,7 @@ twinSlowDoorRoom w h x =
}
where
--thewall = switchWallCol red
thewall = defaultSwitchWall
thewall = defaultDoorWall
wlSpeed = 0.5
addColorChange lsid drid =
over prUpdate $
@@ -131,7 +131,7 @@ addButtonSlowDoor x h rm = do
-- TODO make the height of this light source and of other mounted lights
-- be taken from a single consistent source
--thewall = switchWallCol red
thewall = defaultSwitchWall
thewall = defaultDoorWall
butDoor = putLitButOnPos
col
(rprBool (isUnusedLnkType InLink))
src/Dodge/Room/Procedural.hs
+1 -1
View File
@@ -331,7 +331,7 @@ centerVaultRoom w h d =
sPS (V2 0 (d -10)) 0 (PutSlideDr (thedoor btid) thewall switchWallObs 1 (V2 21 0) (V2 0 0))
]
--thewall = switchWallCol col
thewall = defaultSwitchWall
thewall = defaultDoorWall
thedoor btid =
defaultDoor
& drTrigger .~ WdBlBtOn btid