Move towards removing machine update field

src/Dodge/Data.hs

@@ -1024,7 +1024,6 @@ data Machine = Machine
     { _mcID     :: Int
     , _mcWallIDs    :: IS.IntSet
     , _mcUpdate :: Machine -> World -> World
-    , _mcApplyDamage    :: [Damage] -> Machine -> World -> World
     , _mcDraw   :: Machine -> SPic
     , _mcPos    :: Point2
     , _mcDir    :: Float
@@ -1036,6 +1035,7 @@ data Machine = Machine
     , _mcType   :: MachineType
     , _mcMounts :: M.Map Object Int
     , _mcName   :: String
+    , _mcCloseSound :: Maybe SoundID
 --    , _mcTermMID :: Maybe Int
     }
 data Sensor = NoSensor

src/Dodge/Default.hs

@@ -181,7 +181,6 @@ defaultMachine = Machine
     { _mcID = 0
     , _mcWallIDs = mempty
     , _mcUpdate = defaultMachineUpdate
-    , _mcApplyDamage = \_ _ -> id
     , _mcDraw = const mempty
     , _mcColor = white
     , _mcPos = V2 0 0
@@ -193,6 +192,7 @@ defaultMachine = Machine
     , _mcType = StaticMachine
     , _mcName = ""
     , _mcMounts = mempty
+    , _mcCloseSound = Nothing
     }
 defaultMachineUpdate :: Machine -> World -> World
 defaultMachineUpdate mc

src/Dodge/Machine/Update.hs

