251 lines
8.9 KiB
Haskell
251 lines
8.9 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
|
|
module Dodge.Machine.Update (updateMachine) 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.Item.Display
|
|
import Dodge.Machine.Destroy
|
|
import Dodge.Movement.Turn
|
|
import Dodge.SoundLogic
|
|
import Dodge.Terminal
|
|
import Dodge.Terminal.Color
|
|
import Geometry
|
|
import LensHelp
|
|
|
|
updateMachine :: Machine -> World -> World
|
|
updateMachine mc
|
|
| _mcHP mc < 1 = destroyMachine mc
|
|
| otherwise =
|
|
mcApplyDamage (_mcDamage mc) mc
|
|
. mcPlaySound mc
|
|
. mcTypeUpdate mc (_mcType mc)
|
|
|
|
mcTypeUpdate :: Machine -> MachineType -> World -> World
|
|
mcTypeUpdate mc = \case
|
|
McStatic -> id
|
|
McTerminal -> terminalScreenGlow mc
|
|
McTurret tu -> updateTurret (_tuTurnSpeed tu) mc
|
|
McDamSensor se -> mcDamSensorTriggerUpdate se mc . mcDamSensorUpdate se mc
|
|
McProxSensor se -> mcProxSensorTriggerUpdate se mc . mcProxSensorUpdate 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 w = fromMaybe w $ do
|
|
tu <- mc ^? mcType . _McTurret
|
|
let i = tu ^. tuWeapon
|
|
it <- w ^? cWorld . lWorld . items . ix i
|
|
hit <- it ^? itType
|
|
guard (_tuFireTime tu > 0)
|
|
return $ mcUseHeld hit it mc w
|
|
|
|
mcDamSensorTriggerUpdate :: DamageSensor -> Machine -> World -> World
|
|
mcDamSensorTriggerUpdate se mc = fromMaybe id $ do
|
|
trid <- mc ^? mcMounts . ix OTTrigger
|
|
bval <- mcTriggerVal se
|
|
return $ cWorld . lWorld . triggers . ix trid ||~ bval
|
|
|
|
mcProxSensorTriggerUpdate :: ProximitySensor -> Machine -> World -> World
|
|
mcProxSensorTriggerUpdate se mc = fromMaybe id $ do
|
|
trid <- mc ^? mcMounts . ix OTTrigger
|
|
bval <- se ^? proxToggle . _Just
|
|
return $ cWorld . lWorld . triggers . at trid ?~ bval
|
|
|
|
mcTriggerVal :: DamageSensor -> Maybe Bool
|
|
mcTriggerVal se = Just $ _sensAmount se > _sensThreshold se
|
|
|
|
mcPlaySound :: Machine -> World -> World
|
|
mcPlaySound mc w = case _mcType mc of
|
|
McTerminal
|
|
| d < 100 ->
|
|
soundContinueVol
|
|
(1 -0.01 * d)
|
|
(MachineSound mid)
|
|
(_mcPos mc)
|
|
fridgeHumS
|
|
(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 . _McDamSensor of
|
|
Nothing -> mcpointer %~ ((mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds)))
|
|
_ -> mcpointer %~ (mcDamage .~ [])
|
|
where
|
|
mcpointer = cWorld . lWorld . machines . ix (_mcID mc)
|
|
|
|
mcDamSensorUpdate :: DamageSensor -> Machine -> World -> World
|
|
mcDamSensorUpdate se = senseDamage (_sensThreshold se) (_sensType se)
|
|
|
|
mcProxSensorUpdate :: ProximitySensor -> Machine -> World -> World
|
|
mcProxSensorUpdate se mc = case se ^. proxSensorType of
|
|
NoItemZone xs -> mcNoItemsTest mc xs
|
|
SensorWithRequirement pr -> mcProximitySensorUpdate mc se pr
|
|
|
|
mcNoItemsTest :: Machine -> [Point2] -> World -> World
|
|
mcNoItemsTest mc ps w
|
|
| t && (falsetog || notog) =
|
|
w & mcsenslens . proxToggle ?~ True
|
|
& playsound dedaS
|
|
& mctermlens . tmFutureLines .:~ makeTermLine "SENSOR SUCCESS: ZONE CLEAR"
|
|
| not t && (truetog || notog) =
|
|
w & mcsenslens . proxToggle ?~ False
|
|
& playsound dedumS
|
|
& mctermlens . tmFutureLines .:~ makeTermLine "SENSOR FAIL: ITEM IN ZONE"
|
|
| otherwise = w
|
|
where
|
|
truetog = mc ^? mcType . _McProxSensor . proxToggle . _Just == Just True
|
|
falsetog = mc ^? mcType . _McProxSensor . proxToggle . _Just == Just False
|
|
notog = null (mc ^? mcType . _McProxSensor . proxToggle . _Just)
|
|
&& pointInPoly (cr ^. crPos) qs
|
|
t = ((cr ^. crInv == mempty) || not (pointInPoly (cr ^. crPos) qs))
|
|
&& not (any ((`pointInPoly` qs) . _flItPos) (w ^. cWorld . lWorld . floorItems))
|
|
cr = w ^?! cWorld . lWorld . creatures . ix 0
|
|
mcsenslens = cWorld . lWorld . machines . ix (_mcID mc) . mcType . _McProxSensor
|
|
mctermlens = cWorld . lWorld . terminals . ix (mc ^?! mcMounts . ix OTTerminal)
|
|
playsound sid = soundContinue (MachineAltSound (_mcID mc)) (_mcPos mc) sid Nothing
|
|
qs = f ps
|
|
f = fmap ((+ _mcPos mc) . rotateV (_mcDir mc))
|
|
|
|
mcProximitySensorUpdate
|
|
:: Machine -> ProximitySensor -> ProximityRequirement -> World -> World
|
|
mcProximitySensorUpdate mc sens pr w
|
|
| truetog || dist (_crPos ycr) (_mcPos mc) > 40 = w
|
|
| mcProxTest w pr =
|
|
w
|
|
& mcsenslens . proxToggle ?~ True
|
|
& playsound dedaS
|
|
& mctermlens . tmFutureLines <>~
|
|
[makeTermLine "SENSOR SUCCESS, DEACTIVATED" ]
|
|
<> tlSetStatus (TerminalPressTo "QUIT")
|
|
<> tlDoEffect TmWdWdLeaveTerminal
|
|
| notog =
|
|
w & playsound dedumS
|
|
& mcsenslens . proxToggle ?~ False
|
|
& mctermlens . tmFutureLines
|
|
.:~ makeTermLine ( "SENSOR FAIL: REQUIRES " ++ sensorReqToString pr)
|
|
| otherwise = w
|
|
where
|
|
truetog = sens ^? proxToggle . _Just == Just True
|
|
notog = null (sens ^? proxToggle . _Just)
|
|
mctermlens = cWorld . lWorld . terminals . ix (mc ^?! mcMounts . ix OTTerminal)
|
|
mcsenslens = cWorld . lWorld . machines . ix (_mcID mc) . mcType . _McProxSensor
|
|
playsound sid = soundContinue (MachineAltSound (_mcID mc)) (_mcPos mc) sid Nothing
|
|
ycr = you w
|
|
|
|
sensorReqToString :: ProximityRequirement -> String
|
|
sensorReqToString = \case
|
|
RequireHealth x -> "HEALTH ABOVE " ++ show x
|
|
RequireEquipment x -> itemBaseName x
|
|
|
|
mcProxTest :: World -> ProximityRequirement -> Bool
|
|
mcProxTest w = \case
|
|
RequireHealth x -> _crHP cr >= x
|
|
RequireEquipment ct ->
|
|
any
|
|
(\itm -> _itType itm == ct)
|
|
((\k -> w ^?! cWorld . lWorld . items . ix k) <$> _crInv cr)
|
|
where
|
|
cr = you w
|
|
|
|
senseDamage :: Int -> SensorType -> Machine -> World -> World
|
|
senseDamage threshold dt mc =
|
|
(cWorld . lWorld . machines . ix mcid %~ upmc)
|
|
. updatels
|
|
where
|
|
upmc = mcType . _McDamSensor . 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 . _McDamSensor . 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
|