diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 981e1e38c..1344d56d5 100644 --- a/src/Dodge/Data.hs +++ b/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 diff --git a/src/Dodge/Data/Object.hs b/src/Dodge/Data/Object.hs new file mode 100644 index 000000000..546ac182e --- /dev/null +++ b/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) diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 747626992..476a2f95e 100644 --- a/src/Dodge/Default.hs +++ b/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 diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 686775721..ac24849d9 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -41,10 +41,10 @@ initialAnoTree :: Annotation initialAnoTree = OnwardList $ intersperse (AnTree corDoor) [ IntAnno $ AnTree . startRoom - , AnRoom $ tanksRoom [] [] <&> rmPmnts .~ [] - , AnRoom $ tanksRoom [] [] - , AnRoom $ roomCCrits 0 - , AnRoom $ return airlock0 +-- , AnRoom $ tanksRoom [] [] <&> rmPmnts .~ [] +-- , AnRoom $ tanksRoom [] [] +-- , AnRoom $ roomCCrits 0 +-- , AnRoom $ return airlock0 , AnRoom slowDoorRoom -- , AnRoom $ roomCCrits 10 -- , AnTree firstBreather diff --git a/src/Dodge/Machine/Destroy.hs b/src/Dodge/Machine/Destroy.hs new file mode 100644 index 000000000..026f6ce79 --- /dev/null +++ b/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 diff --git a/src/Dodge/Placement/Instance/Terminal.hs b/src/Dodge/Placement/Instance/Terminal.hs index 0663711c2..dee0d1d34 100644 --- a/src/Dodge/Placement/Instance/Terminal.hs +++ b/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 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index e3e263ef3..d82bf7400 100644 --- a/src/Dodge/Update.hs +++ b/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)) - . deleteWallIDs (_mcWallIDs mc) - . _mcDeath mc mc' + | otherwise = destroyMachine mc +-- (machines %~ IM.delete (_mcID mc)) +-- . deleteWallIDs (_mcWallIDs mc) +-- . _mcDeath mc mc' tmUpdate :: Terminal -> World -> World tmUpdate tm w = case w ^? terminals . ix (_tmID tm) . tmFutureLines . ix 0 of