From 29394e86a3fc2440415bb2d0a37f8e817419922d Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 26 Dec 2025 12:49:49 +0000 Subject: [PATCH] Unify background machine sounds --- src/Dodge/Data/Machine.hs | 2 + src/Dodge/Machine/Draw.hs | 4 +- src/Dodge/Machine/Update.hs | 155 ++++++++++++++++++++++-------------- 3 files changed, 102 insertions(+), 59 deletions(-) diff --git a/src/Dodge/Data/Machine.hs b/src/Dodge/Data/Machine.hs index 0c9c5dd92..1f1bf9b5d 100644 --- a/src/Dodge/Data/Machine.hs +++ b/src/Dodge/Data/Machine.hs @@ -47,6 +47,7 @@ data MachineType | McTurret {_mctTurret :: Turret} | McStorage {_mcsType :: AmmoType, _mcsAmount :: Int} | McDistributer {_mcdStorageMachine :: Maybe Int} + | McInterrupter -- | McSynthesiser instance ShortShow MachineType where @@ -58,6 +59,7 @@ instance ShortShow MachineType where McTurret {} -> "McTur" McStorage {} -> "McStor" McDistributer {} -> "McDist" + McInterrupter {} -> "McInterrupter" data Turret = Turret { _tuWeapon :: Int diff --git a/src/Dodge/Machine/Draw.hs b/src/Dodge/Machine/Draw.hs index 0b214aa50..53674d52c 100644 --- a/src/Dodge/Machine/Draw.hs +++ b/src/Dodge/Machine/Draw.hs @@ -23,6 +23,7 @@ drawMachine cw mc = case _mcType mc of McProxSensor {} -> drawBaseMachine 25 mc McStorage {} -> noPic $ colorSH (mcColor mc) storageShape McDistributer {} -> drawBaseMachine 25 mc + McInterrupter {} -> drawBaseMachine 25 mc where lw = cw ^. lWorld gp = cw ^. cwGen . cwgParams . sensorCoding @@ -86,7 +87,8 @@ mcColor mc = case mc ^. mcType of McProxSensor {} -> aquamarine McTurret {} -> blue McStorage {} -> orange - McDistributer {} -> red + McDistributer {} -> green + McInterrupter {} -> red drawTurret :: LWorld -> Turret -> Machine -> SPic diff --git a/src/Dodge/Machine/Update.hs b/src/Dodge/Machine/Update.hs index f2597da74..0e5bff802 100644 --- a/src/Dodge/Machine/Update.hs +++ b/src/Dodge/Machine/Update.hs @@ -2,8 +2,9 @@ module Dodge.Machine.Update (updateMachine) where -import Linear import Control.Monad +import qualified Data.IntMap.Strict as IM +import qualified Data.IntSet as IS import Data.List (partition) import Data.Maybe import Dodge.Base.Collide @@ -18,8 +19,8 @@ import Dodge.Terminal import Dodge.Terminal.Color import Geometry import LensHelp -import qualified Data.IntMap.Strict as IM -import qualified Data.IntSet as IS +import Linear +import Sound.Data updateMachine :: Machine -> World -> World updateMachine mc @@ -36,8 +37,9 @@ mcTypeUpdate mc = \case McTurret tu -> updateTurret (_tuTurnSpeed tu) mc McDamSensor se -> mcDamSensorTriggerUpdate se mc . mcDamSensorUpdate se mc McProxSensor se -> mcProxSensorTriggerUpdate se mc . mcProxSensorUpdate se mc - McStorage {} -> id - McDistributer {} -> id + McStorage{} -> id + McDistributer{} -> id + McInterrupter{} -> id terminalScreenGlow :: Machine -> World -> World terminalScreenGlow mc w = fromMaybe w $ do @@ -45,7 +47,10 @@ terminalScreenGlow mc w = fromMaybe w $ do term <- w ^? cWorld . lWorld . terminals . ix tid V4 x y z _ <- termScreenColor term return $ - w & cWorld . lWorld . lights + w + & cWorld + . lWorld + . lights .:~ LSParam (_mcPos mc `v2z` 20) 30 (V3 x y z) updateTurret :: Float -> Machine -> World -> World @@ -56,7 +61,10 @@ updateTurret rotSpeed mc w = & elecDamBranch where dodamage = - cWorld . lWorld . machines . ix mcid + cWorld + . lWorld + . machines + . ix mcid %~ ( (mcDamage .~ [Electrical (min 2500 $ max 0 (elecDam - 10))]) . (mcHP -~ dam) ) @@ -64,7 +72,7 @@ updateTurret rotSpeed mc w = | elecDam < 10 = updateFiringStatus . doTurn | otherwise = id mcid = _mcID mc - ypos = you w ^. crPos . _xy + ypos = you w ^. crPos . _xy mcpos = _mcPos mc seesYou = hasLOSIndirect mcpos ypos w (elecDams, dams) = partition isElectrical $ _mcDamage mc @@ -72,7 +80,13 @@ updateTurret rotSpeed mc w = elecDam = sum $ map _dmAmount elecDams doTurn | seesYou = - cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuDir + cWorld + . lWorld + . machines + . ix mcid + . mcType + . _McTurret + . tuDir %~ turnTo rotSpeed mcpos ypos | otherwise = id closeFireAngle = seesYou -- && angleVV (ypos -.- mcpos) (unitVectorAtAngle mcdir) < 1 @@ -80,7 +94,13 @@ updateTurret rotSpeed mc w = | closeFireAngle = cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuFireTime .~ 20 | otherwise = - cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuFireTime + cWorld + . lWorld + . machines + . ix mcid + . mcType + . _McTurret + . tuFireTime %~ (max 0 . subtract 1) isElectrical :: Damage -> Bool @@ -113,39 +133,32 @@ mcTriggerVal :: DamageSensor -> Maybe Bool 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) - (MachineBackgroundSound mid) - (_mcPos mc) - fridgeHumS - (Just 2) - w - McDistributer {} - | d < 100 -> - soundContinueVol - (0.5 * (1 -0.01 * d)) - (MachineBackgroundSound mid) - (_mcPos mc) - whirS - (Just 2) - w - McProxSensor {} - | d < 100 -> - soundContinueVol - (0.5 * (1 -0.01 * d)) - (MachineBackgroundSound mid) - (_mcPos mc) - throbC4S - (Just 2) - w - _ -> w +mcPlaySound mc w = fromMaybe w $ do + guard $ d < 100 + (sid,x) <- mcBackgroundSound mc + return $ + soundContinueVol + (x * (1 - 0.01 * d)) + (MachineBackgroundSound mid) + (_mcPos mc) + sid + (Just 2) + w where - d = max 0 (dist ( you w ^. crPos . _xy) (_mcPos mc) - 100) + d = max 0 (dist (you w ^. crPos . _xy) (_mcPos mc) - 100) mid = _mcID mc +mcBackgroundSound :: Machine -> Maybe (SoundID,Float) +mcBackgroundSound mc = case mc ^. mcType of + McStatic -> Nothing + McTerminal -> Just (fridgeHumS,1) + McTurret{} -> Just (fridgeHumS,1) + McDamSensor{} -> Just (fridgeHumS,1) + McProxSensor{} -> Just (throbC4S,0.5) + McStorage{} -> Nothing + McDistributer{} -> Just (whirS,0.5) + McInterrupter{} -> Just (throbC4S,0.5) + mcApplyDamage :: [Damage] -> Machine -> World -> World mcApplyDamage ds mc = case mc ^? mcType . _McDamSensor of Nothing -> mcpointer %~ ((mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds))) @@ -164,13 +177,23 @@ mcProxSensorUpdate se mc = case se ^. proxSensorType of mcNoItemsTest :: Machine -> [Point2] -> World -> World mcNoItemsTest mc ps w | t && (falsetog || notog) = - w & mcsenslens . proxToggle ?~ True + w + & mcsenslens + . proxToggle + ?~ True & playsound dedaS - & mctermlens . tmFutureLines .:~ makeTermLine "SENSOR SUCCESS: ZONE CLEAR" + & mctermlens + . tmFutureLines + .:~ makeTermLine "SENSOR SUCCESS: ZONE CLEAR" | not t && (truetog || notog) = - w & mcsenslens . proxToggle ?~ False + w + & mcsenslens + . proxToggle + ?~ False & playsound dedumS - & mctermlens . tmFutureLines .:~ makeTermLine "SENSOR FAIL: ITEM IN ZONE" + & mctermlens + . tmFutureLines + .:~ makeTermLine "SENSOR FAIL: ITEM IN ZONE" | otherwise = w where truetog = mc ^? mcType . _McProxSensor . proxToggle . _Just == Just True @@ -194,16 +217,23 @@ mcProximitySensorUpdate mc sens pr w | truetog || dist (ycr ^. crPos . _xy) (_mcPos mc) > 40 = w | mcProxTest w pr = w - & mcsenslens . proxToggle ?~ True + & mcsenslens + . proxToggle + ?~ True & playsound dedaS - & mctermlens . tmFutureLines - <>~ [makeTermLine "SENSOR SUCCESS: DEACTIVATED"] - <> tlSetStatus (TerminalPressTo "QUIT") - <> tlDoEffect (TmWdWdLeaveTerminal "QUIT") + & mctermlens + . tmFutureLines + <>~ [makeTermLine "SENSOR SUCCESS: DEACTIVATED"] + <> tlSetStatus (TerminalPressTo "QUIT") + <> tlDoEffect (TmWdWdLeaveTerminal "QUIT") | notog = - w & playsound dedumS - & mcsenslens . proxToggle ?~ False - & mctermlens . tmFutureLines + w + & playsound dedumS + & mcsenslens + . proxToggle + ?~ False + & mctermlens + . tmFutureLines .:~ makeTermLine ("SENSOR FAIL: REQUIRES " ++ sensorReqToString pr) | otherwise = w where @@ -225,10 +255,14 @@ mcProxTest w = \case RequireHealth x -> fromMaybe 0 (cr ^? crHP . _HP) >= x RequireEquipment ct -> any - ((\itm -> _itType itm == ct) - . (\k -> w ^?! cWorld . lWorld . items . ix k)) (_crInv cr) - RequireDeadCreatures is -> all (\x -> null (x ^? crHP . _HP)) - (IM.restrictKeys (w ^. cWorld . lWorld . creatures) (IS.fromList is)) + ( (\itm -> _itType itm == ct) + . (\k -> w ^?! cWorld . lWorld . items . ix k) + ) + (_crInv cr) + RequireDeadCreatures is -> + all + (\x -> null (x ^? crHP . _HP)) + (IM.restrictKeys (w ^. cWorld . lWorld . creatures) (IS.fromList is)) where cr = you w @@ -237,8 +271,13 @@ 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