diff --git a/src/Dodge/Zone.hs b/src/Dodge/Zone.hs index aa7ade821..3384cfbc7 100644 --- a/src/Dodge/Zone.hs +++ b/src/Dodge/Zone.hs @@ -9,8 +9,6 @@ module Dodge.Zone , crsNearSeg , wlsInsideCirc , crsInsideCirc - , lookLookups - , zoneNearPointIP , clZoneOfPoint , crZoneOfPoint , wlZoneOfPoint @@ -30,31 +28,25 @@ import Geometry.Zone import qualified Streaming.Prelude as S import StreamingHelp import Data.Maybe -import qualified Data.IntMap.Strict as IM import Control.Lens extractFromZone :: Zoning t a -> Int2 -> Maybe (t a) +{-# INLINE extractFromZone #-} extractFromZone zn (V2 x y) = zn ^? znObjects . ix x . ix y streamFromZone :: Foldable t => Zoning t a -> StreamOf Int2 -> StreamOf a +{-# INLINE streamFromZone #-} streamFromZone zn = S.concat . S.mapMaybe (extractFromZone zn) - -zoneNearPointIP :: Point2 -> [(Int,Int)] -zoneNearPointIP p = [(a,b) | a <- [x-1..x+1] , b <- [y-1..y+1] ] - where - V2 x y = wlZoneOfPoint p - zoneAroundPoint :: Float -> Point2 -> StreamOf Int2 +{-# INLINE zoneAroundPoint #-} zoneAroundPoint s p = S.each [V2 a b | a <- [x-1..x+1] , b <- [y-1..y+1] ] where V2 x y = zoneOfPoint s p ---zoneOfBounds :: Float -> (Float,Float,Float,Float) -> Stream (Of Int2) Identity () ---zoneOfBounds x (n,s,e,w) = ddaSqStream x (V2 n e) (V2 s w) - -- this is ugly, might be better with zoneOfBounds or somesuch zoneOfSight :: Float -> World -> Stream (Of (V2 Int)) Identity () --(Int,Int)] +{-# INLINE zoneOfSight #-} zoneOfSight x' w = S.each [V2 a b | a <- [minimum xs .. maximum xs] @@ -67,15 +59,6 @@ zoneOfSight x' w = S.each where f = floor . (/ s) -lookLookup :: Int -> Int -> IM.IntMap (IM.IntMap a) -> Maybe a -lookLookup i j z = case IM.lookup i z of - Just z' -> IM.lookup j z' - Nothing -> Nothing - -lookLookups :: [(Int,Int)] -> IM.IntMap (IM.IntMap a) -> [a] -lookLookups xs z = mapMaybe (flip (uncurry lookLookup) z) xs - - nearPoint :: (Foldable t,Monoid (t a)) => (World -> Zoning t a) -> Point2 -> World -> StreamOf a {-# INLINE nearPoint #-} @@ -83,42 +66,60 @@ nearPoint f p w = S.each . fromMaybe mempty $ extractFromZone zn (zoneOfPoint (_ where zn = f w +aroundPoint :: Foldable t => (World -> Zoning t a) -> Point2 -> World -> StreamOf a +{-# INLINE aroundPoint #-} +aroundPoint f p w = streamFromZone zn $ zoneAroundPoint (_znSize zn) p + where + zn = f w + clsNearPoint :: Point2 -> World -> StreamOf Cloud +{-# INLINE clsNearPoint #-} clsNearPoint = nearPoint _clZoning wlsNearPoint :: Point2 -> World -> StreamOf Wall +{-# INLINE wlsNearPoint #-} wlsNearPoint = nearPoint _wlZoning crsNearPoint :: Point2 -> World -> StreamOf Creature +{-# INLINE crsNearPoint #-} crsNearPoint = nearPoint _crZoning nearSeg :: Foldable t => (World -> Zoning t a) -> Point2 -> Point2 -> World -> StreamOf a +{-# INLINE nearSeg #-} nearSeg f p r w = streamFromZone zn $ zoneOfSeg (_znSize zn) p r where - zn = (f w) + zn = f w wlsNearSeg :: Point2 -> Point2 -> World -> Stream (Of Wall) Identity () +{-# INLINE wlsNearSeg #-} wlsNearSeg = nearSeg _wlZoning crsNearSeg :: Point2 -> Point2 -> World -> StreamOf Creature +{-# INLINE crsNearSeg #-} crsNearSeg = nearSeg _crZoning insideCirc :: Foldable t => (World -> Zoning t a) -> Point2 -> Float -> World -> StreamOf a +{-# INLINE insideCirc #-} insideCirc f p r w = streamFromZone zn $ zoneInsideCirc (_znSize zn) p r where zn = f w wlsInsideCirc :: Point2 -> Float -> World -> Stream (Of Wall) Identity () +{-# INLINE wlsInsideCirc #-} wlsInsideCirc = insideCirc _wlZoning crsInsideCirc :: Point2 -> Float -> World -> StreamOf Creature +{-# INLINE crsInsideCirc #-} crsInsideCirc = insideCirc _crZoning wlZoneOfPoint :: Point2 -> Int2 +{-# INLINE wlZoneOfPoint #-} wlZoneOfPoint = zoneOfPoint wlZoneSize clZoneOfPoint :: Point2 -> Int2 +{-# INLINE clZoneOfPoint #-} clZoneOfPoint = zoneOfPoint clZoneSize crZoneOfPoint :: Point2 -> Int2 +{-# INLINE crZoneOfPoint #-} crZoneOfPoint = zoneOfPoint crZoneSize