Implement working no-item-airlock zone

2025-09-18 15:23:51 +01:00
parent 4494e47b43
commit e017a92892
7 changed files with 55 additions and 51 deletions
@@ -43,13 +43,6 @@ terminalScreenGlow mc w = fromMaybe w $ do
        w & cWorld . lWorld . lights
            .:~ LSParam (_mcPos mc `v2z` 20) 30 (V3 x y z)

--        w & cWorld . lWorld . tempLightSources
--            .:~ TLS
--                { _tlsParam = LSParam (_mcPos mc `v2z` 20) 30 (V3 x y z)
--                , _tlsUpdate = TimerTLS
--                , _tlsTime = 1
--                }
-
 updateTurret :: Float -> Machine -> World -> World
 updateTurret rotSpeed mc w =
    w
@@ -73,12 +66,17 @@ updateTurret rotSpeed mc w =
    dam = sum $ map _dmAmount dams
    elecDam = sum $ map _dmAmount elecDams
    doTurn
-        | seesYou = cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuDir %~ turnTo rotSpeed mcpos ypos
+        | seesYou =
+            cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuDir
+                %~ turnTo rotSpeed mcpos ypos
        | otherwise = id
    closeFireAngle = seesYou -- && angleVV (ypos -.- mcpos) (unitVectorAtAngle mcdir) < 1
    updateFiringStatus
-        | closeFireAngle = cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuFireTime .~ 20
-        | otherwise = cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuFireTime %~ (max 0 . subtract 1)
+        | closeFireAngle =
+            cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuFireTime .~ 20
+        | otherwise =
+            cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuFireTime
+                %~ (max 0 . subtract 1)

 isElectrical :: Damage -> Bool
 isElectrical dm = case dm of
@@ -128,7 +126,7 @@ 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 .~ [])
+    _ -> mcpointer . mcDamage .~ []
  where
    mcpointer = cWorld . lWorld . machines . ix (_mcID mc)

@@ -154,10 +152,12 @@ mcNoItemsTest mc ps w
  where
    truetog = mc ^? mcType . _McProxSensor . proxToggle . _Just == Just True
    falsetog = mc ^? mcType . _McProxSensor . proxToggle . _Just == Just False
-    notog = null (mc ^? mcType . _McProxSensor . proxToggle . _Just)
-        && pointInPoly (cr ^. crPos) qs
-    t = ((cr ^. crInv == mempty) || not (pointInPoly (cr ^. crPos) qs))
-         && not (any ((`pointInPoly` qs) . _flItPos) (w ^. cWorld . lWorld . floorItems))
+    notog =
+        null (mc ^? mcType . _McProxSensor . proxToggle . _Just)
+            && pointInPoly (cr ^. crPos) qs
+    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
    mctermlens = cWorld . lWorld . terminals . ix (mc ^?! mcMounts . ix OTTerminal)
@@ -165,23 +165,23 @@ mcNoItemsTest mc ps w
    qs = f ps
    f = fmap ((+ _mcPos mc) . rotateV (_mcDir mc))

-mcProximitySensorUpdate 
-    :: Machine -> ProximitySensor -> ProximityRequirement -> World -> World
+mcProximitySensorUpdate ::
+    Machine -> ProximitySensor -> ProximityRequirement -> World -> World
 mcProximitySensorUpdate mc sens pr w
    | truetog || dist (_crPos ycr) (_mcPos mc) > 40 = w
    | mcProxTest w pr =
        w
            & mcsenslens . proxToggle ?~ True
            & playsound dedaS
-            & mctermlens . tmFutureLines <>~ 
-                [makeTermLine "SENSOR SUCCESS, DEACTIVATED" ] 
+            & mctermlens . tmFutureLines
+                <>~ [makeTermLine "SENSOR SUCCESS, DEACTIVATED"]
                <> tlSetStatus (TerminalPressTo "QUIT")
                <> tlDoEffect TmWdWdLeaveTerminal
    | notog =
        w & playsound dedumS
            & mcsenslens . proxToggle ?~ False
            & mctermlens . tmFutureLines
-            .:~ makeTermLine ( "SENSOR FAIL: REQUIRES " ++ sensorReqToString pr)
+            .:~ makeTermLine ("SENSOR FAIL: REQUIRES " ++ sensorReqToString pr)
    | otherwise = w
  where
    truetog = sens ^? proxToggle . _Just == Just True
@@ -211,7 +211,8 @@ senseDamage threshold dt mc =
    (cWorld . lWorld . machines . ix mcid %~ upmc)
        . updatels
  where
