loop/src/Dodge/Machine/Update.hs

module Dodge.Machine.Update where

import Control.Monad
import Data.List (partition)
import Data.Maybe
import Dodge.Base.Collide
import Dodge.Base.You
import Dodge.Data.World
import Dodge.HeldUse
import Dodge.Machine.Destroy
import Dodge.Movement.Turn
import Dodge.SoundLogic
import Geometry
import LensHelp

updateMachine :: Machine -> World -> World
updateMachine mc
    | _mcHP mc < 1 = destroyMachine mc
    | otherwise =
        mcApplyDamage (_mcDamage mc) mc
            . mcPlaySound mc
            . mcTypeUpdate mc

mcTypeUpdate :: Machine -> World -> World
mcTypeUpdate mc = case mc ^. mcType of
    McStatic -> id
    McTerminal -> id
    McTurret tu -> updateTurret (_tuTurnSpeed tu) mc
    McSensor se -> mcSensorTriggerUpdate se mc . mcSensorUpdate se mc

updateTurret :: Float -> Machine -> World -> World
updateTurret rotSpeed mc w =
    w
        & dodamage
        & mcUseItem mc
        & elecDamBranch
  where
    dodamage =
        cWorld . 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
    mcid = _mcID mc
    ypos = _crPos $ you w
    mcpos = _mcPos mc
    seesYou = hasLOSIndirect mcpos ypos w
    (elecDams, dams) = partition isElectrical $ _mcDamage mc
    dam = sum $ map _dmAmount dams
    elecDam = sum $ map _dmAmount elecDams
    doTurn
        | seesYou = cWorld . machines . ix mcid . mcType . _McTurret . tuDir %~ turnTo rotSpeed mcpos ypos
        | otherwise = id
    closeFireAngle = seesYou -- && angleVV (ypos -.- mcpos) (unitVectorAtAngle mcdir) < 1
    updateFiringStatus
        | closeFireAngle = cWorld . machines . ix mcid . mcType . _McTurret . tuFireTime .~ 20
        | otherwise = cWorld . machines . ix mcid . mcType . _McTurret . tuFireTime %~ (max 0 . subtract 1)

mcUseItem :: Machine -> World -> World
mcUseItem mc = fromMaybe id $ do
    tu <- mc ^? mcType . _McTurret
    let it = tu ^. tuWeapon
    hit <- it ^? itType . iyBase . ibtHeld
    guard (_tuFireTime tu > 0)
    return $ mcUseHeld hit it mc

mcSensorTriggerUpdate :: Sensor -> Machine -> World -> World
mcSensorTriggerUpdate se mc = fromMaybe id $ do
    trid <- mc ^? mcMounts . ix ObTrigger
    bval <- mcTriggerVal se
    return $ cWorld . triggers . ix trid ||~ bval

mcTriggerVal :: Sensor -> Maybe Bool
mcTriggerVal se = case se of
    ProximitySensor{} -> se ^? sensToggle
    DamageSensor{} -> Just $ _sensAmount se > _sensThreshold se

mcPlaySound :: Machine -> World -> World
mcPlaySound mc w = case _mcCloseSound mc of
    Just sid
        | d < 100 ->
            soundContinueVol (1 -0.01 * d) (MachineSound mid) (_mcPos mc) sid (Just 2) w
    _ -> w
  where
    d = max 0 (dist (_crPos $ you w) (_mcPos mc) - 100)
    mid = _mcID mc

mcApplyDamage :: [Damage] -> Machine -> World -> World
mcApplyDamage ds mc = case mc ^? mcType . _McSensor of
    Nothing -> mcpointer
            %~ ((mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds)))
    _ -> mcpointer
            %~ (mcDamage .~ [])
  where
    mcpointer = cWorld . machines . ix (_mcID mc)

mcSensorUpdate :: Sensor -> Machine -> World -> World
mcSensorUpdate se mc w = case se of
    s@DamageSensor{} -> senseDamage (_sensThreshold se) (_sensType s) mc w
    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
            & cWorld . machines . ix (_mcID mc) . mcType . _McSensor . sensToggle .~ True
            & playsound dedaS
            & cWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ IsClose
    (NotClose, _, False, True) ->
        w & playsound dedumS
            & cWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ IsClose
    (_, _, _, False) -> w & cWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ NotClose
    _ -> w
  where
    playsound sid = soundContinue (MachineAltSound (_mcID mc)) (_mcPos mc) sid Nothing
    ycr = you w
    sens = mc ^?! mcType . _McSensor

mcProxTest :: Machine -> World -> Bool
mcProxTest mc w = case mc ^? mcType . _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

senseDamage :: Int -> DamageType -> Machine -> World -> World
senseDamage threshold dt mc =
    (cWorld . machines . ix mcid %~ upmc)
        . updatels
  where
    upmc = mcType . _McSensor . sensAmount %~ min (100 * threshold) . max 0 . (+ newsense)
    mcid = _mcID mc
    newsense
        | x > 0 = x
        | otherwise = -5
      where
        x = sum . map _dmAmount $ filter ((== dt) . _dmType) (_mcDamage mc)
    ni = fromIntegral (mc ^?! mcType . _McSensor . sensAmount) / fromIntegral threshold
    updatels = fromMaybe id $ do
        lsid <- mc ^? mcMounts . ix ObLightSource
        return $ cWorld . lightSources . ix lsid . lsParam . lsCol .~ V3 ni ni ni

damageUsing :: DamageType -> Damage -> Either Int Int
damageUsing dt dm
    | _dmType dm == dt = Left $ _dmAmount dm
    | otherwise = Right 0