59 lines
1.8 KiB
Haskell
59 lines
1.8 KiB
Haskell
module Dodge.Room.Path (
|
|
gridPoints,
|
|
linksAndPath,
|
|
linksAndPath',
|
|
makeGrid,
|
|
createPathGrid,
|
|
gridPoints'',
|
|
) where
|
|
|
|
import qualified Control.Foldl as L
|
|
import Data.Function (on)
|
|
import Data.List
|
|
import Data.Maybe
|
|
import qualified Data.Set as S
|
|
import Dodge.Data.GenWorld
|
|
import Dodge.LevelGen.StaticWalls
|
|
import Dodge.RoomLink
|
|
import Geometry
|
|
import Grid
|
|
|
|
createPathGrid :: Room -> Room
|
|
createPathGrid rm =
|
|
rm
|
|
{ _rmPath = linksAndPath (map lnkPosDir $ _rmLinks rm) filterGrid
|
|
}
|
|
where
|
|
filterGrid = filter (\p -> pairInPolys (_rmPolys rm) p && testCrossWalls outerWalls p) grid
|
|
grid = fromMaybe [] $ shiftedGrid <$> minx <*> maxx <*> miny <*> maxy
|
|
outerWalls = foldr cutPoly [] $ _rmPolys rm
|
|
outerPoints = map fst outerWalls
|
|
(minx, maxx, miny, maxy) = L.fold theFold outerPoints
|
|
theFold =
|
|
(,,,)
|
|
<$> L.premap fstV2 L.minimum
|
|
<*> L.premap fstV2 L.maximum
|
|
<*> L.premap sndV2 L.minimum
|
|
<*> L.premap sndV2 L.maximum
|
|
|
|
linksAndPath :: [(Point2, Float)] -> [(Point2, Point2)] -> S.Set (Point2, Point2)
|
|
linksAndPath lnks subpth = S.fromList subpth <> foldMap linkClosest lnks
|
|
where
|
|
linkClosest (p, _) = doublePairSet (p, minimumBy (compare `on` dist p) $ map fst subpth)
|
|
|
|
linksAndPath' :: [RoomLink] -> [(Point2, Point2)] -> S.Set (Point2, Point2)
|
|
linksAndPath' = linksAndPath . map lnkPosDir
|
|
|
|
testCrossWalls ::
|
|
[(Point2, Point2)] ->
|
|
(Point2, Point2) ->
|
|
Bool
|
|
testCrossWalls wls (a, b) = not $ any (isJust . uncurry (intersectSegSeg a b)) wls
|
|
|
|
--extra test whether both members of the path edge are in some poly
|
|
pairInPolys ::
|
|
[[Point2]] ->
|
|
(Point2, Point2) ->
|
|
Bool
|
|
pairInPolys polys (a, b) = any (pointInPolygon a) polys && any (pointInPolygon b) polys
|