Work on detecting floor items near analyser
This commit is contained in:
@@ -1,4 +1,4 @@
|
||||
Seed: 897386367644826610
|
||||
Seed: 7114951007332849727
|
||||
Room layout (compact):
|
||||
0,1,2,3,4,5,6
|
||||
|
|
||||
|
||||
+2
-2
@@ -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
@@ -1,4 +1,4 @@
|
||||
Seed: 897386367644826610
|
||||
Seed: 7114951007332849727
|
||||
0:teststart
|
||||
|
|
||||
1:TutDrop
|
||||
|
||||
File diff suppressed because one or more lines are too long
+1
-1
@@ -1 +1 @@
|
||||
897386367644826610
|
||||
7114951007332849727
|
||||
@@ -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)
|
||||
|
||||
@@ -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 =
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user