loop/src/Dodge/Machine/Update.hs

{-# LANGUAGE LambdaCase #-}
module Dodge.Machine.Update (
    updateMachine,
) where

import Dodge.Terminal.Color
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 -> terminalScreenGlow mc
    McTurret tu -> updateTurret (_tuTurnSpeed tu) mc
    McSensor se -> mcSensorTriggerUpdate se mc . mcSensorUpdate se mc

terminalScreenGlow :: Machine -> World -> World
terminalScreenGlow mc w = fromMaybe w $ do
    tid <- mc ^? mcMounts . ix OTTerminal
    term <- w ^? cWorld . lWorld . terminals . ix tid
    V4 x y z _ <- termScreenColor term
    return $
        w & cWorld . lWorld . lights
            .:~ LSParam (_mcPos mc `v2z` 20) 30 (V3 x y z)
--        w & cWorld . lWorld . tempLightSources
--            .:~ TLS
--                { _tlsParam = LSParam (_mcPos mc `v2z` 20) 30 (V3 x y z)
--                , _tlsUpdate = TimerTLS
--                , _tlsTime = 1
--                }

updateTurret :: Float -> Machine -> World -> World
updateTurret rotSpeed mc w =
    w
        & dodamage
        & mcUseItem mc
        & elecDamBranch
  where
    dodamage =
        cWorld . lWorld . machines . ix mcid
            %~ ( (mcDamage .~ [Electrical (min 2500 $ max 0 (elecDam - 10))])
                    . (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 . lWorld . machines . ix mcid . mcType . _McTurret . tuDir %~ turnTo rotSpeed mcpos ypos
        | otherwise = id
    closeFireAngle = seesYou -- && angleVV (ypos -.- mcpos) (unitVectorAtAngle mcdir) < 1
    updateFiringStatus
        | closeFireAngle = cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuFireTime .~ 20
        | otherwise = cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuFireTime %~ (max 0 . subtract 1)

isElectrical :: Damage -> Bool
isElectrical dm = case dm of
    Electrical{} -> True
    _ -> False

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

mcSensorTriggerUpdate :: Sensor -> Machine -> World -> World
mcSensorTriggerUpdate se mc = fromMaybe id $ do
    trid <- mc ^? mcMounts . ix OTTrigger
    bval <- mcTriggerVal se
    return $ cWorld . lWorld . 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 . lWorld . 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 . lWorld . machines . ix (_mcID mc) . mcType . _McSensor . sensToggle .~ True
            & playsound dedaS
            & cWorld . lWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ IsClose
    (NotClose, _, False, True) ->
        w & playsound dedumS
            & cWorld . lWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ IsClose
    (_, _, _, False) -> w & cWorld . lWorld . 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 -> _itType itm == ct) (_crInv cr)
    _ -> False
  where
    cr = you w

senseDamage :: Int -> SensorType -> Machine -> World -> World
senseDamage threshold dt mc =
    (cWorld . lWorld . 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
        f = sensorTypeDamages dt
        x = sum . map _dmAmount $ filter f (_mcDamage mc)
    ni = fromIntegral (mc ^?! mcType . _McSensor . sensAmount) / fromIntegral threshold
    updatels = fromMaybe id $ do
        lsid <- mc ^? mcMounts . ix OTLightSource
        return $ cWorld . lWorld . lightSources . ix lsid . lsParam . lsCol .~ V3 ni ni ni

sensorTypeDamages :: SensorType -> Damage -> Bool
sensorTypeDamages = \case
    LaserSensor -> \case 
        Lasering{} -> True
        _ -> False
    ElectricSensor -> \case
        Electrical {} -> True
        _ -> False
    ThermalSensor -> \case
        Flaming {} -> True
        Sparking {} -> True
        Explosive {} -> True
        _ -> False
    PhysicalSensor -> \case
        Piercing {} -> True
        Blunt {} -> True
        Crushing {} -> True
        Explosive {} -> True
        _ -> False
    

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