From 18ab89d3f25891ef4b9ab22db52f7de9b6a395d3 Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 24 Oct 2025 10:58:01 +0100 Subject: [PATCH] Cleanup --- src/Dodge/Block.hs | 58 +------------------- src/Dodge/Data/Block.hs | 1 - src/Dodge/Default/Block.hs | 1 - src/Dodge/Path.hs | 7 +-- src/Dodge/Placement/PlaceSpot.hs | 4 +- src/Dodge/Placement/PlaceSpot/Block.hs | 7 +-- src/Dodge/Placement/PlaceSpot/TriggerDoor.hs | 2 +- 7 files changed, 8 insertions(+), 72 deletions(-) diff --git a/src/Dodge/Block.hs b/src/Dodge/Block.hs index 2cf79f0d7..f52bfe69e 100644 --- a/src/Dodge/Block.hs +++ b/src/Dodge/Block.hs @@ -8,46 +8,13 @@ import Dodge.Zoning.Base import Geometry.Data import qualified Data.Set as S import Control.Lens -import Control.Monad ---import Data.Foldable ---import qualified Data.IntSet as IS -import Data.Maybe -import Dodge.Base.Collide import Dodge.Block.Debris import Dodge.Data.World ---import Dodge.Material.Sound -import Dodge.Path import Dodge.Wall.Delete -import Dodge.Wall.Zone ---import Dodge.WorldEvent.Sound -import Dodge.Zoning.Wall import qualified IntMapHelp as IM ---splinterBlock :: Block -> World -> World ---splinterBlock bl w = --- foldl' unshadowBlock w (_blShadows bl) -- foldr shiftTowardCen w (_blWallIDs bl) --- & soundOriginsIDsAt --- [MaterialSound bm 0, MaterialSound bm 1, MaterialSound bm 2] --- (weakenMatS bm) --- (_blPos bl) --- where --- bm = fromMaybe Stone $ do --- wlids <- w ^? cWorld . lWorld . blocks . ix (_blID bl) . blWallIDs --- (wlid, _) <- IS.minView wlids --- w ^? cWorld . lWorld . walls . ix wlid . wlMaterial - unshadowBlock :: World -> Int -> World -unshadowBlock w wlid = case w ^? cWorld . lWorld . walls . ix wlid of - Just wl -> - w - & cWorld . lWorld . walls . ix wlid . wlUnshadowed .~ True - & insertWallInZones (wl & wlUnshadowed .~ True) - Nothing -> w - ---checkBlockHP :: Block -> World -> World ---checkBlockHP bl --- | _blHP bl < 1 = destroyBlock bl --- | otherwise = id +unshadowBlock w wlid = w & cWorld . lWorld . walls . ix wlid . wlUnshadowed .~ True destroyBlock :: S.Set Int2 -> Block -> World -> (S.Set Int2,World) destroyBlock is bl w = @@ -55,32 +22,9 @@ destroyBlock is bl w = & flip (foldl' unshadowBlock) (_blShadows bl) & makeBlockDebris bl & deleteWallIDs wlids - & maybeClearPaths (_blObstructs bl) -- must happen after the walls are deleted & cWorld . lWorld . blocks %~ IM.delete (_blID bl)) where js = foldMap (S.fromList . uncurry (zoneOfSeg peZoneSize)) (loopPairs $ bl^.blFootprint) -- & muchWlDustAt awl (_blPos bl) -- & flip (foldl' $ flip (muchWlDustAt awl)) (map (pos +.+) ps) - wlids = _blWallIDs bl - --- awl = w ^?! cWorld . lWorld . walls . ix (IS.findMin wlids) --- pos = fst . _wlLine $ awl --- ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w - --- this does not handle eg doors blocking the path as well -maybeClearPaths :: [(Int, Int)] -> World -> World -maybeClearPaths ps w = foldl' maybeClearPath w ps - -maybeClearPath :: World -> (Int, Int) -> World -maybeClearPath w (i, j) = fromMaybe w $ do - x <- getNodePos i w - y <- getNodePos j w - guard $ null $ overlapSegWalls x y $ wlsNearSeg x y w - return $ w & cWorld . incGraph %~ updateEdge (S.intersection (S.singleton ChasmObstacle)) (i, j) - ----- | not . null $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w = ----- w ----- | otherwise = ----- w ----- & cWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles .~ mempty) . FGL.delEdge (x, y) diff --git a/src/Dodge/Data/Block.hs b/src/Dodge/Data/Block.hs index 121427fde..8509ea16c 100644 --- a/src/Dodge/Data/Block.hs +++ b/src/Dodge/Data/Block.hs @@ -28,7 +28,6 @@ data Block = Block , _blHeight :: Float , _blMaterial :: Material , _blDraw :: BlockDraw - , _blObstructs :: [(Int,Int)] } deriving (Eq, Ord, Show, Read) --Generic, Flat) diff --git a/src/Dodge/Default/Block.hs b/src/Dodge/Default/Block.hs index 88d8a9ec2..a57f6e433 100644 --- a/src/Dodge/Default/Block.hs +++ b/src/Dodge/Default/Block.hs @@ -14,7 +14,6 @@ defaultBlock = Block , _blDraw = BlockDrawMempty , _blHeight = 100 , _blMaterial = Stone - , _blObstructs = mempty } defaultDirtBlock :: Block defaultDirtBlock = defaultBlock & blHP .~ 50 diff --git a/src/Dodge/Path.hs b/src/Dodge/Path.hs index 7afe9565f..af3b60fd3 100644 --- a/src/Dodge/Path.hs +++ b/src/Dodge/Path.hs @@ -134,11 +134,8 @@ obstructPathsCrossing :: Point2 -> Point2 -> World -> - (World, [(Int,Int)]) -obstructPathsCrossing obs s e w = - ( w & cWorld . incGraph %~ updateincedges - , inces - ) + World +obstructPathsCrossing obs s e w = w & cWorld . incGraph %~ updateincedges where updateincedge = flip $ updateEdge (S.union obs) updateincedges gr = foldl' updateincedge gr inces diff --git a/src/Dodge/Placement/PlaceSpot.hs b/src/Dodge/Placement/PlaceSpot.hs index f1d241aed..f87cdee5e 100644 --- a/src/Dodge/Placement/PlaceSpot.hs +++ b/src/Dodge/Placement/PlaceSpot.hs @@ -165,7 +165,7 @@ placeChasm gw rid ps shiftps = & gwWorld %~ f where f w = foldl' g w (loopPairs shiftps) - g w (x, y) = fst $ obstructPathsCrossing (S.singleton ChasmObstacle) x y w + g w (x, y) = obstructPathsCrossing (S.singleton ChasmObstacle) x y w --evaluateRandPS -- :: Int -> State StdGen PSType -> PlacementSpot -> GenWorld -> (Int, GenWorld) @@ -185,7 +185,7 @@ placeWallPoly qs wl w = foldl' (addPane wl) w pairs addPane :: Wall -> World -> (Point2, Point2) -> World addPane wl w l = w & plNew (cWorld . lWorld . walls) wlID (wl & wlLine .~ l) - & fst . uncurry (obstructPathsCrossing (S.fromList [WallObstacle WallNotAutoOpen])) l + & uncurry (obstructPathsCrossing (S.fromList [WallObstacle WallNotAutoOpen])) l mvProp :: Point2 -> Float -> Prop -> Prop mvProp p a = (prRot +~ a) . (prPos %~ ((p +.+) . rotateV a)) diff --git a/src/Dodge/Placement/PlaceSpot/Block.hs b/src/Dodge/Placement/PlaceSpot/Block.hs index e8871e660..ebaaba649 100644 --- a/src/Dodge/Placement/PlaceSpot/Block.hs +++ b/src/Dodge/Placement/PlaceSpot/Block.hs @@ -86,7 +86,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) - , _blObstructs = mempty , _blMaterial = _wlMaterial basePane , _blHeight = 100 , _blPos = p @@ -114,11 +113,9 @@ plLineBlock basePane blwidth a b gw = -- | Must be done after inserting the block insertWalls :: Int -> [Wall] -> World -> World -insertWalls blid wls w = w' & cWorld . lWorld . blocks . ix blid . blObstructs .~ concat paths - where - (w', paths) = mapAccumR (flip insertWall) w wls +insertWalls _ wls w = foldl' (flip insertWall) w wls -insertWall :: Wall -> World -> (World, [(Int,Int)]) +insertWall :: Wall -> World -> World insertWall wl = uncurry (obstructPathsCrossing (S.fromList [WallObstacle WallNotAutoOpen, WallObstacle WallBlockVisibility])) (_wlLine wl) diff --git a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs index fff4ddde9..9619a857c 100644 --- a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs +++ b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs @@ -61,7 +61,7 @@ addDoorWall eo drid wl w (wlid, wlps) = } -- & cWorld . lWorld . doors . ix drid . drObstructs <>~ es where - (w', _) = uncurry (obstructPathsCrossing eo) wlps w + w' = uncurry (obstructPathsCrossing eo) wlps w updateDoorEdges :: EdgeObstacle -> [(Int,Int)] -> World -> World updateDoorEdges eo es w = foldl' (updateDoorEdge eo) w es