diff --git a/src/Dodge/Block.hs b/src/Dodge/Block.hs index e591c5fc7..b62369b66 100644 --- a/src/Dodge/Block.hs +++ b/src/Dodge/Block.hs @@ -60,8 +60,16 @@ destroyDoor dr w = w & deleteWallIDs wlids & doors %~ IM.delete (_drID dr) & flip (foldr (wlDustAt awl)) (map (pos +.+) ps) + & stopPushing (_drPushes 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 + +stopPushing :: Maybe Int -> World -> World +stopPushing mdrid w = fromMaybe w $ do + drid <- mdrid + dr <- w ^? doors . ix drid + return $ w & doors . ix drid . drMech .~ const id + & stopPushing (_drPushes dr) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 77f6267db..da28fb54d 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -169,6 +169,7 @@ data World = World , _testFloat :: Float } + newtype GenParams = GenParams { _sensorCoding :: M.Map DamageType (PaletteColor,DecorationShape) } diff --git a/src/Dodge/Data/ForegroundShape.hs b/src/Dodge/Data/ForegroundShape.hs index a95fcc380..c64e538bd 100644 --- a/src/Dodge/Data/ForegroundShape.hs +++ b/src/Dodge/Data/ForegroundShape.hs @@ -8,8 +8,8 @@ import Control.Lens data ForegroundShape = ForegroundShape { _fsID :: Int , _fsPos :: Point2 - , _fsRot :: Float - , _fsPic :: SPic + , _fsDir :: Float + , _fsSPic :: SPic } deriving (Eq,Show,Ord) makeLenses ''ForegroundShape diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index bcb45932c..40ae64b01 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -12,6 +12,7 @@ import Dodge.Tree import Geometry.ConvexPoly --import Dodge.LevelGen.LevelStructure +import Data.Foldable import System.Directory import System.Random import Control.Lens @@ -26,9 +27,18 @@ generateWorldFromSeed i = do writeFile "log/aGeneratedRoomLayout" "" (roomList,bounds) <- layoutLevelFromSeed 0 i return $ saveLevelStartSlot + $ postGenerationProcessing $ generateLevelFromRoomList roomList initialWorld{_randGen=mkStdGen i} & roomClipping .~ bounds +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) + _ -> w + layoutLevelFromSeed :: Int -> Int -> IO (IM.IntMap Room,[ConvexPoly]) layoutLevelFromSeed i seed = do let i' = i + 1 diff --git a/src/Dodge/Placement/Instance/Door.hs b/src/Dodge/Placement/Instance/Door.hs index 642d24523..9e3e03f98 100644 --- a/src/Dodge/Placement/Instance/Door.hs +++ b/src/Dodge/Placement/Instance/Door.hs @@ -13,7 +13,6 @@ import Dodge.LevelGen.Data import Dodge.Creature.Test import Dodge.LevelGen.Switch -import Data.Maybe import Control.Lens import qualified Data.IntMap.Strict as IM @@ -52,7 +51,7 @@ divideDoorPane mid pathing col cond soff speed ppairs g = case ppairs of where adoor (x,y) = PutSlideDr pathing col thedoor soff x y thedoor = defaultDoor & drSpeed .~ speed & drTrigger .~ cond - & drSupport .~ SupportedBy (fromJust mid) + & drSupport .~ maybe SupportsItself SupportedBy mid putAutoDoor :: Point2 -> Point2 -> Placement putAutoDoor a b = PlacementUsingPos (addZ 0 a) diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index d21005aca..22aafb689 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -34,6 +34,7 @@ worldSPic cfig w = (extraShapes w, extraPics cfig w) <> foldMap (dbArg _prDraw) (filtOn _prPos _props) <> foldMap (shiftDraw _blPos _blDir _blDraw) (filtOn _blPos _blocks) + <> foldMap (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _shapes) <> foldMap (dbArg _cpPict) (filtOn _cpPos _corpses) <> foldMap ((($ w) . ($ cfig)) . dbArg _crPict) (filtOn _crPos _creatures) <> foldMap floorItemSPic (filtOn _flItPos _floorItems)