diff --git a/src/Dodge/Block.hs b/src/Dodge/Block.hs index b62369b66..7baf21e5e 100644 --- a/src/Dodge/Block.hs +++ b/src/Dodge/Block.hs @@ -61,12 +61,21 @@ destroyDoor dr w = w & doors %~ IM.delete (_drID dr) & flip (foldr (wlDustAt awl)) (map (pos +.+) ps) & stopPushing (_drPushes dr) + & destroyMounts (_drMounts dr) where wlids = _drWallIDs dr awl = _walls w IM.! IS.findMin wlids pos = fst . _wlLine $ _walls w IM.! IS.findMin wlids ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w +destroyMounts :: [MountedObject] -> World -> World +destroyMounts mos w = foldr destroyMount w mos + +destroyMount :: MountedObject -> World -> World +destroyMount mo = case mo of + MountedLS lsid -> lightSources . at lsid .~ Nothing + MountedProp prid -> props . at prid .~ Nothing + stopPushing :: Maybe Int -> World -> World stopPushing mdrid w = fromMaybe w $ do drid <- mdrid diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index da28fb54d..8633216f8 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -1022,15 +1022,21 @@ data Door = Door , _drHP :: Int , _drDeath :: Door -> World -> World , _drSpeed :: Float - , _drSupport :: Support + , _drPushedBy :: PushSource , _drPushes :: Maybe Int + , _drMounts :: [MountedObject] } +data MountedObject + = MountedLS Int + | MountedProp Int + deriving (Eq,Ord,Show) + data DoorStatus = DoorOpen | DoorClosed | DoorHalfway | DoorInt Int deriving (Eq, Ord, Show) -data Support = SupportsItself - | SupportedBy Int - | Unsupported +data PushSource = PushesItself + | PushedBy Int + | NotPushed data ActionPlan = Inanimate diff --git a/src/Dodge/Default/Door.hs b/src/Dodge/Default/Door.hs index 51ae65477..7b77d41e2 100644 --- a/src/Dodge/Default/Door.hs +++ b/src/Dodge/Default/Door.hs @@ -14,7 +14,8 @@ defaultDoor = Door , _drHP = 10000 , _drDeath = const id , _drSpeed = 1 - , _drSupport = SupportsItself + , _drPushedBy = PushesItself , _drPushes = Nothing + , _drMounts = mempty } diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index 40ae64b01..1025dd26b 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -35,8 +35,8 @@ postGenerationProcessing :: World -> World postGenerationProcessing w = foldl' assignPushDoors w (_doors w) assignPushDoors :: World -> Door -> World -assignPushDoors w dr = case dr ^?! drSupport of - SupportedBy i -> w & doors . ix i . drPushes .~ Just (_drID dr) +assignPushDoors w dr = case dr ^?! drPushedBy of + PushedBy i -> w & doors . ix i . drPushes ?~ _drID dr _ -> w layoutLevelFromSeed :: Int -> Int -> IO (IM.IntMap Room,[ConvexPoly]) diff --git a/src/Dodge/Placement/Instance/Door.hs b/src/Dodge/Placement/Instance/Door.hs index 9e3e03f98..ef5baebbd 100644 --- a/src/Dodge/Placement/Instance/Door.hs +++ b/src/Dodge/Placement/Instance/Door.hs @@ -45,13 +45,13 @@ doorBetween pathing col cond soff pa pb speed g = case divideLine 40 pa pb of divideDoorPane :: Maybe Int -> Bool -> Color -> (World -> Bool) -> Float -> Float -> [(Point2,Point2)] -> (Placement -> Maybe Placement) -> Placement divideDoorPane mid pathing col cond soff speed ppairs g = case ppairs of - [p] -> ptCont (adoor p) $ g + [p] -> ptCont (adoor p) g (p:ps) -> ptCont (adoor p) $ \pl -> Just $ divideDoorPane (_plMID pl) pathing col cond soff speed ps g _ -> undefined where adoor (x,y) = PutSlideDr pathing col thedoor soff x y thedoor = defaultDoor & drSpeed .~ speed & drTrigger .~ cond - & drSupport .~ maybe SupportsItself SupportedBy mid + & drPushedBy .~ maybe PushesItself PushedBy mid putAutoDoor :: Point2 -> Point2 -> Placement putAutoDoor a b = PlacementUsingPos (addZ 0 a) diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index 1da87ef90..3d7081c0e 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -106,8 +106,12 @@ addButtonSlowDoor x h rm = do openDoorBound = reverse $ rectNSWE (h + 5) (h - 5) (3*x/2) (-x/2) belowH y = (sndV2 . fst) y < h - 40 aboveH y = (sndV2 . fst) y > h + 40 - amountedlight dr xoff = Just . moveLSThen (getdoorpos (fromJust $ _plMID dr)) - (V3 15 xoff 89) (aShape (V2 15 0) (V3 15 xoff 90)) . const . const + amountedlight dr xoff mpl = Just . moveLSThen (getdoorpos (fromJust $ _plMID dr)) + (V3 15 xoff 89) (aShape (V2 15 0) (V3 15 xoff 90)) + $ \plls plpr -> Just $ ptCont (PutWorldUpdate (const $ setmount dr plls plpr)) + $ const mpl + setmount pldr plls plpr = doors . ix (fromJust $ _plMID pldr) . drMounts .++~ + [MountedLS (fromJust $ _plMID plls), MountedProp (fromJust $ _plMID plpr)] -- TODO make the height of this light source and of other mounted lights -- be taken from a single consistent source butDoor = putLitButOnPos col