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'