module Dodge.LevelGen.Pathing
    where
import Geometry

import Control.Lens

import Dodge.Data
import Dodge.Base

import Data.Maybe
import Data.List

import qualified Data.IntMap as IM
import Data.Graph.Inductive hiding ((&))
import Data.Graph.Inductive.NodeMap

pairsToGraph :: (Ord a, Eq 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 pathGraph' pg'
                            $ set pathPoints (foldr insertPoint IM.empty (labNodes newGraph))
                            w
    where pg' = filter (not . isJust . uncurry (intersectSegSeg' a b)) $ _pathGraph' w
          insertPoint  pp@(_,(x,y)) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
          newGraph = pairsToGraph dist pg'