@@ -0,0 +1,169 @@
+module Dodge.Machine.Update where
+import Dodge.Data
+import Dodge.Machine.Destroy
+import Dodge.SoundLogic
+import Dodge.Base.You
+import Dodge.Base.Collide
+import Dodge.Wall.Delete
+import Dodge.WorldEvent.Explosion
+import Dodge.FloorItem
+import Dodge.Item.Weapon.BatteryGuns
+import Dodge.Default
+import Dodge.Creature.State
+import Dodge.Creature.Impulse
+import Dodge.Creature.Damage
+import Dodge.Movement.Turn
+import Geometry
+import LensHelp
+import qualified IntMapHelp as IM
+
+import Data.Either
+import Data.List (partition)
+import Data.Maybe
+
+updateMachine :: Machine -> World -> World
+updateMachine mc
+    | _mcHP mc < 1 = destroyMachine mc
+    | otherwise = mcApplyDamage (_mcDamage mc) mc
+        . mcPlaySound mc
+        . mcTurretUpdate mc
+        . mcSensorUpdate mc
+
+mcTurretUpdate :: Machine -> World -> World
+mcTurretUpdate mc = case _mcType mc of
+    mt@Turret{} -> updateTurret (_tuTurnSpeed mt) mc
+    _ -> id
+
+-- this needs a major cleanup
+updateTurret :: Float -> Machine -> World -> World
+updateTurret rotSpeed mc w 
+    | _mcHP mc < 1 = w & machines %~ IM.delete mcid
+        & deleteWallIDs (_mcWallIDs mc)
+        & makeExplosionAt mcpos
+        & copyItemToFloor mcpos lasGun
+        & deleteHomonculus
+    | otherwise = w 
+        & initHomonculus
+        & dodamage 
+        & maybeFire 
+        & elecDamBranch
+  where
+    deleteHomonculus = case _tuMCrID (_mcType mc) of
+        Nothing -> id
+        Just cid -> creatures . at cid .~ Nothing
+    initHomonculus w' = case w' ^? machines . ix mcid . mcType . tuMCrID . _Just of
+        Nothing -> w' & machines . ix mcid . mcType . tuMCrID ?~ cid
+            & creatures . at cid ?~ thecreature
+          where
+            cid = IM.newKey (_creatures w')
+            thecreature = defaultCreature
+                & crID .~ cid
+                & crInv . at 0 ?~ (_tuWeapon (_mcType mc) & itUse . useAim . aimHandlePos -~ 10
+                    & itConsumption . laLoaded .~ 1
+                    )
+                & crPos .~ mcpos
+                & crOldPos .~ mcpos
+                & crRad    .~ 1
+                & crDir .~ mcdir
+                & crUpdate .~ stateUpdate followThenClearImpulses
+                & crStance . posture .~ Aiming
+                & crApplyDamage .~ applyNoDamage
+        Just cid -> w'
+            & creatures . ix cid . crPos .~ mcpos
+            & creatures . ix cid . crDir .~ mcdir
+    dodamage = machines . ix mcid %~ 
+        ( (mcDamage .~ [Damage ELECTRICAL (min 2500 $ max 0 (elecDam - 10)) 0 0 0 NoDamageEffect])
+        . (mcHP -~ dam)
+        )
+    elecDamBranch
+        | elecDam < 10 = updateFiringStatus . doTurn
+        | otherwise = id
+    maybeFire
+        | _tuFireTime (_mcType mc) > 0
+            = fromMaybe id $ do
+                cid <- _tuMCrID (_mcType mc)
+                return $ creatures . ix cid . crActionPlan . apImpulse .~ [UseItem]
+        | otherwise = id
+    mcid = _mcID mc
+    ypos = _crPos $ you w
+    mcpos = _mcPos mc
+    mcdir = _mcDir mc
+    seesYou = hasLOSIndirect mcpos ypos w
+    (elecDams, dams) = partition isElectrical $ _mcDamage mc
+    dam = sum $ map _dmAmount dams
+    elecDam = sum $ map _dmAmount elecDams
+    doTurn  
+        | seesYou = machines . ix mcid . mcDir %~ turnTo rotSpeed mcpos ypos
+        | otherwise = id
+    closeFireAngle = seesYou -- && angleVV (ypos -.- mcpos) (unitVectorAtAngle mcdir) < 1
+    updateFiringStatus 
+        | closeFireAngle = machines . ix mcid . mcType . tuFireTime .~ 20
+        | otherwise      = machines . ix mcid . mcType . tuFireTime %~ (max 0 . subtract 1)
+
+mcPlaySound :: Machine -> World -> World
+mcPlaySound mc w = case _mcCloseSound mc of
+    Just sid | d < 200 -> soundContinueVol (1-0.005*d) (MachineSound mid) (_mcPos mc) sid (Just 2) w
+    _ -> w
+  where
+    d = dist (_crPos $ you w) (_mcPos mc)
+    mid = _mcID mc
+
+mcApplyDamage :: [Damage] -> Machine -> World -> World
+mcApplyDamage ds mc = machines . ix (_mcID mc) %~
+    ( (mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds)) )
+
+mcSensorUpdate :: Machine -> World -> World
+mcSensorUpdate mc w = case _mcSensor mc of
+    NoSensor -> w
+    SensorToggleAmount{} -> foldr (flip sensorUpdate mc) w (map _dmType $ _mcDamage mc)
+    ProximitySensor{} -> mcProximitySensorUpdate mc w
+
+mcProximitySensorUpdate :: Machine -> World -> World
+mcProximitySensorUpdate mc w = case 
+        (_proxStatus sens
+        , _sensToggle sens
+        , mcProxTest mc w 
+        , dist (_crPos ycr) (_mcPos mc) < _proxDist sens) of
+    (_,True,_,_) -> w
+    (_,False,True,True) -> w 
+            & machines . ix (_mcID mc) . mcSensor . sensToggle .~ True
+            & playsound dedaS
+            & machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose
+    (NotClose,_,False,True) -> w & playsound dedumS
+            & machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose
+    (_,_,_,False) -> w & machines . ix (_mcID mc) . mcSensor . proxStatus .~ NotClose
+    _ -> w
+ where
+    playsound sid = soundContinue (MachineAltSound (_mcID mc)) (_mcPos mc) sid Nothing
+    ycr = you w
+    sens = _mcSensor mc
+
+mcProxTest :: Machine -> World -> Bool
+mcProxTest mc w = case mc ^? mcSensor . proxRequirement of
+    Just (RequireHealth x)      -> _crHP cr >= x
+    Just (RequireEquipment ct)  -> any (\itm -> _iyBase (_itType itm) == ct) (_crInv cr)
+    _ -> False
+  where
+    cr = you w
+    
+
+sensorUpdate :: DamageType -> Machine -> World -> World
+sensorUpdate damF mc w = w & machines . ix mcid %~ upmc
+    & lightSources . ix lsid %~ upls
+  where
+    upmc = ( mcSensor . sensAmount %~ \x' -> min 1000 (max 0 (x' - 5 + newSense)) )
+        . ( mcHP -~ sum dam )
+        . (mcDamage .~ [])
+    x = _sensAmount $ _mcSensor mc
+    mcid = _mcID mc
+    lsid = head (_mcLSs mc)
+    (senseData,dam) = partitionEithers $ map (damageUsing damF) $ _mcDamage mc
+    newSense = sum senseData
+    ni = fromIntegral x / 1000
+    upls = lsParam . lsCol .~ V3 ni ni ni
+
+damageUsing :: DamageType -> Damage -> Either Int Int
+damageUsing dt dm
+    | _dmType dm == dt = Left $ _dmAmount dm
+    | otherwise = Right 0
+