This commit is contained in:
2025-10-24 13:08:44 +01:00
parent 27569ed8f3
commit 7b622c8e31
8 changed files with 6 additions and 28 deletions
+6 -8
View File
@@ -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)
@@ -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