Stop intersectSegSegTest returning True for collinear line pairs

This commit is contained in:
2026-03-12 13:37:56 +00:00
parent cdc21c9fb1
commit 65383e2303
15 changed files with 326 additions and 223 deletions
+4 -3
View File
@@ -20,10 +20,11 @@ corridor =
{ _rmPolys = [poly]
, _rmLinks = lnks'
, --, _rmPath = foldMap (doublePairSet . (,) (V2 20 60) . fst) lnks
_rmPath = foldMap (doublePairSet . (,) (V2 20 60)) [V2 20 70, V2 20 10]
_rmPath = foldMap (doublePairSet . (,) (V2 20 60)) [V2 20 70, V2 20 5]
--, _rmPmnts = [spanLightI (V2 0 39.5) (V2 40 39.5)]
, _rmPmnts = []
, _rmBound = [rectNSWE 50 30 (-5) 45]
, _rmBound = [rectNSWE 45 35 (-5) 45]
-- , _rmBound = [rectNSWE 50 40 (-5) 45]
, _rmFloor = Tiled [makeTileFromPoly poly 5]
, _rmRandPSs = [psRandRanges (10, 30) (30, 60) (0, 2 * pi)]
, _rmName = "Corridor"
@@ -38,7 +39,7 @@ corridor =
, outLink (V2 20 70) (negate $ pi / 4)
, outLink (V2 20 70) (pi / 6)
, outLink (V2 20 70) (negate $ pi / 6)
, inLink (V2 20 10) pi
, inLink (V2 20 5) pi
]
keyholeCorridor :: Room
+1
View File
@@ -19,6 +19,7 @@ door =
, -- door extends into side walls (for shadows as rendered 12/03)
_rmPmnts = [putAutoDoor (V2 0 20) (V2 40 20)]
, _rmName = "autoDoor"
-- , _rmBound = [rectNSWE 21 19 0 40]
, _rmBound = [rectNSWE 21 19 0 40]
}
where
+28 -2
View File
@@ -11,6 +11,7 @@ module Dodge.Room.LasTurret (
lasCenRunClose,
) where
import Dodge.Room.Procedural
import qualified Data.Set as S
import Dodge.Cleat
import Dodge.Data.GenWorld
@@ -141,8 +142,8 @@ lasCenSensEdge n = do
, treePost [door, cleatLabel 0 corridor]
]
lasCenRunClose :: (RandomGen g) => State g (MetaTree Room String)
lasCenRunClose = do
lasCenRunClose' :: (RandomGen g) => State g (MetaTree Room String)
lasCenRunClose' = do
thelight <- mntLightLnkCond $ rprBool $ const . isInLnk
thelight1 <- mntLightLnkCond $ rprBool $ const . isOutLnk
r <-
@@ -169,6 +170,31 @@ lasCenRunClose = do
inlinkwall = linkwall isInLnk
outlinkwall = linkwall isOutLnk
lasCenRunClose :: (RandomGen g) => State g (MetaTree Room String)
lasCenRunClose = do
r <-
roomRectAutoLights 250 250
<&> rmPmnts
<>~ [ putLasTurret 0.02 & plSpot .~ PS (V2 220 20) 0
, inlinkwall 70 (rectNSWE 10 (-10) (-10) 30)
, inlinkwall 125 (rectNSWE 55 (-55) (-10) 10)
, inlinkwall 180 (rectNSWE 10 (-10) (-30) 10)
, outlinkwall 70 (rectNSWE 10 (-10) (-30) 10)
, outlinkwall 125 (rectNSWE 55 (-55) (-10) 10)
, outlinkwall 180 (rectNSWE 10 (-10) (-10) 30)
]
<&> rmLinks %~ setInLinks (memtest (FromEdge West 0) (OnEdge South))
<&> rmLinks %~ setOutLinks (memtest (FromEdge East 0) (OnEdge North))
rToOnward "lasCenRunClose" $ return $ cleatOnward r
where
memtest a b x = let y = _rlType x
in a `S.member` y && b `S.member` y
linkwall f x = heightWallPS
(resetPLUse $ rprBoolShift (const . f) (shiftInBy x <&> (,S.singleton UsedPosLow)))
30
inlinkwall = linkwall isInLnk
outlinkwall = linkwall isOutLnk
lasTunnel :: (RandomGen g) => Float -> State g Room
lasTunnel y = do
extraPlmnts <-
+10 -2
View File
@@ -8,6 +8,7 @@ module Dodge.Room.Room (
pistolerRoom,
spawnerRoom,
corDoor,
doorCor,
weaponBehindPillar,
critsRoom,
distributerRoom,
@@ -395,10 +396,15 @@ spawnerRoom = do
aRoom <- airlock
return $ treeFromTrunk [aRoom, corridor] $ pure $ cleatOnward roomWithSpawner
doorCor :: RandomGen g => State g (MetaTree Room String)
doorCor = do
cor <- shuffleLinks (cleatOnward corridor) <&> rmPmnts .~ []
return $ tToBTree "doorCor" $ treePost [door, cor]
corDoor :: RandomGen g => State g (MetaTree Room String)
corDoor = do
cor <- shuffleLinks (cleatOnward corridor) <&> rmPmnts .~ []
return $ tToBTree "corDoor" $ treePost [door, cor]
cor <- shuffleLinks corridor <&> rmPmnts .~ []
return $ tToBTree "corDoor" $ treePost [cor,cor, cleatOnward door]
critsPillarRoom :: Int -> State LayoutVars Room
critsPillarRoom i = do
@@ -452,6 +458,8 @@ distributerRoom atype aamount = do
)
return $ r & rmPmnts .:~ store
& rmInPmnt <>~ [(0,dst),(1,thepipe)]
& rmLinks %~ setInLinksByType (OnEdge South)
& rmLinks %~ setOutLinks (not . S.member (OnEdge South) . _rlType)
tmDistributeLines :: [TerminalLine]
tmDistributeLines = [TLine 1 [TerminalLineConst "ATTEMPTING TO DISTRIBUTE MATERIAL..." white] TmDistributeAmmo]
+36 -35
View File
@@ -52,43 +52,44 @@ tutAnoTree :: State LayoutVars MTRS
tutAnoTree = do
foldMTRS
[ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
-- , return . tToBTree "door" $ treePost [corridor, cleatOnward door]
, corDoor
, tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
, lasCenRunClose
-- , passthroughLockKeyLists lockRoomKeyItems itemRooms
, tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
-- , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
-- , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
-- , passthroughLockKeyLists
-- [(sensorRoomRunPast ElectricSensor, takeOne
-- [-- CRAFT (ENERGYBALLCRAFT TeslaBall) ,
-- HELD SPARKGUN])]
-- itemRooms
-- , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
-- , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
, tToBTree "sdr" . return . cleatOnward <$>
(shuffleLinks =<< distributerRoom BulletAmmo 100000)
-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
-- --, tToBTree "sdr" . return . cleatOnward <$> slowDoorRoom
---- , tToBTree "sr" . return . cleatOnward <$> tanksRoom [] []
-- , return $ tToBTree "door" $ return $ cleatOnward door
-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
-- , tToBTree "sdr" . return . cleatOnward <$>
-- (shuffleLinks =<< tanksPipesRoom)
-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
, return $ tToBTree "cor" $ return $ cleatOnward corridor
, return $ tToBTree "cor" $ return $ cleatOnward corridor
, return $ tToBTree "cor" $ return $ cleatOnward corridor
, return $ tToBTree "door" $ return $ cleatOnward door
, tutHub
, chasmSpitTerminal
, tutLight
, tutDrop
, return $ tToBTree "cor" $ return $ cleatOnward corridor
---- , AnTree $ pickupTut
---- , AnTree $ weaponTut
--aaa , lasCenRunClose
--aaa-- , passthroughLockKeyLists lockRoomKeyItems itemRooms
--aaa , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
--aaa-- , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
--aaa-- , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
--aaa-- , passthroughLockKeyLists
--aaa-- [(sensorRoomRunPast ElectricSensor, takeOne
--aaa-- [-- CRAFT (ENERGYBALLCRAFT TeslaBall) ,
--aaa-- HELD SPARKGUN])]
--aaa-- itemRooms
--aaa-- , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
--aaa-- , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
--aaa , tToBTree "sdr" . return . cleatOnward <$>
--aaa (shuffleLinks =<< distributerRoom BulletAmmo 100000)
--aaa-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
--aaa-- --, tToBTree "sdr" . return . cleatOnward <$> slowDoorRoom
--aaa---- , tToBTree "sr" . return . cleatOnward <$> tanksRoom [] []
--aaa-- , return $ tToBTree "door" $ return $ cleatOnward door
--aaa-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
--aaa-- , tToBTree "sdr" . return . cleatOnward <$>
--aaa-- (shuffleLinks =<< tanksPipesRoom)
--aaa-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
--aaa-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
--aaa-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
--aaa , return $ tToBTree "cor" $ return $ cleatOnward corridor
--aaa , return $ tToBTree "cor" $ return $ cleatOnward corridor
--aaa , return $ tToBTree "cor" $ return $ cleatOnward corridor
--aaa , return $ tToBTree "door" $ return $ cleatOnward door
--aaa , tutHub
--aaa , chasmSpitTerminal
--aaa , tutLight
--aaa , tutDrop
--aaa , return $ tToBTree "cor" $ return $ cleatOnward corridor
--aaa ---- , AnTree $ pickupTut
--aaa ---- , AnTree $ weaponTut
]
foldMTRS ::