Move machine destruction to external function

src/Dodge/Data.hs

@@ -15,6 +15,7 @@ module Dodge.Data
     , module Dodge.Data.LoadAction
     , module Dodge.Data.ForegroundShape
     , module Dodge.Data.Wall
+    , module Dodge.Data.Object
     , module Dodge.Data.Zoning
     , module Dodge.Data.Bounds
     , module Dodge.Combine.Data
@@ -40,6 +41,7 @@ import Dodge.Data.RadarBlip
 import Dodge.Data.Room
 import Dodge.Data.Flare
 import Dodge.Data.PathGraph
+import Dodge.Data.Object
 import Dodge.Data.Zoning
 import Dodge.Data.ForegroundShape
 import Dodge.Data.LoadAction
@@ -1022,7 +1024,6 @@ data Machine = Machine
     { _mcID     :: Int
     , _mcWallIDs    :: IS.IntSet
     , _mcUpdate :: Machine -> World -> World
-    , _mcDeath  :: Machine -> World -> World
     , _mcApplyDamage    :: [Damage] -> Machine -> World -> World
     , _mcDraw   :: Machine -> SPic
     , _mcPos    :: Point2
@@ -1033,8 +1034,9 @@ data Machine = Machine
     , _mcDamage :: [Damage]
     , _mcLSs    :: [Int]
     , _mcType   :: MachineType
+    , _mcMounts :: M.Map Object Int
     , _mcName   :: String
-    , _mcTermMID :: Maybe Int
+--    , _mcTermMID :: Maybe Int
     }
 data Sensor = NoSensor
     | SensorToggleAmount

src/Dodge/Data/Object.hs

@@ -0,0 +1,13 @@
+module Dodge.Data.Object where
+
+data Object
+    = ObTerminal
+    | ObCreature
+    | ObMachine
+    | ObWall
+    | ObDoor
+    | ObButton
+    | ObForegroundShape
+    | ObLightSource
+    | ObProp
+  deriving (Eq,Show,Ord,Read,Enum,Bounded)

src/Dodge/Default.hs

@@ -181,7 +181,6 @@ defaultMachine = Machine
     { _mcID = 0
     , _mcWallIDs = mempty
     , _mcUpdate = defaultMachineUpdate
-    , _mcDeath  = const id
     , _mcApplyDamage = \_ _ -> id
     , _mcDraw = const mempty
     , _mcColor = white
@@ -193,7 +192,7 @@ defaultMachine = Machine
     , _mcLSs = []
     , _mcType = StaticMachine
     , _mcName = ""
-    , _mcTermMID = Nothing
+    , _mcMounts = mempty
     }
 defaultMachineUpdate :: Machine -> World -> World
 defaultMachineUpdate mc

src/Dodge/Floor.hs

