Damage sense through immediate damage to machines

src/Dodge/Floor.hs

@@ -5,7 +5,6 @@ module Dodge.Floor (
 ) where
 
 import Dodge.Data.MTRS
-import Data.Maybe
 import Dodge.Room.Tutorial
 import Data.List (intersperse)
 import Dodge.Cleat
@@ -117,18 +116,3 @@ intAnno f = do
 anRoom :: State StdGen Room -> State LayoutVars MTRS
 anRoom t = zoom lyGen (tToBTree "anRoom" . return . cleatOnward <$> t)
 
-passthroughLockKeyLists ::
-        [(Int -> State LayoutVars (MetaTree Room String), State LayoutVars ItemType)]
-        -> [(ItemType, State LayoutVars (MetaTree Room String))]
-        -> State LayoutVars (MetaTree Room String)
-passthroughLockKeyLists ls ks = do
-        i <- nextLayoutInt
-        (functionlockroom, randomitemidentity) <- takeOne ls
-        lr <- functionlockroom i
-        ii <- randomitemidentity
-        keyroom <- fromJust $ lookup ii ks
-        return $
-            MTree
-                ("PassthroughLockKeyLists-" ++ show ii)
-                (NodeMTree $ MTree "RassThroughLockKeyLists" (NodeMTree lr) [MBranch (toLabel i) keyroom])
-                []

src/Dodge/Machine/Update.hs

@@ -12,7 +12,6 @@ import Dodge.Base.You
 import Dodge.Data.World
 import Dodge.HeldUse
 import Dodge.Item.Display
-import Dodge.Machine.Destroy
 import Dodge.Movement.Turn
 import Dodge.SoundLogic
 import Dodge.Terminal

src/Dodge/Room/Tutorial.hs

@@ -1,6 +1,9 @@
 {-# OPTIONS_GHC -Wno-unused-imports #-}
 module Dodge.Room.Tutorial where
 
+import Data.Maybe
+import Dodge.LockAndKey
+import Dodge.Room.SensorDoor
 import Dodge.Room.Room
 import Dodge.Data.AmmoType
 import Dodge.Room.Path
@@ -51,6 +54,14 @@ tutAnoTree = do
         [ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
         , corDoor
         , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
+        , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
+            , passthroughLockKeyLists
+                    [(sensorRoomRunPast ElectricSensor, takeOne 
+                        [-- CRAFT (ENERGYBALLCRAFT TeslaBall) , 
+                        HELD SPARKGUN])]
+                    itemRooms
+        , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
+        , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
         , tToBTree "sdr" . return . cleatOnward <$> 
                 (shuffleLinks =<< distributerRoom BulletAmmo 100000)
 --        , return $ tToBTree "cor" $ return $ cleatOnward corridor
@@ -505,3 +516,18 @@ tutorialMessage1 i =
 --           , makeTermLine "        AND NEARBY OBJECTS WILL BE DISPLAYED"
 --           , makeTermLine "--------------------------------------------"
 --           ]
+passthroughLockKeyLists ::
+        [(Int -> State LayoutVars (MetaTree Room String), State LayoutVars ItemType)]
+        -> [(ItemType, State LayoutVars (MetaTree Room String))]
+        -> State LayoutVars (MetaTree Room String)
+passthroughLockKeyLists ls ks = do
+        i <- nextLayoutInt
+        (functionlockroom, randomitemidentity) <- takeOne ls
+        lr <- functionlockroom i
+        ii <- randomitemidentity
+        keyroom <- fromJust $ lookup ii ks
+        return $
+            MTree
+                ("PassthroughLockKeyLists-" ++ show ii)
+                (NodeMTree $ MTree "RassThroughLockKeyLists" (NodeMTree lr) [MBranch (toLabel i) keyroom])
+                []

src/Dodge/Wall/Damage.hs

@@ -35,7 +35,7 @@ damageWall wlid dt w = fromMaybe (mempty,w) $ do
     return $ case wl ^. wlStructure of
         MachinePart mcid -> -- (,) mempty 
 --            $ w' & cWorld . lWorld . machines . ix mcid . mcDamage .:~ dt
-            w' & damageMachine dmam mcid
+            w' & damageMachine dt dmam mcid
         BlockPart blid ->
             w' & damageBlock (wl ^. wlMaterial) dmam blid
         DoorPart drid _ ->
@@ -43,11 +43,68 @@ damageWall wlid dt w = fromMaybe (mempty,w) $ do
                 & maybeDestroyDoor drid
         _ -> (mempty, w')
 
-damageMachine :: Int -> Int -> World -> (S.Set Int2, World)
-damageMachine x mcid w = case w ^? cWorld . lWorld . machines . ix mcid of
+damageMachine :: Damage -> Int -> Int -> World -> (S.Set Int2, World)
+damageMachine dam x mcid w = case w ^? cWorld . lWorld . machines . ix mcid of
+    Just mc | Just se <- mc ^? mcType . _McDamSensor
+        , sensorTypeDamages (se ^. sensType) dam
+        -> (mempty,mcDamSensorUpdate' (_dmAmount dam) se mc w)
     Just mc | _mcHP mc < x -> destroyMachine' mc w
     _ -> (mempty, w & cWorld . lWorld . machines . ix mcid . mcHP -~ x)
 
+mcDamSensorUpdate' :: Int -> DamageSensor -> Machine -> World -> World
+mcDamSensorUpdate' x se = senseDamage' x (damageTypeThreshold' (se ^. sensType)) (se ^. sensType)
+
+senseDamage' :: Int -> Int -> SensorType -> Machine -> World -> World
+senseDamage' x threshold dt mc =
+    (cWorld . lWorld . machines . ix mcid %~ upmc)
+        . updatels
+  where
+    upmc =
+        mcType
+            . _McDamSensor
+            . sensAmount
+            %~ min (100 * threshold)
+            . max 0
+            . (+ newsense)
+    mcid = _mcID mc
+    newsense
+        | x > 0 = x
+        | otherwise = -5
+--      where
+--        f = sensorTypeDamages dt
+--        x = sum . map _dmAmount $ filter f (_mcDamage mc)
+    ni = fromIntegral (mc ^?! mcType . _McDamSensor . sensAmount) / fromIntegral threshold
+    updatels = fromMaybe id $ do
+        lsid <- mc ^? mcMounts . ix OTLightSource
+        return $ cWorld . lWorld . lightSources . ix lsid . lsParam . lsCol .~ V3 ni ni ni
+
+damageTypeThreshold' :: SensorType -> Int
+damageTypeThreshold' = \case
+    LaserSensor -> 1000
+    ElectricSensor -> 500
+    ThermalSensor -> 1000
+    PhysicalSensor -> 1000
+
+sensorTypeDamages :: SensorType -> Damage -> Bool
+sensorTypeDamages = \case
+    LaserSensor -> \case
+        Lasering{} -> True
+        _ -> False
+    ElectricSensor -> \case
+        Electrical{} -> True
+        _ -> False
+    ThermalSensor -> \case
+        Flaming{} -> True
+        Sparking{} -> True
+        Explosive{} -> True
+        _ -> False
+    PhysicalSensor -> \case
+        Piercing{} -> True
+        Blunt{} -> True
+        Crushing{} -> True
+        Explosive{} -> True
+        _ -> False
+
 destroyMachine' :: Machine -> World -> (S.Set Int2, World)
 destroyMachine' mc w = (js, destroyMachine mc w)
   where