Work on detecting floor items near analyser

This commit is contained in:
2025-09-08 11:37:08 +01:00
parent f278af0f30
commit 203919933c
9 changed files with 25 additions and 26 deletions
+1 -1
View File
@@ -1,4 +1,4 @@
Seed: 897386367644826610 Seed: 7114951007332849727
Room layout (compact): Room layout (compact):
0,1,2,3,4,5,6 0,1,2,3,4,5,6
| |
+2 -2
View File
@@ -1,4 +1,4 @@
Generating level with seed 897386367644826610 Generating level with seed 7114951007332849727
After 1 attempt(s), Successful generation of level with seed 897386367644826610 After 1 attempt(s), Successful generation of level with seed 7114951007332849727
15 rooms in total 15 rooms in total
+1 -1
View File
@@ -1,4 +1,4 @@
Seed: 897386367644826610 Seed: 7114951007332849727
0:teststart 0:teststart
| |
1:TutDrop 1:TutDrop
+1 -1
View File
File diff suppressed because one or more lines are too long
+1 -1
View File
@@ -1 +1 @@
897386367644826610 7114951007332849727
+2
View File
@@ -8,6 +8,7 @@ module Dodge.Data.Machine.Sensor (
module Dodge.Data.Machine.Sensor.Type, module Dodge.Data.Machine.Sensor.Type,
) where ) where
import Geometry.Data
import Color import Color
import Control.Lens import Control.Lens
import Data.Aeson import Data.Aeson
@@ -36,6 +37,7 @@ data Sensor
data ProximityRequirement data ProximityRequirement
= RequireHealth {_proxReqMinHealth :: Int} = RequireHealth {_proxReqMinHealth :: Int}
| RequireEquipment {_proxReqEquipment :: ItemType} | RequireEquipment {_proxReqEquipment :: ItemType}
| RequireNoItems {_proxNoItems :: [Point2]}
deriving (Show) deriving (Show)
--deriving (Eq, Ord, Show, Read) --Generic, Flat) --deriving (Eq, Ord, Show, Read) --Generic, Flat)
+12 -9
View File
@@ -128,12 +128,12 @@ mcApplyDamage ds mc = case mc ^? mcType . _McSensor of
mcSensorUpdate :: Sensor -> Machine -> World -> World mcSensorUpdate :: Sensor -> Machine -> World -> World
mcSensorUpdate se mc w = case se of mcSensorUpdate se mc w = case se of
s@DamageSensor{} -> senseDamage (_sensThreshold se) (_sensType s) mc w s@DamageSensor{} -> senseDamage (_sensThreshold se) (_sensType s) mc w
ProximitySensor{} -> mcProximitySensorUpdate mc w ProximitySensor {_proxRequirement = x} -> mcProximitySensorUpdate mc x w
mcProximitySensorUpdate :: Machine -> World -> World mcProximitySensorUpdate :: Machine -> ProximityRequirement -> World -> World
mcProximitySensorUpdate mc w = case ( _proxStatus sens mcProximitySensorUpdate mc x w = case ( _proxStatus sens
, _sensToggle sens , _sensToggle sens
, mcProxTest mc w , mcProxTest mc w x
, dist (_crPos ycr) (_mcPos mc) < _proxDist sens , dist (_crPos ycr) (_mcPos mc) < _proxDist sens
) of ) of
(_, True, _, _) -> w (_, True, _, _) -> w
@@ -160,17 +160,20 @@ sensorReqToString :: ProximityRequirement -> String
sensorReqToString = \case sensorReqToString = \case
RequireHealth x -> "HEALTH ABOVE " ++ show x RequireHealth x -> "HEALTH ABOVE " ++ show x
RequireEquipment x -> itemBaseName x RequireEquipment x -> itemBaseName x
RequireNoItems _ -> "NO NEARBY ITEMS"
mcProxTest :: Machine -> World -> Bool mcProxTest :: Machine -> World -> ProximityRequirement -> Bool
mcProxTest mc w = case mc ^? mcType . _McSensor . proxRequirement of mcProxTest mc w = \case
Just (RequireHealth x) -> _crHP cr >= x RequireHealth x -> _crHP cr >= x
Just (RequireEquipment ct) -> RequireEquipment ct ->
any any
(\itm -> _itType itm == ct) (\itm -> _itType itm == ct)
((\k -> w ^?! cWorld . lWorld . items . ix k) <$> _crInv cr) ((\k -> w ^?! cWorld . lWorld . items . ix k) <$> _crInv cr)
_ -> False RequireNoItems ps -> (w ^?! cWorld . lWorld . creatures . ix 0 . crInv == mempty)
&& not (any ((`pointInPolygon` f ps) . _flItPos) (w ^. cWorld . lWorld . floorItems) )
where where
cr = you w cr = you w
f = fmap ((+ _mcPos mc) . rotateV (_mcDir mc))
senseDamage :: Int -> SensorType -> Machine -> World -> World senseDamage :: Int -> SensorType -> Machine -> World -> World
senseDamage threshold dt mc = senseDamage threshold dt mc =
+2 -1
View File
@@ -40,7 +40,8 @@ decontamRoom = do
\_ _ -> Just $ putDoubleDoor DoorObstacle thewall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2 \_ _ -> Just $ putDoubleDoor DoorObstacle thewall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
, invisibleWall $ rectNSWE 60 40 (-40) (-30) , invisibleWall $ rectNSWE 60 40 (-40) (-30)
, spanLightI (V2 (-2) 30) (V2 (-2) 70) , spanLightI (V2 (-2) 30) (V2 (-2) 70)
, analyser (RequireHealth 100) (PS 50 0) (PS (V2 70 50) 0) --, analyser (RequireHealth 100) (PS 50 0) (PS (V2 70 50) 0)
, analyser (RequireNoItems $ square 50) (PS 50 0) (PS (V2 70 50) 0)
] ]
& rmBound .~ [rectNSWE 75 15 0 40, switchcut] & rmBound .~ [rectNSWE 75 15 0 40, switchcut]
where where
+3 -10
View File
@@ -11,7 +11,7 @@ module Geometry.ConvexPoly (
-- , centroid -- , centroid
pointsToPoly, pointsToPoly,
convexPolysOverlap, convexPolysOverlap,
pointInPolyPoints, -- pointInPolyPoints,
) where ) where
import Control.Lens import Control.Lens
@@ -59,18 +59,11 @@ convexPolysOverlap cp1 cp2 =
-- | Test whether two polygons intersect or if one is contained in the other. -- | Test whether two polygons intersect or if one is contained in the other.
polyPointsOverlap :: [Point2] -> [Point2] -> Bool polyPointsOverlap :: [Point2] -> [Point2] -> Bool
polyPointsOverlap (p : ps) (q : qs) = polyPointsOverlap (p : ps) (q : qs) =
pointInPolyPoints p (q : qs) pointInPolygon p (q : qs)
|| pointInPolyPoints q (p : ps) || pointInPolygon q (p : ps)
|| polyPointsIntersect (p : ps) (q : qs) || polyPointsIntersect (p : ps) (q : qs)
polyPointsOverlap _ _ = False polyPointsOverlap _ _ = False
{- | Test whether a point is strictly inside a polygon.
Supposes the points in the polygon are listed in anticlockwise order.
-}
pointInPolyPoints :: Point2 -> [Point2] -> Bool
pointInPolyPoints !p (x : xs) = all (\l -> uncurry isLHS l p) $ zip (x : xs) (xs ++ [x])
pointInPolyPoints _ [] = False
polyPointsIntersect :: [Point2] -> [Point2] -> Bool polyPointsIntersect :: [Point2] -> [Point2] -> Bool
polyPointsIntersect (a : b : xs) ps = go a (a : b : xs) ps polyPointsIntersect (a : b : xs) ps = go a (a : b : xs) ps
where where