Remove some Streaming
This commit is contained in:
+8
-13
@@ -26,8 +26,7 @@ import Dodge.Data.World
|
|||||||
import Dodge.Zoning.Base
|
import Dodge.Zoning.Base
|
||||||
import Dodge.Zoning.Pathing
|
import Dodge.Zoning.Pathing
|
||||||
import Geometry
|
import Geometry
|
||||||
import qualified Streaming.Prelude as S
|
import Data.Bifunctor
|
||||||
import StreamingHelp
|
|
||||||
|
|
||||||
getNodePos :: Int -> World -> Maybe Point2
|
getNodePos :: Int -> World -> Maybe Point2
|
||||||
getNodePos i w = _pathGraph (_cWorld w) `lab` i
|
getNodePos i w = _pathGraph (_cWorld w) `lab` i
|
||||||
@@ -48,7 +47,6 @@ walkableNodeNear :: World -> Point2 -> Maybe Int
|
|||||||
{-# INLINE walkableNodeNear #-}
|
{-# INLINE walkableNodeNear #-}
|
||||||
walkableNodeNear w p = fmap fst . find (flip (isWalkable p) w . snd) $ nodesNear
|
walkableNodeNear w p = fmap fst . find (flip (isWalkable p) w . snd) $ nodesNear
|
||||||
where
|
where
|
||||||
--nodesNear = runIdentity . S.toList_ $ nearPoint _pnZoning p w
|
|
||||||
nodesNear = zonesExtract (w ^. cWorld . pnZoning) $ zonesAroundPoint pnZoneSize p
|
nodesNear = zonesExtract (w ^. cWorld . pnZoning) $ zonesAroundPoint pnZoneSize p
|
||||||
|
|
||||||
makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2]
|
makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2]
|
||||||
@@ -105,17 +103,14 @@ pointTowardsImpulse a b w = (find (flip (isWalkable a) w) . reverse) =<< makePat
|
|||||||
-- [] -> return Nothing
|
-- [] -> return Nothing
|
||||||
-- _ -> return $ Just $ ns !! i
|
-- _ -> return $ Just $ ns !! i
|
||||||
--
|
--
|
||||||
|
|
||||||
pairsToGraph :: Set.Set (Point2, Point2) -> (Map (V2 Point2) (Int, Int, PathEdge), Gr Point2 PathEdge)
|
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
|
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
|
addNodes :: [Point2] -> (Map Point2 Int, Int, Gr Point2 PathEdge)
|
||||||
-- pairs' = Set.map (\(x,y)->(x,y,f x y)) pairs
|
addNodes = foldl' f (mempty, 0, Data.Graph.Inductive.empty)
|
||||||
-- 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
|
|
||||||
where
|
where
|
||||||
f (nodemap, i, gr) p = case nodemap M.!? p of
|
f (nodemap, i, gr) p = case nodemap M.!? p of
|
||||||
Just _ -> (nodemap, i, gr)
|
Just _ -> (nodemap, i, gr)
|
||||||
@@ -124,9 +119,9 @@ addNodes = runIdentity . S.fold_ f (mempty, 0, Data.Graph.Inductive.empty) id
|
|||||||
addEdges ::
|
addEdges ::
|
||||||
Map Point2 Int ->
|
Map Point2 Int ->
|
||||||
Gr Point2 PathEdge ->
|
Gr Point2 PathEdge ->
|
||||||
StreamOf (Point2, Point2) ->
|
Set.Set (Point2, Point2) ->
|
||||||
(Map (V2 Point2) (Int, Int, PathEdge), Gr Point2 PathEdge)
|
(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
|
where
|
||||||
f (edgemap, gr') (a, b) =
|
f (edgemap, gr') (a, b) =
|
||||||
( M.insert (V2 a b) theedge edgemap
|
( M.insert (V2 a b) theedge edgemap
|
||||||
|
|||||||
Reference in New Issue
Block a user