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):
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
+1 -1
View File
@@ -1,4 +1,4 @@
Seed: 897386367644826610
Seed: 7114951007332849727
0:teststart
|
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,
) where
import Geometry.Data
import Color
import Control.Lens
import Data.Aeson
@@ -36,6 +37,7 @@ data Sensor
data ProximityRequirement
= RequireHealth {_proxReqMinHealth :: Int}
| RequireEquipment {_proxReqEquipment :: ItemType}
| RequireNoItems {_proxNoItems :: [Point2]}
deriving (Show)
--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 se mc w = case se of
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 mc w = case ( _proxStatus sens
mcProximitySensorUpdate :: Machine -> ProximityRequirement -> World -> World
mcProximitySensorUpdate mc x w = case ( _proxStatus sens
, _sensToggle sens
, mcProxTest mc w
, mcProxTest mc w x
, dist (_crPos ycr) (_mcPos mc) < _proxDist sens
) of
(_, True, _, _) -> w
@@ -160,17 +160,20 @@ sensorReqToString :: ProximityRequirement -> String
sensorReqToString = \case
RequireHealth x -> "HEALTH ABOVE " ++ show x
RequireEquipment x -> itemBaseName x
RequireNoItems _ -> "NO NEARBY ITEMS"
mcProxTest :: Machine -> World -> Bool
mcProxTest mc w = case mc ^? mcType . _McSensor . proxRequirement of
Just (RequireHealth x) -> _crHP cr >= x
Just (RequireEquipment ct) ->
mcProxTest :: Machine -> World -> ProximityRequirement -> Bool
mcProxTest mc w = \case
RequireHealth x -> _crHP cr >= x
RequireEquipment ct ->
any
(\itm -> _itType itm == ct)
((\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
cr = you w
f = fmap ((+ _mcPos mc) . rotateV (_mcDir mc))
senseDamage :: Int -> SensorType -> Machine -> World -> World
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
, invisibleWall $ rectNSWE 60 40 (-40) (-30)
, 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]
where
+3 -10
View File
@@ -11,7 +11,7 @@ module Geometry.ConvexPoly (
-- , centroid
pointsToPoly,
convexPolysOverlap,
pointInPolyPoints,
-- pointInPolyPoints,
) where
import Control.Lens
@@ -59,18 +59,11 @@ convexPolysOverlap cp1 cp2 =
-- | Test whether two polygons intersect or if one is contained in the other.
polyPointsOverlap :: [Point2] -> [Point2] -> Bool
polyPointsOverlap (p : ps) (q : qs) =
pointInPolyPoints p (q : qs)
|| pointInPolyPoints q (p : ps)
pointInPolygon p (q : qs)
|| pointInPolygon q (p : ps)
|| polyPointsIntersect (p : ps) (q : qs)
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 (a : b : xs) ps = go a (a : b : xs) ps
where