From a9e80809e890cb3281259fec32de74933c26e470 Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 15 Feb 2026 11:01:20 +0000 Subject: [PATCH] Damage sense through immediate damage to machines --- src/Dodge/Floor.hs | 16 ---------- src/Dodge/Machine/Update.hs | 1 - src/Dodge/Room/Tutorial.hs | 26 +++++++++++++++ src/Dodge/Wall/Damage.hs | 63 +++++++++++++++++++++++++++++++++++-- 4 files changed, 86 insertions(+), 20 deletions(-) diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 10723e1bd..feb67bd5a 100644 --- a/src/Dodge/Floor.hs +++ b/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]) - [] diff --git a/src/Dodge/Machine/Update.hs b/src/Dodge/Machine/Update.hs index 32c6afcd6..14307aebd 100644 --- a/src/Dodge/Machine/Update.hs +++ b/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 diff --git a/src/Dodge/Room/Tutorial.hs b/src/Dodge/Room/Tutorial.hs index 64a3064f9..278d2defa 100644 --- a/src/Dodge/Room/Tutorial.hs +++ b/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]) + [] diff --git a/src/Dodge/Wall/Damage.hs b/src/Dodge/Wall/Damage.hs index 8ed2a6490..d4a165613 100644 --- a/src/Dodge/Wall/Damage.hs +++ b/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