justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

First implementation of no-item-zone sensor

Browse Source
This commit is contained in:
justin
2025-09-16 22:35:53 +01:00
parent 81d6727d8e
commit 103f1e7e99
3 changed files with 47 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Machine/Update.hs
+41 -17
View File
@@ -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 ->
soundContinueVol (1 -0.01 * d)
(MachineSound mid) (_mcPos mc) fridgeHumS (Just 2) w
McTerminal
| d < 100 ->
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 ->
mcpointer
%~ ((mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds)))
_ ->
mcpointer
%~ (mcDamage .~ [])
Nothing -> mcpointer %~ ((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
& mctermlens . tmFutureLines
.:~ makeTermLine ("SENSOR FAIL: REQUIRES "
++ sensorReqToString (mc ^?! mcType . _McProxSensor . proxRequirement))
| otherwise =
w & playsound dedumS
& mctermlens . tmFutureLines
.:~ makeTermLine
( "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)
&& not (any ((`pointInPoly` f ps) . _flItPos) (w ^. cWorld . lWorld . floorItems) )
RequireNoItems ps ->
(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
+5 -35
View File
@@ -31,42 +31,12 @@ import NewInt
import Data.Foldable
testStringInit :: Universe -> [String]
testStringInit _ = mempty
-- map f (IM.toList $ u ^. uvWorld . cWorld . lWorld . items)
-- <> ["---"]
-- <> 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
testStringInit _ = []
-- foldMap prettyShort $ u ^? uvWorld . cWorld . lWorld . machines . ix 0 . mcType . _McProxSensor
--testStringInit u = foldMap prettyShort $ u ^.. uvWorld . cWorld . lWorld . machines
-- showh _ = ""
-- shortShow
topTestPart :: Universe -> [String]
topTestPart u = [maybe "" showManObj $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . manObject