From ad33ddd569fe41b6b0088291af46ada90ae479ab Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 14 Jul 2022 19:56:37 +0100 Subject: [PATCH] Move towards removing machine update field --- src/Dodge/Data.hs | 2 +- src/Dodge/Default.hs | 2 +- src/Dodge/Machine/Update.hs | 169 ++++++++++++++++++++++++++++++++++++ 3 files changed, 171 insertions(+), 2 deletions(-) create mode 100644 src/Dodge/Machine/Update.hs diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 1344d56d5..751f11cf9 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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 diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 476a2f95e..105dc0911 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -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 diff --git a/src/Dodge/Machine/Update.hs b/src/Dodge/Machine/Update.hs new file mode 100644 index 000000000..ca7de4889 --- /dev/null +++ b/src/Dodge/Machine/Update.hs @@ -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 +