Redo zoning functions/inlining
This commit is contained in:
+23
-22
@@ -9,8 +9,6 @@ module Dodge.Zone
|
|||||||
, crsNearSeg
|
, crsNearSeg
|
||||||
, wlsInsideCirc
|
, wlsInsideCirc
|
||||||
, crsInsideCirc
|
, crsInsideCirc
|
||||||
, lookLookups
|
|
||||||
, zoneNearPointIP
|
|
||||||
, clZoneOfPoint
|
, clZoneOfPoint
|
||||||
, crZoneOfPoint
|
, crZoneOfPoint
|
||||||
, wlZoneOfPoint
|
, wlZoneOfPoint
|
||||||
@@ -30,31 +28,25 @@ import Geometry.Zone
|
|||||||
import qualified Streaming.Prelude as S
|
import qualified Streaming.Prelude as S
|
||||||
import StreamingHelp
|
import StreamingHelp
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import qualified Data.IntMap.Strict as IM
|
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
|
|
||||||
extractFromZone :: Zoning t a -> Int2 -> Maybe (t a)
|
extractFromZone :: Zoning t a -> Int2 -> Maybe (t a)
|
||||||
|
{-# INLINE extractFromZone #-}
|
||||||
extractFromZone zn (V2 x y) = zn ^? znObjects . ix x . ix y
|
extractFromZone zn (V2 x y) = zn ^? znObjects . ix x . ix y
|
||||||
|
|
||||||
streamFromZone :: Foldable t => Zoning t a -> StreamOf Int2 -> StreamOf a
|
streamFromZone :: Foldable t => Zoning t a -> StreamOf Int2 -> StreamOf a
|
||||||
|
{-# INLINE streamFromZone #-}
|
||||||
streamFromZone zn = S.concat . S.mapMaybe (extractFromZone zn)
|
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
|
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] ]
|
zoneAroundPoint s p = S.each [V2 a b | a <- [x-1..x+1] , b <- [y-1..y+1] ]
|
||||||
where
|
where
|
||||||
V2 x y = zoneOfPoint s p
|
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
|
-- this is ugly, might be better with zoneOfBounds or somesuch
|
||||||
zoneOfSight :: Float -> World -> Stream (Of (V2 Int)) Identity () --(Int,Int)]
|
zoneOfSight :: Float -> World -> Stream (Of (V2 Int)) Identity () --(Int,Int)]
|
||||||
|
{-# INLINE zoneOfSight #-}
|
||||||
zoneOfSight x' w = S.each
|
zoneOfSight x' w = S.each
|
||||||
[V2 a b
|
[V2 a b
|
||||||
| a <- [minimum xs .. maximum xs]
|
| a <- [minimum xs .. maximum xs]
|
||||||
@@ -67,15 +59,6 @@ zoneOfSight x' w = S.each
|
|||||||
where
|
where
|
||||||
f = floor . (/ s)
|
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))
|
nearPoint :: (Foldable t,Monoid (t a))
|
||||||
=> (World -> Zoning t a) -> Point2 -> World -> StreamOf a
|
=> (World -> Zoning t a) -> Point2 -> World -> StreamOf a
|
||||||
{-# INLINE nearPoint #-}
|
{-# INLINE nearPoint #-}
|
||||||
@@ -83,42 +66,60 @@ nearPoint f p w = S.each . fromMaybe mempty $ extractFromZone zn (zoneOfPoint (_
|
|||||||
where
|
where
|
||||||
zn = f w
|
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
|
clsNearPoint :: Point2 -> World -> StreamOf Cloud
|
||||||
|
{-# INLINE clsNearPoint #-}
|
||||||
clsNearPoint = nearPoint _clZoning
|
clsNearPoint = nearPoint _clZoning
|
||||||
|
|
||||||
wlsNearPoint :: Point2 -> World -> StreamOf Wall
|
wlsNearPoint :: Point2 -> World -> StreamOf Wall
|
||||||
|
{-# INLINE wlsNearPoint #-}
|
||||||
wlsNearPoint = nearPoint _wlZoning
|
wlsNearPoint = nearPoint _wlZoning
|
||||||
|
|
||||||
crsNearPoint :: Point2 -> World -> StreamOf Creature
|
crsNearPoint :: Point2 -> World -> StreamOf Creature
|
||||||
|
{-# INLINE crsNearPoint #-}
|
||||||
crsNearPoint = nearPoint _crZoning
|
crsNearPoint = nearPoint _crZoning
|
||||||
|
|
||||||
nearSeg :: Foldable t => (World -> Zoning t a) -> Point2 -> Point2 -> World -> StreamOf a
|
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
|
nearSeg f p r w = streamFromZone zn $ zoneOfSeg (_znSize zn) p r
|
||||||
where
|
where
|
||||||
zn = (f w)
|
zn = f w
|
||||||
|
|
||||||
wlsNearSeg :: Point2 -> Point2 -> World -> Stream (Of Wall) Identity ()
|
wlsNearSeg :: Point2 -> Point2 -> World -> Stream (Of Wall) Identity ()
|
||||||
|
{-# INLINE wlsNearSeg #-}
|
||||||
wlsNearSeg = nearSeg _wlZoning
|
wlsNearSeg = nearSeg _wlZoning
|
||||||
|
|
||||||
crsNearSeg :: Point2 -> Point2 -> World -> StreamOf Creature
|
crsNearSeg :: Point2 -> Point2 -> World -> StreamOf Creature
|
||||||
|
{-# INLINE crsNearSeg #-}
|
||||||
crsNearSeg = nearSeg _crZoning
|
crsNearSeg = nearSeg _crZoning
|
||||||
|
|
||||||
insideCirc :: Foldable t => (World -> Zoning t a) -> Point2 -> Float -> World -> StreamOf a
|
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
|
insideCirc f p r w = streamFromZone zn $ zoneInsideCirc (_znSize zn) p r
|
||||||
where
|
where
|
||||||
zn = f w
|
zn = f w
|
||||||
|
|
||||||
wlsInsideCirc :: Point2 -> Float -> World -> Stream (Of Wall) Identity ()
|
wlsInsideCirc :: Point2 -> Float -> World -> Stream (Of Wall) Identity ()
|
||||||
|
{-# INLINE wlsInsideCirc #-}
|
||||||
wlsInsideCirc = insideCirc _wlZoning
|
wlsInsideCirc = insideCirc _wlZoning
|
||||||
|
|
||||||
crsInsideCirc :: Point2 -> Float -> World -> StreamOf Creature
|
crsInsideCirc :: Point2 -> Float -> World -> StreamOf Creature
|
||||||
|
{-# INLINE crsInsideCirc #-}
|
||||||
crsInsideCirc = insideCirc _crZoning
|
crsInsideCirc = insideCirc _crZoning
|
||||||
|
|
||||||
wlZoneOfPoint :: Point2 -> Int2
|
wlZoneOfPoint :: Point2 -> Int2
|
||||||
|
{-# INLINE wlZoneOfPoint #-}
|
||||||
wlZoneOfPoint = zoneOfPoint wlZoneSize
|
wlZoneOfPoint = zoneOfPoint wlZoneSize
|
||||||
|
|
||||||
clZoneOfPoint :: Point2 -> Int2
|
clZoneOfPoint :: Point2 -> Int2
|
||||||
|
{-# INLINE clZoneOfPoint #-}
|
||||||
clZoneOfPoint = zoneOfPoint clZoneSize
|
clZoneOfPoint = zoneOfPoint clZoneSize
|
||||||
|
|
||||||
crZoneOfPoint :: Point2 -> Int2
|
crZoneOfPoint :: Point2 -> Int2
|
||||||
|
{-# INLINE crZoneOfPoint #-}
|
||||||
crZoneOfPoint = zoneOfPoint crZoneSize
|
crZoneOfPoint = zoneOfPoint crZoneSize
|
||||||
|
|||||||
Reference in New Issue
Block a user