Add distance test when checking for overlapping bound polygons

This commit is contained in:
jgk
2021-08-13 12:35:40 +02:00
parent 5829c66527
commit 501a1cea86
2 changed files with 3 additions and 5 deletions
+3 -4
View File
@@ -10,7 +10,6 @@ module Dodge.Layout.Tree.Shift
import Dodge.Room.Data
import Dodge.Room.Link
import Dodge.Layout.Tree.Polymorphic
import Geometry
import Geometry.ConvexPoly
--import Geometry.Data
@@ -21,7 +20,7 @@ import Data.Maybe (listToMaybe)
import Control.Lens hiding (Empty, (<|) , (|>))
{- | All: Depth first search of trees of rooms, produces a list of lists of rooms that are not clipping. -}
shiftRoomTreeSearchAll
:: [[Point2]] -- ^ Clipping bounds
:: [ConvexPoly] -- ^ Clipping bounds
-> Seq (Tree Room) -- ^ Rooms to be added
-> [[Room]]
shiftRoomTreeSearchAll _ Empty = [[]]
@@ -33,8 +32,8 @@ shiftRoomTreeSearchAll bs (Node r ts :<| ts')
where
convexBounds = map pointsToPoly $ _rmBound r
ls = init $ _rmLinks r
newBounds = _rmBound r ++ bs
roomIsClipping = or (polysOverlap <$> _rmBound r <*> bs)
newBounds = convexBounds ++ bs
roomIsClipping = or (convexPolysOverlap <$> convexBounds <*> bs)
rm l = r & rmLinks %~ delete l
f l = applyToRoot (shiftRoomToLink l)
{- |
-1
View File
@@ -3,7 +3,6 @@ module Geometry.LHS
, isRHS
) where
import Geometry.Data
import Geometry.Vector
-- | Test whether a point is on the LHS of a line.
-- Returns False if the line is of zero length.
isLHS