Add IntMapHelper, locate wall cutting bug
This commit is contained in:
@@ -38,24 +38,29 @@ removeInverseWalls ((a,b):ps)
|
||||
removeInverseWalls ps = ps
|
||||
-- | Cut out a polygon from a set of walls, and check for errors in the
|
||||
-- created walls.
|
||||
-- If created walls are not consistent, rotate and expand poly and retry.
|
||||
-- If created walls are not consistent, retry, rotating and expanding poly.
|
||||
cutWalls :: [Point2] -> [WallP] -> [WallP]
|
||||
cutWalls 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
|
||||
_ -> cutWallsRetry 0 ps wls
|
||||
-- _ -> wls
|
||||
-- _ -> error $ show ps
|
||||
where
|
||||
newWalls = cutWalls' ps wls
|
||||
-- | As 'cutWalls', but rotate in the other direction.
|
||||
cutWallsL :: [Point2] -> [WallP] -> [WallP]
|
||||
cutWallsL ps wls = case mapMaybe (`checkWallRight` newWalls) newWalls of
|
||||
newWalls = cutPoly ps wls
|
||||
cutWallsRetry :: Int -> [Point2] -> [WallP] -> [WallP]
|
||||
--cutWallsRetry 200 ps wls = error $ show ps ++ show wls
|
||||
cutWallsRetry i 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
|
||||
_ -> cutWallsRetry (i+1) ps wls
|
||||
-- _ -> wls
|
||||
-- _ -> error $ show ps
|
||||
where
|
||||
newWalls = cutWalls' ps wls
|
||||
newWalls = cutPoly ps' wls
|
||||
--ps' = map (rotateV a) $ expandPolyBy 0.1 ps
|
||||
ps' = map (rotateV a) $ expandPolyBy x ps
|
||||
x = fromIntegral i / 100
|
||||
a | even i = 0.001
|
||||
| otherwise = negate 0.001
|
||||
-- | Cut out a polygon from a set of walls, and check for errors in the
|
||||
-- created walls.
|
||||
-- Give error if created walls are not consistent.
|
||||
@@ -72,7 +77,7 @@ cutWalls'' ps wls = case mapMaybe (`checkWallRight` newWalls) newWalls of
|
||||
++ "\nWalls after cut:\n"
|
||||
++ unlines (map show newWalls)
|
||||
where
|
||||
newWalls = cutWalls' ps wls
|
||||
newWalls = cutPoly ps wls
|
||||
errsL = mapMaybe (`checkWallLeft` newWalls) newWalls
|
||||
-- | Given a specific wall and list of walls, checks that the number of walls leaving the
|
||||
-- second point is the same as the number of walls entering the second point of
|
||||
@@ -109,10 +114,10 @@ checkWallLeft (x,y) wls
|
||||
-- 5. remove any walls that ended up zero length after fusing
|
||||
-- 6. remove any duplicate walls
|
||||
-- Unclear behaviour if a line in the polygon is colinear with a wall.
|
||||
cutWalls' :: [Point2] -> [WallP] -> [WallP]
|
||||
cutWalls' qs wls =
|
||||
cutPoly :: [Point2] -> [WallP] -> [WallP]
|
||||
cutPoly qs wls =
|
||||
nub
|
||||
. filter (not.wallIsZeroLength)
|
||||
. filter (not . wallIsZeroLength)
|
||||
. fuseWallsWith zs
|
||||
. addPolyWalls rs
|
||||
-- . removeWallsInPolygon ps
|
||||
@@ -131,6 +136,7 @@ expandPolyBy x ps = map f ps
|
||||
where
|
||||
cp = 1/fromIntegral (length ps) *.* foldr (+.+) (0,0) ps
|
||||
f p = p +.+ x *.* (p -.- cp)
|
||||
--f p = p +.+ x *.* normalizeV (p -.- cp)
|
||||
-- | Given a polygon expressed as a list of points and a collection of walls,
|
||||
-- returns:
|
||||
-- fst: points of the polygon's intersection with walls
|
||||
@@ -223,3 +229,29 @@ removeWallsInPolygon :: [Point2] -> [WallP] -> [WallP]
|
||||
removeWallsInPolygon ps = filter (not . cond)
|
||||
where
|
||||
cond wall = pointInOrOnPolygon (0.5 *.* uncurry (+.+) wall) ps
|
||||
|
||||
brokenWalls :: [(Point2,Point2)]
|
||||
brokenWalls =
|
||||
[((330.12192,3032.2456),(190.52365,2995.8352)),((190.52365,2995.8352),(203.94716,2945.9377)),((214.33855,2907.311),(230.12193,2859.0405)),((230.12193,2859.0405),(366.7245,2895.643)),((366.7245,2895.643),(330.12192,3032.2456)),((366.7245,2895.643),(230.12193,2859.0405)),((230.12193,2859.0405),(266.7245,2722.438)),((266.7245,2722.438),(403.32703,2759.0405)),((403.32703,2759.0405),(503.32703,2932.2456)),((466.72446,3068.8481),(330.12192,3032.2456)),((330.12192,3032.2456),(366.7245,2895.643)),((503.32703,2932.2456),(466.72446,3068.8481)),((203.94716,2945.9377),(145.99155,2930.4084)),((156.38292,2891.7817),(214.33855,2907.311)),((107.47222,2920.979),(34.06077,2901.2295)),((34.06077,2901.2295),(52.571453,2832.4224)),((70.17772,2796.55),(174.45558,2824.6025)),((174.45558,2824.6025),(156.38292,2891.7817)),((100.76944,2955.4202),(107.47222,2920.979)),((145.99155,2930.4084),(140.79587,2949.722)),((52.571453,2832.4224),(35.882084,2827.9504)),((31.745949,2785.4312),(70.17772,2796.55)),((88.14497,3002.5354),(100.76944,2955.4202)),((140.79587,2949.722),(120.21855,3027.0303)),((35.882084,2827.9504),(-22.07344,2812.4214)),((-31.039248,2768.608),(31.745949,2785.4312)),((-261.32483,3408.5737),(-303.9881,3451.237)),((-303.9881,3451.237),(-332.27234,3422.9526)),((-332.27234,3422.9526),(-289.84595,3380.5264)),((-261.56174,3352.242),(88.14497,3002.5354)),((120.21855,3027.0303),(-233.27742,3380.5264)),((-289.84595,3380.5264),(-332.2724,3338.0999)),((-332.2724,3338.0999),(-303.9881,3309.8157)),((-303.9881,3309.8157),(-261.56174,3352.242)),((-22.07344,2812.4214),(-89.68823,2794.304)),((-79.335526,2755.667),(-31.039248,2768.608)),((-210.16953,3456.4133),(-261.32483,3408.5737)),((-233.27742,3380.5264),(-194.64026,3419.1633)),((-128.32533,2783.9514),(-200.79468,3054.4106)),((-200.79468,3054.4106),(-780.35016,2899.1191)),((-780.35016,2899.1191),(-625.05865,2319.5635)),((-625.05865,2319.5635),(-45.503174,2474.855)),((-45.503174,2474.855),(-117.97253,2745.3142)),((-89.68823,2794.304),(-128.32533,2783.9514)),((-117.97253,2745.3142),(-79.335526,2755.667)),((-178.49438,3590.2566),(-241.50847,3573.372)),((-241.50847,3573.372),(-210.16953,3456.4133)),((-194.64026,3419.1633),(-136.80266,3434.6611)),((-98.165634,3445.014),(-139.85736,3600.6094)),((-92.98925,3425.6953),(-98.165634,3445.014)),((-136.80266,3434.6611),(-127.74397,3400.8535)),((-187.553,3624.064),(-178.49438,3590.2566)),((-139.85736,3600.6094),(-148.91603,3634.4167)),((-127.74397,3400.8535),(-111.20285,3339.121)),((-78.55679,3371.8325),(-92.98925,3425.6953)),((-349.5008,4383.0093),(-388.13782,4372.6563)),((-388.13782,4372.6563),(-485.18823,3653.0168)),((-485.18823,3653.0168),(-477.42368,3624.039)),((-477.42368,3624.039),(-206.96445,3696.5085)),((-168.32744,3706.861),(102.131805,3779.3306)),((102.131805,3779.3306),(94.36725,3808.308)),((94.36725,3808.308),(-349.5008,4383.0093)),((-206.96445,3696.5085),(-187.553,3624.064)),((-148.91603,3634.4167),(-168.32744,3706.861)),((299.35522,3346.2668),(97.2383,3547.9797)),((97.2383,3547.9797),(-78.55679,3371.8325)),((-111.20285,3339.121),(116.74672,3110.6904)),((116.74672,3110.6904),(320.08704,3314.438)),((352.084,3395.578),(299.35522,3346.2668)),((320.08704,3314.438),(367.6133,3358.328)),((495.06226,3666.979),(293.8115,3613.054)),((293.8115,3613.054),(352.084,3395.578)),((367.6133,3358.328),(563.6875,3410.866)),((563.6875,3410.866),(495.06226,3666.979))]
|
||||
|
||||
intersectingBrokenWalls :: [(Point2,Point2)]
|
||||
intersectingBrokenWalls = filter (\(a,b) -> test a b) brokenWalls
|
||||
where
|
||||
polyPairs = zip brokenPoly (tail brokenPoly ++ [head brokenPoly])
|
||||
test a b = any (isJust . uncurry (myIntersectSegSeg a b)) polyPairs
|
||||
|
||||
brokenPoly :: [Point2]
|
||||
brokenPoly = [(434.66675,2833.3225),(503.9488,2793.3225),(523.9488,2827.9636),(454.66675,2867.9636)]
|
||||
|
||||
iBWall :: (Point2,Point2)
|
||||
iBWall = ((403.32703,2759.0405),(503.32703,2932.2456))
|
||||
|
||||
expandToSquare :: (Point2,Point2) -> [(Point2,Point2)]
|
||||
expandToSquare (a,b) = [(a,b),(b,c),(c,d),(d,a)]
|
||||
where
|
||||
v = a -.- b
|
||||
c = b +.+ vNormal v
|
||||
d = a +.+ vNormal v
|
||||
|
||||
minWalls :: [(Point2,Point2)]
|
||||
minWalls = expandToSquare iBWall
|
||||
|
||||
Reference in New Issue
Block a user