58 lines
1.9 KiB
Haskell
58 lines
1.9 KiB
Haskell
module Dodge.Machine.Destroy where
|
|
|
|
import Geometry.Vector3D
|
|
import Dodge.FloorItem
|
|
import Data.Maybe
|
|
import Dodge.Data.World
|
|
import Dodge.Wall.Delete
|
|
import Dodge.WorldEffect
|
|
import Dodge.WorldEvent.Explosion
|
|
import qualified IntMapHelp as IM
|
|
import LensHelp
|
|
|
|
destroyMachine :: Machine -> World -> World
|
|
destroyMachine mc =
|
|
(cWorld . lWorld . machines %~ IM.delete (_mcID mc))
|
|
. deleteWallIDs (IM.keysSet $ _mcFootPrint mc)
|
|
. makeMachineDebris mc
|
|
. makeSmallExplosionAt (_mcPos mc `v2z` 20) 0
|
|
. mcKillTerm mc
|
|
. mcKillBut mc
|
|
. destroyMcType (mc ^. mcType) mc
|
|
|
|
--explodeMachine :: Machine -> MachineType -> World -> World
|
|
--explodeMachine mc = \case
|
|
|
|
makeMachineDebris :: Machine -> World -> World
|
|
makeMachineDebris _ = id -- foldl' (flip $ makeDebris mt) w ps
|
|
--makeMachineDebris mc = id -- foldl' (flip $ makeDebris mt) w ps
|
|
-- where
|
|
-- dsize = debrisSize mt
|
|
-- ps = gridInPolygon dsize $ shrinkPolyOnEdges dsize $ reverse (_mcFootprint bl)
|
|
-- mt = fromMaybe Stone $ do
|
|
-- wlids <- w ^? cWorld . lWorld . blocks . ix (_blID bl) . blWallIDs
|
|
-- (wlid, _) <- IS.minView wlids
|
|
-- wl <- w ^? cWorld . lWorld . walls . ix wlid
|
|
-- return $ _wlMaterial wl
|
|
|
|
destroyMcType :: MachineType -> Machine -> World -> World
|
|
destroyMcType mt mc w = case mt of
|
|
McTurret tu _ -> fromMaybe w $ do
|
|
itm <- w ^? cWorld . lWorld . items . ix (tu ^. tuWeapon)
|
|
return $ copyItemToFloor (_mcPos mc) itm w
|
|
McTrigger i -> w & cWorld . lWorld . triggers . ix i %~ not
|
|
_ -> w
|
|
|
|
mcKillTerm :: Machine -> World -> World
|
|
mcKillTerm mc w = fromMaybe w $ do
|
|
tmid <- mc ^? mcMounts . ix OTTerminal
|
|
tm <- w ^? cWorld . lWorld . terminals . ix tmid
|
|
return $
|
|
w
|
|
& doTmWdWd (_tmDeathEffect tm) tm
|
|
|
|
mcKillBut :: Machine -> World -> World
|
|
mcKillBut mc w = fromMaybe w $ do
|
|
btid <- mc ^? mcMounts . ix OTButton
|
|
return $ w & cWorld . lWorld . buttons . at btid .~ Nothing
|