Files
loop/src/Dodge/Machine/Update.hs
T

175 lines
6.2 KiB
Haskell

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 ObTerminal
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 .~ [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 . 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)
mcUseItem :: Machine -> World -> World
mcUseItem mc = fromMaybe id $ do
tu <- mc ^? mcType . _McTurret
let it = tu ^. tuWeapon
hit <- it ^? itType . 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 . 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 -> DamageType -> 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
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 . lWorld . 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