First implementation of no-item-zone sensor

src/Dodge/Machine/Update.hs

@@ -111,9 +111,15 @@ mcTriggerVal se = Just $ _sensAmount se > _sensThreshold se
 
 mcPlaySound :: Machine -> World -> World
 mcPlaySound mc w = case _mcType mc of
-    McTerminal | d < 100 ->
+    McTerminal
-            soundContinueVol (1 -0.01 * d) 
+        | d < 100 ->
-                (MachineSound mid) (_mcPos mc) fridgeHumS (Just 2) w
+            soundContinueVol
+                (1 -0.01 * d)
+                (MachineSound mid)
+                (_mcPos mc)
+                fridgeHumS
+                (Just 2)
+                w
     _ -> w
   where
     d = max 0 (dist (_crPos $ you w) (_mcPos mc) - 100)
@@ -121,23 +127,37 @@ mcPlaySound mc w = case _mcType mc of
 
 mcApplyDamage :: [Damage] -> Machine -> World -> World
 mcApplyDamage ds mc = case mc ^? mcType . _McDamSensor of
-    Nothing ->
+    Nothing -> mcpointer %~ ((mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds)))
-        mcpointer
+    _ -> mcpointer %~ (mcDamage .~ [])
-            %~ ((mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds)))
-    _ ->
-        mcpointer
-            %~ (mcDamage .~ [])
   where
     mcpointer = cWorld . lWorld . machines . ix (_mcID mc)
 
 mcDamSensorUpdate :: DamageSensor -> Machine -> World -> World
-mcDamSensorUpdate se mc w = senseDamage (_sensThreshold se) (_sensType se) mc w
+mcDamSensorUpdate se = senseDamage (_sensThreshold se) (_sensType se)
 
 mcProxSensorUpdate :: ProximitySensor -> Machine -> World -> World
 mcProxSensorUpdate se mc = case se ^. proxRequirement of
-    RequireNoItems xs -> id 
+    RequireNoItems xs -> mcNoItemsTest mc xs
     _ -> mcProximitySensorUpdate mc se
 
+mcNoItemsTest :: Machine -> [Point2] -> World -> World
+mcNoItemsTest mc ps w
+    | t && not (mc ^?! mcType . _McProxSensor . proxToggle) =
+        w & mcsenslens . proxToggle .~ True
+            & playsound dedaS
+    | not t && (mc ^?! mcType . _McProxSensor . proxToggle) =
+        w & mcsenslens . proxToggle .~ False
+            & playsound dedumS
+    | otherwise = w
+  where
+    t = ((cr ^. crInv == mempty) || not (pointInPoly (cr ^. crPos) qs))
+         && not (any ((`pointInPoly` qs) . _flItPos) (w ^. cWorld . lWorld . floorItems))
+    cr = w ^?! cWorld . lWorld . creatures . ix 0
+    mcsenslens = cWorld . lWorld . machines . ix (_mcID mc) . mcType . _McProxSensor
+    playsound sid = soundContinue (MachineAltSound (_mcID mc)) (_mcPos mc) sid Nothing
+    qs = f ps
+    f = fmap ((+ _mcPos mc) . rotateV (_mcDir mc))
+
 mcProximitySensorUpdate :: Machine -> ProximitySensor -> World -> World
 mcProximitySensorUpdate mc sens w
     | sens ^. proxToggle || dist (_crPos ycr) (_mcPos mc) > 40 = w
@@ -146,10 +166,13 @@ mcProximitySensorUpdate mc sens w
             & mcsenslens . proxToggle .~ True
             & playsound dedaS
             & mctermlens . tmFutureLines .:~ makeTermLine "SENSOR SUCCESS!"
-    | otherwise = w & playsound dedumS
+    | otherwise =
+        w & playsound dedumS
             & mctermlens . tmFutureLines
