Unify background machine sounds

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

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

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 Linear
-import qualified Data.IntSet as IS
+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
+    McStorage{} -> id
-    McDistributer {} -> 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)
                )
@@ -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
+mcPlaySound mc w = fromMaybe w $ do
-    McTerminal
+    guard $ d < 100
-        | d < 100 ->
+    (sid,x) <- mcBackgroundSound mc
+    return $
         soundContinueVol
-                (1 -0.01 * d)
+            (x * (1 - 0.01 * d))
             (MachineBackgroundSound mid)
             (_mcPos mc)
-                fridgeHumS
+            sid
             (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
   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
+            & mctermlens
+            . tmFutureLines
             <>~ [makeTermLine "SENSOR SUCCESS: DEACTIVATED"]
             <> tlSetStatus (TerminalPressTo "QUIT")
             <> tlDoEffect (TmWdWdLeaveTerminal "QUIT")
     | notog =
-        w & playsound dedumS
+        w
-            & mcsenslens . proxToggle ?~ False
+            & playsound dedumS
-            & mctermlens . tmFutureLines
+            & mcsenslens
+            . proxToggle
+            ?~ False
+            & mctermlens
+            . tmFutureLines
             .:~ makeTermLine ("SENSOR FAIL: REQUIRES " ++ sensorReqToString pr)
     | otherwise = w
   where
@@ -225,9 +255,13 @@ mcProxTest w = \case
     RequireHealth x -> fromMaybe 0 (cr ^? crHP . _HP) >= x
     RequireEquipment ct ->
         any
-            ((\itm -> _itType itm == ct)
+            ( (\itm -> _itType itm == ct)
-            . (\k -> w ^?! cWorld . lWorld . items . ix k)) (_crInv cr)
+                . (\k -> w ^?! cWorld . lWorld . items . ix k)
-    RequireDeadCreatures is -> all (\x -> null (x ^? crHP . _HP))
+            )
+            (_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 
+    upmc =
-        %~ min (100 * threshold) . max 0 . (+ newsense)
+        mcType
+            . _McDamSensor
+            . sensAmount
+            %~ min (100 * threshold)
+            . max 0
+            . (+ newsense)
     mcid = _mcID mc
     newsense
         | x > 0 = x