@@ -41,10 +41,10 @@ initialAnoTree :: Annotation
 initialAnoTree = OnwardList 
         $ intersperse (AnTree corDoor)
     [ IntAnno $ AnTree . startRoom
-    , AnRoom $ tanksRoom [] [] <&> rmPmnts .~ []
+--    , AnRoom $ tanksRoom [] [] <&> rmPmnts .~ []
-    , AnRoom $ tanksRoom [] []
+--    , AnRoom $ tanksRoom [] []
-    , AnRoom $ roomCCrits 0
+--    , AnRoom $ roomCCrits 0
-    , AnRoom $ return airlock0
+--    , AnRoom $ return airlock0
     , AnRoom slowDoorRoom
 --    , AnRoom $ roomCCrits 10
 --    , AnTree firstBreather

src/Dodge/Machine/Destroy.hs

@@ -0,0 +1,27 @@
+module Dodge.Machine.Destroy where
+import Dodge.Wall.Delete
+import Dodge.Data
+import Dodge.WorldEvent.Explosion
+import LensHelp
+
+import Data.Maybe
+import qualified Data.IntMap.Strict as IM
+
+destroyMachine :: Machine -> World -> World
+destroyMachine mc = (machines %~ IM.delete (_mcID mc))
+    . deleteWallIDs (_mcWallIDs mc)
+    . makeExplosionAt (_mcPos mc)
+    . mcKillTerm mc
+    . mcKillBut mc
+
+mcKillTerm :: Machine -> World -> World
+mcKillTerm mc w = fromMaybe w $ do
+    tmid <- mc ^? mcMounts . ix ObTerminal
+    tm <- w ^? terminals . ix tmid 
+    return $ w 
+        & _tmDeathEffect tm tm
+
+mcKillBut :: Machine -> World -> World
+mcKillBut mc w = fromMaybe w $ do
+    btid <- mc ^? mcMounts . ix ObButton
+    return $ w & buttons . at btid .~ Nothing

src/Dodge/Placement/Instance/Terminal.hs

@@ -13,7 +13,6 @@ import Dodge.Default
 import Dodge.Machine
 import Dodge.SoundLogic
 import Dodge.Terminal
-import Dodge.WorldEvent.Explosion
 import Color
 import Geometry
 import ShapePicture
@@ -33,27 +32,20 @@ putTerminal'' mc tm mcf = ps0PushPS (PutTerminal tm)
     $ \tmpl -> Just $ ps0PushPS (PutButton termButton)
     $ \btpl -> Just $ pt0 (PutMachine (reverse $ square 10)
         (mc & mcUpdate %~ (\fmu mc' -> mcf (fromJust $ _plMID btpl) mc' . fmu mc') . machineAddSound fridgeHumS
-            & mcDeath %~ (\fd mc' -> mcKillTerm mc' . (buttons . at (fromJust (_plMID btpl)) .~ Nothing) . fd mc')
+            & mcMounts . at ObButton ?~ fromJust (_plMID btpl)
         )       )
     $ \mcpl -> Just $ sps0 $ PutWorldUpdate $ const (setids tmpl btpl mcpl) 
   where
     setids tmpl btpl mcpl w = w
         & terminals . ix tmid . tmButtonID .~ btid
         & terminals . ix tmid . tmMachineID .~ mcid
-        & machines  . ix mcid . mcTermMID ?~ tmid
+        & machines  . ix mcid . mcMounts . at ObTerminal ?~ tmid
         & buttons   . ix btid . btTermMID ?~ tmid
       where
         tmid = fromJust (_plMID tmpl)
         btid = fromJust (_plMID btpl)
         mcid = fromJust (_plMID mcpl)
 
-mcKillTerm :: Machine -> World -> World
-mcKillTerm mc w = fromMaybe w $ do
-    tmid <- _mcTermMID mc
-    tm <- w ^? terminals . ix tmid 
-    return $ w 
-        & _tmDeathEffect tm tm
-
 putTerminal' 
     :: Color
     -> Terminal
@@ -72,7 +64,6 @@ putTerminal col f = putTerminal'' (mc & mcColor .~ col) f (\_ -> basicMachineUpd
     mc = defaultMachine
         { _mcDraw = terminalSPic
         , _mcHP = 100
-        , _mcDeath = makeExplosionAt . _mcPos
         }
 
 termButton :: Button

src/Dodge/Update.hs

@@ -12,8 +12,9 @@ import Dodge.CullBox
 --import Dodge.Block
 import Dodge.Distortion
 import Dodge.SoundLogic
-import Dodge.Wall.Delete
+--import Dodge.Wall.Delete
 import Dodge.Update.WallDamage
+import Dodge.Machine.Destroy
 --import Dodge.Menu
 import Dodge.Base
 import Dodge.Zone
@@ -127,9 +128,10 @@ updateWorldSelect w = f . g $ case (w ^? mouseButtons . ix ButtonLeft, w ^? mous
 mcChooseUpdate :: Machine -> Machine -> World -> World
 mcChooseUpdate mc mc'
     | _mcHP mc > 0  = _mcUpdate mc mc'
-    | otherwise     = (machines %~ IM.delete (_mcID mc))
+    | otherwise     = destroyMachine mc
-        . deleteWallIDs (_mcWallIDs mc)
+--        (machines %~ IM.delete (_mcID mc))
-        . _mcDeath mc mc'
+--        . deleteWallIDs (_mcWallIDs mc)
+--        . _mcDeath mc mc'
 
 tmUpdate :: Terminal -> World -> World
 tmUpdate tm w = case w ^? terminals . ix (_tmID tm) . tmFutureLines . ix 0 of