-             .:~ makeTermLine ("SENSOR FAIL: REQUIRES " 
+            .:~ makeTermLine
-                ++ sensorReqToString (mc ^?! mcType . _McProxSensor . proxRequirement))
+                ( "SENSOR FAIL: REQUIRES "
+                    ++ sensorReqToString (mc ^?! mcType . _McProxSensor . proxRequirement)
+                )
   where
     mctermlens = cWorld . lWorld . terminals . ix (mc ^?! mcMounts . ix OTTerminal)
     mcsenslens = cWorld . lWorld . machines . ix (_mcID mc) . mcType . _McProxSensor
@@ -169,8 +192,9 @@ mcProxTest mc w = \case
         any
             (\itm -> _itType itm == ct)
             ((\k -> w ^?! cWorld . lWorld . items . ix k) <$> _crInv cr)
-    RequireNoItems ps -> (w ^?! cWorld . lWorld . creatures . ix 0 . crInv == mempty)
+    RequireNoItems ps ->
-        && not (any ((`pointInPoly` f ps) . _flItPos) (w ^. cWorld . lWorld . floorItems) )
+        (w ^?! cWorld . lWorld . creatures . ix 0 . crInv == mempty)
+            && not (any ((`pointInPoly` f ps) . _flItPos) (w ^. cWorld . lWorld . floorItems))
   where
     cr = you w
     f = fmap ((+ _mcPos mc) . rotateV (_mcDir mc))

src/Dodge/TestString.hs

@@ -31,42 +31,12 @@ import NewInt
 import Data.Foldable
 
 testStringInit :: Universe -> [String]
-testStringInit _ = mempty
+testStringInit _ = [] 
- --   map f (IM.toList $ u ^. uvWorld . cWorld . lWorld . items)
+    -- foldMap prettyShort $ u ^? uvWorld . cWorld . lWorld . machines . ix 0 . mcType . _McProxSensor
- --   <> ["---"]
+--testStringInit u = foldMap prettyShort $ u ^.. uvWorld . cWorld . lWorld . machines
- --   <> map show (IM.toList . fold $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInv . unNIntMap)
+
- --   <> ["---"]
- --   <> map show (IM.keys $ u ^. uvWorld . cWorld . lWorld . floorItems)
- --   
- -- where
- --   f (i,itm) = show i <> ":" <> show (itm ^. itID . unNInt) <> ":"<> shortShow (itm ^. itLocation)
--- map shortShow (u ^.. uvWorld . cWorld . lWorld . debris . each . to g)
---  where
---    g db = (pz,z,norm v)
---      where
---        v@(V3 _ _ z) = db ^. dbVel
---        (V3 _ _ pz) = db ^. dbPos
---        --return . foldMap (prettyLDT (show . (^. _1 . itType))) . invLDT $ _crInv cr
---  where
---    idp = invDisplayParams $ u ^. uvWorld
---    cfig = u ^. uvConfig
---    yint =  posSelSecYint cfig idp y
---    mpos@(V2 _ y) = u ^. uvWorld . input . mousePos
---    , show . fmap (fmap _siPictures) $ u ^? uvWorld . hud . hudElement . diSections . ix (-1) . ssItems
---    <> [[toEnum (i+j * 32) | i <- [0..31]] | j <- [0..7]]
---    <> map show (IM.elems (L.postscan (L.premap _siHeight L.sum)
---        $ fromMaybe mempty $ u ^? uvWorld . hud . hudElement . diSections . sssSections . ix 0 . ssItems)
---        )
---testStringInit u = [maybe mempty show $ u ^? uvWorld . cWorld . lWorld . projectiles . ix 0 . prjUpdates . ix 3 . pjuControllerID]
---testStringInit u = (topTestPart u
---    <>) $ map showh $ 
-----    (IM.toList . IM.filter (\itloc -> itloc ^? ilCrID == Just 0) $ (u ^. uvWorld . cWorld . lWorld . itemLocations)) <> 
---    ( IM.elems $ fmap h (u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crInv))
---  where
---    h itm = (_itID itm, _itLocation itm)
---    showh (x,(InInv a b c d e)) = show x ++ "," ++ show a ++ "," ++ show b ++"," ++ show c ++"," ++ show d 
---        ++ "," ++ show e
 --    showh _ = ""
+--    shortShow
 
 topTestPart :: Universe -> [String]
 topTestPart u = [maybe "" showManObj $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . manObject