Tweak wall cutting
This commit is contained in:
+1
-1
@@ -38,7 +38,7 @@ roomTreex :: RandomGen g => State g (Maybe [Room])
|
|||||||
roomTreex = do
|
roomTreex = do
|
||||||
struct' <- aTreeStrut
|
struct' <- aTreeStrut
|
||||||
-- let struct = treeFromPost [[SpecificRoom $ fmap (pure . Right) pistolerRoom]] [EndRoom]
|
-- let struct = treeFromPost [[SpecificRoom $ fmap (pure . Right) pistolerRoom]] [EndRoom]
|
||||||
let struct = treeFromPost [[SpecificRoom $ fmap (pure . Right) testRoom]] [EndRoom]
|
let struct = treeFromPost [[Corridor,SpecificRoom $ fmap (pure . Right) testRoom]] [EndRoom]
|
||||||
let t' = padCorridors struct
|
let t' = padCorridors struct
|
||||||
t = treeFromTrunk
|
t = treeFromTrunk
|
||||||
[[StartRoom]
|
[[StartRoom]
|
||||||
|
|||||||
@@ -41,11 +41,22 @@ removeInverseWalls ps = ps
|
|||||||
|
|
||||||
-- | Cut out a polygon from a set of walls, and check for errors in the
|
-- | Cut out a polygon from a set of walls, and check for errors in the
|
||||||
-- created walls.
|
-- created walls.
|
||||||
-- If created walls are not consistent, expand poly and retry.
|
-- If created walls are not consistent, rotate and expand poly and retry.
|
||||||
cutWalls :: [Point2] -> [WallP] -> [WallP]
|
cutWalls :: [Point2] -> [WallP] -> [WallP]
|
||||||
cutWalls ps wls = case mapMaybe (`checkWallRight` newWalls) newWalls of
|
cutWalls ps wls = case mapMaybe (`checkWallRight` newWalls) newWalls of
|
||||||
[] -> newWalls
|
[] -> newWalls
|
||||||
_ -> cutWalls (expandPolyBy 0.01 ps) wls
|
-- _ -> cutWalls (expandPolyBy 100 ps) wls
|
||||||
|
-- _ -> cutWalls (expandPolyBy 0.01 ps) wls
|
||||||
|
_ -> cutWalls (map (rotateV 0.001) $ expandPolyBy 0.01 ps) wls
|
||||||
|
where
|
||||||
|
newWalls = cutWalls' ps wls
|
||||||
|
errsL = mapMaybe (`checkWallLeft` newWalls) newWalls
|
||||||
|
|
||||||
|
cutWallsL ps wls = case mapMaybe (`checkWallRight` newWalls) newWalls of
|
||||||
|
[] -> newWalls
|
||||||
|
-- _ -> cutWalls (expandPolyBy 100 ps) wls
|
||||||
|
-- _ -> cutWalls (expandPolyBy 0.01 ps) wls
|
||||||
|
_ -> cutWalls (map (rotateV (-0.001)) $ expandPolyBy 0.01 ps) wls
|
||||||
where
|
where
|
||||||
newWalls = cutWalls' ps wls
|
newWalls = cutWalls' ps wls
|
||||||
errsL = mapMaybe (`checkWallLeft` newWalls) newWalls
|
errsL = mapMaybe (`checkWallLeft` newWalls) newWalls
|
||||||
|
|||||||
Reference in New Issue
Block a user