Unify background machine sounds

2025-12-26 12:49:49 +00:00
parent 337e786f33
commit 29394e86a3
3 changed files with 102 additions and 59 deletions
@@ -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
@@ -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
@@ -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