29 lines
991 B
Haskell
29 lines
991 B
Haskell
module Dodge.LevelGen.Pathing
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Dodge.Zone
|
|
import Geometry
|
|
|
|
import Control.Lens
|
|
import Data.Maybe
|
|
import Data.List
|
|
import qualified Data.IntMap.Strict as IM
|
|
import Data.Graph.Inductive hiding ((&))
|
|
--import Data.Graph.Inductive.NodeMap
|
|
|
|
pairsToGraph :: (Ord a, Eq b) => (a -> a -> b) -> [(a,a)] -> Gr a b
|
|
pairsToGraph f pairs =
|
|
let nodes' = nub (map fst pairs ++ map snd pairs)
|
|
pairs' = map (\(x,y)->(x,y,f x y)) pairs
|
|
in undir $ run_ Data.Graph.Inductive.empty $ insMapNodesM nodes' >> insMapEdgesM pairs'
|
|
|
|
removePathsCrossing :: Point2 -> Point2 -> World -> World
|
|
removePathsCrossing a b w = set pathGraph newGraph $ set pathGraphP pg'
|
|
$ set pathPoints (foldr insertPoint IM.empty (labNodes newGraph))
|
|
w
|
|
where
|
|
pg' = filter (isNothing . uncurry (intersectSegSeg a b)) $ _pathGraphP w
|
|
insertPoint pp@(_,V2 x y) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
|
|
newGraph = pairsToGraph dist pg'
|