Attempt to improve perfomance
This commit is contained in:
@@ -30,25 +30,25 @@ zoneOfPn = zoneOfPoint'' pnZoneSize . snd
|
||||
zonePn :: (Int, Point2) -> IM.IntMap (IM.IntMap [(Int, Point2)]) -> IM.IntMap (IM.IntMap [(Int, Point2)])
|
||||
zonePn pn = zoneMonoid (zoneOfPn pn) [pn]
|
||||
|
||||
pesNearPoint :: Point2 -> World -> Set (Int, Int, PathEdge)
|
||||
pesNearPoint :: Point2 -> World -> Set PathEdgeNodes
|
||||
pesNearPoint p w = zoneExtract (zoneOfPoint peZoneSize p) (w ^. cWorld . peZoning)
|
||||
|
||||
pesNearSeg :: Point2 -> Point2 -> World -> Set (Int, Int, PathEdge)
|
||||
pesNearSeg :: Point2 -> Point2 -> World -> Set PathEdgeNodes
|
||||
pesNearSeg sp ep w = zonesExtract (w ^. cWorld . peZoning) (zoneOfSeg peZoneSize sp ep)
|
||||
|
||||
pesNearRect :: Point2 -> Point2 -> World -> Set (Int, Int, PathEdge)
|
||||
pesNearRect :: Point2 -> Point2 -> World -> Set PathEdgeNodes
|
||||
pesNearRect sp ep w = zonesExtract (w ^. cWorld . peZoning) $ zoneOfRect' peZoneSize sp ep
|
||||
|
||||
pesNearCirc :: Point2 -> Float -> World -> Set (Int, Int, PathEdge)
|
||||
pesNearCirc :: Point2 -> Float -> World -> Set PathEdgeNodes
|
||||
pesNearCirc p r = pesNearRect (p +.+ V2 r r) (p -.- V2 r r)
|
||||
|
||||
peZoneSize :: Float
|
||||
peZoneSize = 50
|
||||
|
||||
zoneOfPe :: (Int, Int, PathEdge) -> [Int2]
|
||||
zoneOfPe (_, _, pe) = zoneOfSeg peZoneSize (_peStart pe) (_peEnd pe)
|
||||
zoneOfPe :: (PathEdgeNodes) -> [Int2]
|
||||
zoneOfPe (PathEdgeNodes _ _ pe) = zoneOfSeg peZoneSize (_peStart pe) (_peEnd pe)
|
||||
|
||||
zonePe :: (Int, Int, PathEdge) -> IM.IntMap (IM.IntMap (Set (Int, Int, PathEdge))) -> IM.IntMap (IM.IntMap (Set (Int, Int, PathEdge)))
|
||||
zonePe :: PathEdgeNodes -> IM.IntMap (IM.IntMap (Set PathEdgeNodes)) -> IM.IntMap (IM.IntMap (Set (PathEdgeNodes)))
|
||||
zonePe pe im = foldl' f im (zoneOfPe pe)
|
||||
where
|
||||
f im' i2 = zoneMonoid i2 (Set.singleton pe) im'
|
||||
|
||||
@@ -23,12 +23,14 @@ wlIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet
|
||||
wlIXsNearCirc p r = wlIXsNearRect (p +.+ V2 r r) (p -.- V2 r r)
|
||||
|
||||
wlsFromIXs :: World -> IS.IntSet -> [Wall]
|
||||
{-# INLINE wlsFromIXs #-}
|
||||
wlsFromIXs w = mapMaybe (\wlid -> w ^? cWorld . walls . ix wlid) . IS.toList
|
||||
|
||||
wlsNearPoint :: Point2 -> World -> [Wall]
|
||||
wlsNearPoint p w = wlsFromIXs w $ wlIXsNearPoint p w
|
||||
|
||||
wlsNearSeg :: Point2 -> Point2 -> World -> [Wall]
|
||||
{-# INLINE wlsNearSeg #-}
|
||||
wlsNearSeg sp ep w = wlsFromIXs w $ wlIXsNearSeg sp ep w
|
||||
|
||||
wlsNearRect :: Point2 -> Point2 -> World -> [Wall]
|
||||
|
||||
Reference in New Issue
Block a user