diff --git a/src/Dodge/Path.hs b/src/Dodge/Path.hs index d924a248d..fc2a3aa40 100644 --- a/src/Dodge/Path.hs +++ b/src/Dodge/Path.hs @@ -26,8 +26,7 @@ import Dodge.Data.World import Dodge.Zoning.Base import Dodge.Zoning.Pathing import Geometry -import qualified Streaming.Prelude as S -import StreamingHelp +import Data.Bifunctor getNodePos :: Int -> World -> Maybe Point2 getNodePos i w = _pathGraph (_cWorld w) `lab` i @@ -48,7 +47,6 @@ walkableNodeNear :: World -> Point2 -> Maybe Int {-# INLINE walkableNodeNear #-} walkableNodeNear w p = fmap fst . find (flip (isWalkable p) w . snd) $ nodesNear where - --nodesNear = runIdentity . S.toList_ $ nearPoint _pnZoning p w nodesNear = zonesExtract (w ^. cWorld . pnZoning) $ zonesAroundPoint pnZoneSize p makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2] @@ -105,17 +103,14 @@ pointTowardsImpulse a b w = (find (flip (isWalkable a) w) . reverse) =<< makePat -- [] -> return Nothing -- _ -> return $ Just $ ns !! i -- + pairsToGraph :: Set.Set (Point2, Point2) -> (Map (V2 Point2) (Int, Int, PathEdge), Gr Point2 PathEdge) -pairsToGraph pairs = addEdges nodemap gr $ S.each pairs +pairsToGraph pairs = addEdges nodemap gr pairs where - (nodemap, _, gr) = addNodes $ S.map fst (S.each pairs) <> S.map snd (S.each pairs) + (nodemap, _, gr) = addNodes $ Set.toList $ Set.map fst pairs <> Set.map snd pairs --- let nodes' = Set.map fst pairs `Set.union` Set.map snd pairs --- pairs' = Set.map (\(x,y)->(x,y,f x y)) pairs --- in undir $ run_ Data.Graph.Inductive.empty $ insMapNodesM (Set.toList nodes') >> insMapEdgesM (Set.toList pairs') - -addNodes :: StreamOf Point2 -> (Map Point2 Int, Int, Gr Point2 PathEdge) -addNodes = runIdentity . S.fold_ f (mempty, 0, Data.Graph.Inductive.empty) id +addNodes :: [Point2] -> (Map Point2 Int, Int, Gr Point2 PathEdge) +addNodes = foldl' f (mempty, 0, Data.Graph.Inductive.empty) where f (nodemap, i, gr) p = case nodemap M.!? p of Just _ -> (nodemap, i, gr) @@ -124,9 +119,9 @@ addNodes = runIdentity . S.fold_ f (mempty, 0, Data.Graph.Inductive.empty) id addEdges :: Map Point2 Int -> Gr Point2 PathEdge -> - StreamOf (Point2, Point2) -> + Set.Set (Point2, Point2) -> (Map (V2 Point2) (Int, Int, PathEdge), Gr Point2 PathEdge) -addEdges nodemap gr = runIdentity . S.fold_ f (mempty, gr) id +addEdges nodemap gr = foldl' f (mempty, gr) where f (edgemap, gr') (a, b) = ( M.insert (V2 a b) theedge edgemap