diff --git a/src/Dodge/Block/Debris.hs b/src/Dodge/Block/Debris.hs index 56d3f6c24..8982d37ac 100644 --- a/src/Dodge/Block/Debris.hs +++ b/src/Dodge/Block/Debris.hs @@ -24,17 +24,14 @@ import RandomHelp import Shape makeDoorDebris :: Door -> World -> World ---makeDoorDebris dr w = w & makeDebris mt col p makeDoorDebris dr w = w & makeDebris mt p where p2a = lerpP2A (dr ^. drZeroPos) (dr ^. drOnePos) (dr ^. drLerp) p = centroid . fmap fst $ (dr ^. drFootPrint) & each . each %~ shiftPointBy p2a - --(mt, col) = fromMaybe (Stone, greyN 0.5) $ do mt = fromMaybe Stone $ do wlids <- w ^? cWorld . lWorld . doors . ix (_drID dr) . drFootPrint ((wlid,_),_) <- IM.minViewWithKey wlids wl <- w ^? cWorld . lWorld . walls . ix wlid - --return (_wlMaterial wl, _wlColor wl) return $ wl ^. wlMaterial makeBlockDebris :: Block -> World -> World diff --git a/src/Dodge/Data/Block.hs b/src/Dodge/Data/Block.hs index 8509ea16c..202e09f8e 100644 --- a/src/Dodge/Data/Block.hs +++ b/src/Dodge/Data/Block.hs @@ -26,7 +26,6 @@ data Block = Block , _blPos :: Point2 , _blDir :: Float , _blHeight :: Float - , _blMaterial :: Material , _blDraw :: BlockDraw } deriving (Eq, Ord, Show, Read) --Generic, Flat) diff --git a/src/Dodge/Data/Wall.hs b/src/Dodge/Data/Wall.hs index 81d1b0f81..e53803011 100644 --- a/src/Dodge/Data/Wall.hs +++ b/src/Dodge/Data/Wall.hs @@ -18,7 +18,6 @@ import qualified Data.Set as S data Wall = Wall { _wlLine :: (Point2, Point2) , _wlID :: Int --- , _wlColor :: Color , _wlOpacity :: Opacity , _wlPathFlag :: S.Set WallFlag , _wlTouchThrough :: Bool diff --git a/src/Dodge/Default/Block.hs b/src/Dodge/Default/Block.hs index a57f6e433..8a9015f1d 100644 --- a/src/Dodge/Default/Block.hs +++ b/src/Dodge/Default/Block.hs @@ -13,7 +13,6 @@ defaultBlock = Block , _blDir = 0 , _blDraw = BlockDrawMempty , _blHeight = 100 - , _blMaterial = Stone } defaultDirtBlock :: Block defaultDirtBlock = defaultBlock & blHP .~ 50 diff --git a/src/Dodge/Placement/Instance/Block.hs b/src/Dodge/Placement/Instance/Block.hs index 2bed01fda..87ac9ec43 100644 --- a/src/Dodge/Placement/Instance/Block.hs +++ b/src/Dodge/Placement/Instance/Block.hs @@ -14,7 +14,6 @@ decoratedBlock decf mat col h ps = PutBlock bl wl $ reverse ps defaultBlock & blDraw .~ BlockDraws [BlockDrawColHeightPoss col h ps, BlockDrawBlSh decf] & blHeight .~ h - & blMaterial .~ mat wl = defaultWall & wlRotateTo .~ False diff --git a/src/Dodge/Placement/PlaceSpot/Block.hs b/src/Dodge/Placement/PlaceSpot/Block.hs index ebaaba649..01d1cb93e 100644 --- a/src/Dodge/Placement/PlaceSpot/Block.hs +++ b/src/Dodge/Placement/PlaceSpot/Block.hs @@ -33,7 +33,7 @@ plBlock (p : ps) bl wl w = , _blShadows = [] , _blFootprint = p : ps } - & gwWorld %~ insertWalls blid wls + & gwWorld %~ insertWalls wls where blid = IM.newKey $ w ^. gwWorld . cWorld . lWorld . blocks lns = zip (p : ps) (ps ++ [p]) @@ -58,8 +58,7 @@ plLineBlock :: (Int, GenWorld) plLineBlock basePane blwidth a b gw = ( 0 - , -- , foldr insertWall (insertBlocks gw) listWalls - over gwWorld insertBlocks gw + , over gwWorld insertBlocks gw ) where depth = blwidth @@ -74,7 +73,7 @@ plLineBlock basePane blwidth a b gw = wlid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . walls blid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . blocks insertBlock (i, p) = - insertWalls (i + blid) (makeWallAt p i) + insertWalls (makeWallAt p i) . over (cWorld . lWorld . blocks) ( IM.insert @@ -86,7 +85,6 @@ plLineBlock basePane blwidth a b gw = , _blShadows = shadowsAt i , _blDir = 0 -- THIS IS NOT SENSIBLE. TODO rethink block positioning , _blFootprint = cornersAt p -- TODO check winding (clockwise, anticlockwise) - , _blMaterial = _wlMaterial basePane , _blHeight = 100 , _blPos = p , _blDraw = BlockDrawMempty @@ -112,11 +110,11 @@ plLineBlock basePane blwidth a b gw = } -- | Must be done after inserting the block -insertWalls :: Int -> [Wall] -> World -> World -insertWalls _ wls w = foldl' (flip insertWall) w wls +insertWalls :: [Wall] -> World -> World +insertWalls wls w = foldl' (flip insertWall) w wls insertWall :: Wall -> World -> World insertWall wl = - uncurry (obstructPathsCrossing (S.fromList [WallObstacle WallNotAutoOpen, WallObstacle WallBlockVisibility])) + uncurry (obstructPathsCrossing (S.map WallObstacle $ wl ^. wlPathFlag)) (_wlLine wl) . (cWorld . lWorld . walls . at (_wlID wl) ?~ wl) diff --git a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs index 9b6cff5b6..c45b9409c 100644 --- a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs +++ b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs @@ -59,7 +59,6 @@ addDoorWall eo drid wl w (wlid, wlps) = , _wlID = wlid , _wlStructure = DoorPart drid } --- & cWorld . lWorld . doors . ix drid . drObstructs <>~ es where w' = uncurry (obstructPathsCrossing eo) wlps w diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 0f4323c9a..47fd3c3ac 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -307,18 +307,6 @@ updateAimPos u = u & uvWorld . cWorld . lWorld . lAimPos .~ mouseWorldPos (u ^. uvWorld . input) (u ^. uvWorld . wCam) ---updateEdgesWall :: S.Set (Int,Int) -> World -> World ---updateEdgesWall = flip $ foldl' updateEdgeWallObs --- ---updateEdgeWallObs :: World -> (Int,Int) -> World ---updateEdgeWallObs w (i,j) = fromMaybe w $ do --- s <- getNodePos i w --- e <- getNodePos j w --- let wlflags = foldMap (^. _2 . wlPathFlag) $ wlsHitUnsorted s e w --- return $ w & cWorld . incGraph %~ updateEdge (f wlflags) (i,j) --- where --- f x _ = S.map WallObstacle x - updateDoors :: World -> World updateDoors w = uncurry updateEdgesWall $ foldrM updateDoor w (w ^. cWorld . lWorld . doors)