Move towards removing machine update field
This commit is contained in:
+1
-1
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user