module Dodge.Path ( pointTowardsImpulse , makePathBetween , makePathBetweenPs , removePathsCrossing , pairsToGraph ) where import Dodge.Data import Dodge.Base.Collide import Dodge.Zone import Geometry.Data import Dodge.Base import Geometry import Control.Lens import Data.Maybe import Data.List import qualified Data.IntMap.Strict as IM import Data.Graph.Inductive hiding ((&)) import qualified Data.Set as S --import Data.Graph.Inductive.PatriciaTree --import Data.Graph.Inductive.Graph hiding ((&)) makePathBetween :: Point2 -> Point2 -> World -> Maybe [Int] makePathBetween a b w = do -- join $ sp <$> a' <*> b' <*> return (_pathGraph w) na <- walkableNodeNear a nb <- walkableNodeNear b sp na nb (_pathGraph w) where nodesNear p = concat $ lookLookups (zoneNearPointIP p) (_pathPoints w) walkableNodeNear p = fmap fst . find (flip (isWalkable p) w . snd) $ nodesNear p makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2] makePathBetweenPs a b w = mapMaybe (lab $ _pathGraph w) <$> makePathBetween a b w pointTowardsImpulse :: Point2 -> Point2 -> World -> Maybe Point2 pointTowardsImpulse a b w = find (flip (isWalkable a) w) =<< makePathBetweenPs a b w ------ continues a walk from a list of points, without repetitions ------ supposes that the list is non-empty --randomGraphWalk :: RandomGen g => [Int] -> Gr a b -> State g [Int] --randomGraphWalk (n:ns) g = do -- next' <- randomGraphStepRestricted n ns g -- case next' of -- Nothing -> return (n:ns) -- Just n' -> randomGraphWalk (n':n:ns) g --randomGraphWalk _ _ = error "Trying to walk in an empty list" -- --randomPointXStepsFrom :: Int -> Point2 -> World -> Point2 --randomPointXStepsFrom i p w = -- let g = _pathGraph w -- ns = labNodes g -- mp = listToMaybe $ sortBy (compare `on` dist p . snd) $ filter (flip (isWalkable p) w . snd) ns -- in case mp of -- Nothing -> p -- Just (n,_) -> fromJust -- $ lab g (last $ take i $ randomGraphWalk [n] g Data.Function.& evalState $ _randGen w) -- --randomPointsXStepsFrom :: Int -> Point2 -> World -> [Point2] --randomPointsXStepsFrom i p w = -- let g = _pathGraph w -- ns = labNodes g -- mp = listToMaybe $ sortBy (compare `on` dist p . snd) $ filter (flip (isWalkable p) w . snd) ns -- in case mp of -- Nothing -> [p] -- Just (n,_) -> mapMaybe (lab g) (take i $ randomGraphWalk [n] g Data.Function.& evalState $ _randGen w) -- --randomGraphStep :: RandomGen g => Int -> Gr a b -> State g (Maybe Int) --randomGraphStep n g = -- do let ns = neighbors g n -- i <- state $ randomR (0,length ns - 1) -- case ns of [] -> return Nothing -- _ -> return $ Just $ ns !! i --randomGraphStepRestricted :: RandomGen g => Int -> [Int] -> Gr a b -> State g (Maybe Int) --randomGraphStepRestricted n notns g = do -- let ns = neighbors g n \\ notns -- i <- state $ randomR (0,length ns - 1) -- case ns of -- [] -> return Nothing -- _ -> return $ Just $ ns !! i -- pairsToGraph :: (Ord a, Ord b) => (a -> a -> b) -> S.Set (a,a) -> Gr a b pairsToGraph f pairs = let nodes' = S.map fst pairs `S.union` S.map snd pairs pairs' = S.map (\(x,y)->(x,y,f x y)) pairs in undir $ run_ Data.Graph.Inductive.empty $ insMapNodesM (S.toList nodes') >> insMapEdgesM (S.toList pairs') removePathsCrossing :: Point2 -> Point2 -> World -> World removePathsCrossing a b w = w & pathGraph .~ newGraph & pathGraphP .~ pg' & pathPoints .~ foldr insertPoint IM.empty (labNodes newGraph) where pg' = S.filter (isNothing . uncurry (intersectSegSeg a b)) $ _pathGraphP w insertPoint pp@(_,p) = uncurryV insertInZoneWith (wallZoneOfPoint p) (++) [pp] newGraph = pairsToGraph dist pg'