Cleanup

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
+unshadowBlock w wlid = w & cWorld . lWorld . walls . ix wlid . wlUnshadowed .~ True
-    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
 
 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)

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)
 

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

src/Dodge/Path.hs

@@ -134,11 +134,8 @@ obstructPathsCrossing ::
     Point2 ->
     Point2 ->
     World ->
-    (World, [(Int,Int)])
+    World
-obstructPathsCrossing obs s e w =
+obstructPathsCrossing obs s e w = w & cWorld . incGraph %~ updateincedges
-    ( w & cWorld . incGraph %~ updateincedges
-    , inces
-    )
   where
     updateincedge = flip $ updateEdge (S.union obs) 
     updateincedges gr = foldl' updateincedge gr inces

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))

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
+insertWalls _ wls w = foldl' (flip insertWall) w wls
-  where
-    (w', paths) = mapAccumR (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)

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