-    upmc = mcType . _McDamSensor . sensAmount %~ min (100 * threshold) . max 0 . (+ newsense)
+    upmc = mcType . _McDamSensor . sensAmount 
+        %~ min (100 * threshold) . max 0 . (+ newsense)
    mcid = _mcID mc
    newsense
        | x > 0 = x
@@ -243,8 +244,3 @@ sensorTypeDamages = \case
        Crushing{} -> True
        Explosive{} -> True
        _ -> False
-
--damageUsing :: DamageType -> Damage -> Either Int Int
--damageUsing dt dm
--    | _dmType dm == dt = Left $ _dmAmount dm
--    | otherwise = Right 0
@@ -11,7 +11,8 @@ analyser :: ProximitySensorType -> PlacementSpot -> PlacementSpot -> Placement
 analyser pst pslight psmc = extTrigLitPos pslight $ \tp ->
    Just $
        plSpot .~ psmc $
-            putTerminal (dark magenta)
+            putTerminal
+                (dark magenta)
                (themachine & mcMounts . at OTTrigger .~ _plMID tp)
                tparams
  where
@@ -5,7 +5,7 @@ module Dodge.Room.Airlock where

 import Control.Lens
 import Control.Monad
-import Dodge.Annotation.Data
+--import Dodge.Annotation.Data
 import Dodge.Data.GenWorld
 import Dodge.Default.Door
 import Dodge.Default.Room
@@ -25,25 +25,31 @@ airlock =
    join $
        takeOne [return airlock0, return airlock90, return airlockCrystal, airlockZ]

--airlock = takeOne [airlockCrystal]
-decontamRoom :: State LayoutVars Room
-decontamRoom = do
-    return $
-        defaultRoom
-            & rmPolys .~ cutps
-            & rmLinks .~ muout lnks ++ muin [last lnks]
-            & rmPath .~ foldMap doublePairSet [(V2 20 95, V2 20 45), (V2 20 45, V2 20 5)]
-            & rmPmnts
-                .~ [ pContID (PS (V2 (-35) 50) (negate $ pi / 2)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
-                        \btid -> Just $
-                            putDoubleDoorThen DoorObstacle thewall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $
-                                \_ _ -> 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 (NoItemZone ps) (PS 50 0) (PS mcpos 0)
-                   ]
-            & rmBound .~ [rectNSWE 75 15 0 40, switchcut]
+decontamRoom :: Int -> Room
+decontamRoom i =
+    defaultRoom
+        & rmPolys .~ cutps
+        & rmLinks .~ muout lnks ++ muin [last lnks]
+        & rmPath .~ foldMap doublePairSet [(V2 20 95, V2 20 45), (V2 20 45, V2 20 5)]
+        & rmPmnts
+            .~ [ pContID (PS (V2 (-35) 50) (negate $ pi / 2)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
+                    \btid -> Just $
+                        putDoubleDoorThen DoorObstacle thewall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $
+                            \_ _ -> Just $ putDoubleDoor DoorObstacle thewall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
+               , invisibleWall $ rectNSWE 60 40 (-40) (-30)
+               , spanLightI (V2 (-20) 30) (V2 (-20) 70)
+               ]
+        & rmOutPmnt . at i ?~ 
+               analyser (NoItemZone ps) (PS 50 0) (PS mcpos 0)
+        & rmInPmnt .~ [InPlacement f i]
+        & rmBound .~ [rectNSWE 75 15 0 40, switchcut]
  where
+    f _ (pmnt : _) = putDoubleDoor DoorObstacle (switchWallCol red) (cond pmnt) 
+        (V2 (-10) 35) 
+        (V2 (-10) 65) 
+        2
+    f _ _ = error "tried to put a door using an empty placement list"
+    cond pmnt = WdTrig $ pmnt ^?! plMID . _Just
    mcpos = V2 70 50
    cutps = [rectNSWE 100 0 0 40, switchcut]
    ps = (\p -> p - mcpos) <$> orderPolygon (concat cutps)
@@ -56,7 +56,8 @@ tutAnoTree =
 tutDrop :: State LayoutVars (MetaTree Room String)
 tutDrop = do
    x <- shuffleLinks =<< roomNgon 6 100
-    y <- decontamRoom
+    i <- nextLayoutInt
+    let y = decontamRoom i
    rm <- roomRectAutoLinks 40 100
    return $ tToBTree "TutDrop" $ treePost [x,y,cleatOnward rm]