Cleanup

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

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)

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

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

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

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)

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
 

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)