justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Cleanup zoning

Browse Source
This commit is contained in:
justin
2022-06-28 13:43:37 +01:00
parent e770fba7bf
commit 9801a40b9e
14 changed files with 84 additions and 106 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/Collide.hs
+7 -7
View File
@@ -94,7 +94,7 @@ collidePointTestFilter t sp ep = runIdentity
collidePointWallsFilterStream :: (Wall -> Bool) -> Point2 -> Point2 -> World -> (Point2, Maybe Wall) collidePointWallsFilterStream :: (Wall -> Bool) -> Point2 -> Point2 -> World -> (Point2, Maybe Wall)
collidePointWallsFilterStream t sp ep = collidePoint sp ep collidePointWallsFilterStream t sp ep = collidePoint sp ep
. S.filter t . S.filter t
. wallsAlongLine sp ep . wlsNearSeg sp ep
overlapSegWalls :: Point2 -> Point2 -> Stream (Of Wall) Identity () overlapSegWalls :: Point2 -> Point2 -> Stream (Of Wall) Identity ()
-> Stream (Of (Point2,Wall)) Identity () -> Stream (Of (Point2,Wall)) Identity ()
@@ -105,7 +105,7 @@ visibleWalls sp ep = S.take 1 <=< -- hlint, was using join and fmap
( S.span (not . wlIsOpaque . snd) ( S.span (not . wlIsOpaque . snd)
. sortStreamOn (dist sp . fst) . sortStreamOn (dist sp . fst)
. overlapSegWalls sp ep . overlapSegWalls sp ep
. wallsAlongLine sp ep ) . wlsNearSeg sp ep )
allVisibleWalls :: World -> Stream (Of (Point2,Wall)) Identity () allVisibleWalls :: World -> Stream (Of (Point2,Wall)) Identity ()
allVisibleWalls w = concats $ S.subst (flip (visibleWalls vPos) w . (+.+ vPos)) $ S.each (nRays 20) allVisibleWalls w = concats $ S.subst (flip (visibleWalls vPos) w . (+.+ vPos)) $ S.each (nRays 20)
@@ -236,7 +236,7 @@ collideCircCrsPoint p1 p2 rad = collidePointCrsPoint p1 p2 . fmap (crRad +~ rad)
- Note no check on whether the wall is walkable. -} - Note no check on whether the wall is walkable. -}
circOnSomeWall :: Point2 -> Float -> World -> Bool circOnSomeWall :: Point2 -> Float -> World -> Bool
circOnSomeWall p rad = runIdentity . S.any_ (uncurry (circOnSeg p rad) . _wlLine) circOnSomeWall p rad = runIdentity . S.any_ (uncurry (circOnSeg p rad) . _wlLine)
. wallsNearPoint p . wlsNearPoint p
-- = any (\(x,y) -> circOnSeg x y p rad) -- = any (\(x,y) -> circOnSeg x y p rad)
-- . fmap _wlLine -- . fmap _wlLine
-- . IM.elems -- . IM.elems
@@ -300,23 +300,23 @@ hasLOS :: Point2 -> Point2 -> World -> Bool
{-# INLINE hasLOS #-} {-# INLINE hasLOS #-}
hasLOS p1 p2 = not hasLOS p1 p2 = not
. collidePointTestFilter (const True) p1 p2 . collidePointTestFilter (const True) p1 p2
. wallsAlongLine p1 p2 . wlsNearSeg p1 p2
hasButtonLOS :: Point2 -> Point2 -> World -> Bool hasButtonLOS :: Point2 -> Point2 -> World -> Bool
{-# INLINE hasButtonLOS #-} {-# INLINE hasButtonLOS #-}
hasButtonLOS p1 p2 = not hasButtonLOS p1 p2 = not
. collidePointTestFilter (not . _wlTouchThrough) p1 p2 . collidePointTestFilter (not . _wlTouchThrough) p1 p2
. wallsAlongLine p1 p2 . wlsNearSeg p1 p2
hasLOSIndirect :: Point2 -> Point2 -> World -> Bool hasLOSIndirect :: Point2 -> Point2 -> World -> Bool
hasLOSIndirect p1 p2 = not hasLOSIndirect p1 p2 = not
. collidePointTestFilter wlIsOpaque p1 p2 . collidePointTestFilter wlIsOpaque p1 p2
. wallsAlongLine p1 p2 . wlsNearSeg p1 p2
isWalkable :: Point2 -> Point2 -> World -> Bool isWalkable :: Point2 -> Point2 -> World -> Bool
isWalkable p1 p2 = not isWalkable p1 p2 = not
. collidePointTestFilter (not . (^?! wlPathable)) p1 p2 . collidePointTestFilter (not . (^?! wlPathable)) p1 p2
. wallsAlongLine p1 p2 . wlsNearSeg p1 p2
canSee :: Int -> Int -> World -> Bool canSee :: Int -> Int -> World -> Bool
canSee i j w = hasLOS p1 p2 w canSee i j w = hasLOS p1 p2 w
src/Dodge/Debug.hs
+1 -1
View File
@@ -58,7 +58,7 @@ debugWallZoningPic w = setLayer BloomLayer $ zonesPic `appendPic` wallsPic
where where
--wallsPic = setDepth 25 . color yellow . concatMapPic (drawTheWall . _wlLine) $ IM.elems theWalls --wallsPic = setDepth 25 . color yellow . concatMapPic (drawTheWall . _wlLine) $ IM.elems theWalls
wallsPic = setDepth 25 . color yellow . runIdentity . S.foldMap_ (drawTheWall . _wlLine) wallsPic = setDepth 25 . color yellow . runIdentity . S.foldMap_ (drawTheWall . _wlLine)
$ wallsAlongLine sp ep w $ wlsNearSeg sp ep w
drawTheWall (a,b) = thickLine 20 [a,b] drawTheWall (a,b) = thickLine 20 [a,b]
zonesPic = setDepth 20 $ drawDDA zones zonesPic = setDepth 20 $ drawDDA zones
zones = ddaExt wlZoneSize sp ep zones = ddaExt wlZoneSize sp ep
src/Dodge/Item/Weapon/Grenade.hs
+2 -2
View File
@@ -55,7 +55,7 @@ moveGrenade pj w
-- this should maybe -- this should maybe
-- be wallsAlongLine -- be wallsAlongLine
-- or something vvv -- or something vvv
| otherwise = case bounceBall 1 oldPos newPos 4 $ wallsNearPoint newPos w of | otherwise = case bounceBall 1 oldPos newPos 4 $ wlsNearPoint newPos w of
Nothing -> w & props . ix pID %~ normalUpdate Nothing -> w & props . ix pID %~ normalUpdate
Just (p,v) -> w Just (p,v) -> w
& soundStart (Tap 0) p tapQuietS Nothing & soundStart (Tap 0) p tapQuietS Nothing
@@ -186,7 +186,7 @@ moveRemoteBomb itid time pID w
-- this is hacky, should use a version of collidePointWalls' that collides -- this is hacky, should use a version of collidePointWalls' that collides
-- circles and walls -- circles and walls
invShift x = x -.- 5 *.* normalizeV (_pjVel pj) invShift x = x -.- 5 *.* normalizeV (_pjVel pj)
hitWl = bounceBall 1 oldPos newPos 4 $ wallsNearPoint newPos w hitWl = bounceBall 1 oldPos newPos 4 $ wlsNearPoint newPos w
finalPos = maybe newPos (invShift . fst) hitWl finalPos = maybe newPos (invShift . fst) hitWl
setV v = set (props . ix pID . pjVel) v setV v = set (props . ix pID . pjVel) v
updateV = maybe id (setV . snd) hitWl updateV = maybe id (setV . snd) hitWl
src/Dodge/Item/Weapon/Launcher.hs
+1 -1
View File
@@ -335,7 +335,7 @@ anythingHitCirc :: Float -> Point2 -> Point2 -> World -> Bool
anythingHitCirc rad sp ep w = isJust hitCr || isJust (sequence hitWl) anythingHitCirc rad sp ep w = isJust hitCr || isJust (sequence hitWl)
where where
hitCr = collideCircCrsPoint sp ep rad (_creatures w) hitCr = collideCircCrsPoint sp ep rad (_creatures w)
hitWl = collideCircWallsStream sp ep rad $ wallsNearPoint ep w hitWl = collideCircWallsStream sp ep rad $ wlsNearPoint ep w
-- this should probably be wallsOnLine or something -- this should probably be wallsOnLine or something
explodeRemoteRocket explodeRemoteRocket
src/Dodge/Item/Weapon/UseEffect.hs
+2 -2
View File
@@ -123,8 +123,8 @@ itemBlips p r = IM.elems . IM.filter f . fmap _flItPos . _floorItems
wallBlips :: Point2 -> Float -> World -> [Point2] wallBlips :: Point2 -> Float -> World -> [Point2]
wallBlips p r w = runIdentity . S.toList_ $ S.mapMaybe (uncurry (intersectCircSegFirst p r) . _wlLine) wallBlips p r w = runIdentity . S.toList_ $ S.mapMaybe (uncurry (intersectCircSegFirst p r) . _wlLine)
$ S.map (over wlLine swp) (wallsInsideCirc p r w) $ S.map (over wlLine swp) (wlsInsideCirc p r w)
<> wallsInsideCirc p r w <> wlsInsideCirc p r w
where where
swp (a,b) = (b,a) swp (a,b) = (b,a)
src/Dodge/Render/ShapePicture.hs
+1 -2
View File
@@ -16,7 +16,6 @@ import Dodge.Graph
import Dodge.GameRoom import Dodge.GameRoom
import Dodge.Update.Camera import Dodge.Update.Camera
import Dodge.Item.Draw import Dodge.Item.Draw
import Dodge.Wall.Zone
--import Dodge.Zone --import Dodge.Zone
import Geometry import Geometry
import Geometry.Zone import Geometry.Zone
@@ -127,7 +126,7 @@ drawFarWallDetect w = setLayer DebugLayer
. color yellow . color yellow
. concatMap (\q -> line . concatMap (\q -> line
[ p [ p
, fst $ collidePoint p q $ S.filter wlIsOpaque $ wallsAlongLine p q w , fst $ collidePoint p q $ S.filter wlIsOpaque $ wlsNearSeg p q w
] ) ] )
$ runIdentity $ S.toList_ $ streamViewpoints p w $ runIdentity $ S.toList_ $ streamViewpoints p w
where where
src/Dodge/Update.hs
+4 -1
View File
@@ -97,7 +97,10 @@ functionalUpdate cfig w = checkEndGame
$ updateCloseObjects w $ updateCloseObjects w
where where
--updatedLightSources = mapMaybe (\b -> _tlsUpdate b w b) $ _tempLightSources w --updatedLightSources = mapMaybe (\b -> _tlsUpdate b w b) $ _tempLightSources w
zoneClouds = set (cloudsZone . znObjects) (foldl' (flip cloudInZone) IM.empty (_clouds w))
zoneClouds :: World -> World
zoneClouds w = w & set (cloudsZone . znObjects) (foldl' (flip cloudInZone) IM.empty (_clouds w))
where
cloudInZone cl = insertInZoneWith x y (++) [cl] cloudInZone cl = insertInZoneWith x y (++) [cl]
where where
V2 x y = clZoneOfPoint $ stripZ $ _clPos cl V2 x y = clZoneOfPoint $ stripZ $ _clPos cl
src/Dodge/Update/Camera.hs
+2 -2
View File
@@ -151,7 +151,7 @@ rotateToOverlappingWall :: World -> World
rotateToOverlappingWall w = maybe rotateToOverlappingWall w = maybe
id id
(doWallRotate . snd) (doWallRotate . snd)
(overlapCircWallsClosest p (_crRad cr + 5) (S.filter _wlRotateTo $ wallsNearPoint p w)) (overlapCircWallsClosest p (_crRad cr + 5) (S.filter _wlRotateTo $ wlsNearPoint p w))
w w
where where
cr = you w cr = you w
@@ -224,7 +224,7 @@ farWallDistDirection p w = boundPoints
$ S.map f vps $ S.map f vps
where where
f q = runIdentity (S.fold_ findPoint q (rotateV (negate $ _cameraRot w) . (-.- p)) (wls q)) f q = runIdentity (S.fold_ findPoint q (rotateV (negate $ _cameraRot w) . (-.- p)) (wls q))
wls q = S.filter wlIsOpaque $ wallsAlongLine p q w wls q = S.filter wlIsOpaque $ wlsNearSeg p q w
findPoint q = fromMaybe q . uncurry (intersectSegSeg p q) . _wlLine findPoint q = fromMaybe q . uncurry (intersectSegSeg p q) . _wlLine
vps = streamViewpoints p w vps = streamViewpoints p w
src/Dodge/Wall/Zone.hs
+1 -4
View File
@@ -7,12 +7,9 @@ import Dodge.Base
import Control.Lens import Control.Lens
--import Data.Foldable --import Data.Foldable
import Streaming --import Streaming
import qualified Streaming.Prelude as S import qualified Streaming.Prelude as S
zoneOfWall :: Wall -> Stream (Of (V2 Int)) Identity ()
zoneOfWall = uncurry (zoneOfSeg wlZoneSize) . _wlLine
insertWallInZones :: Wall -> World -> World insertWallInZones :: Wall -> World -> World
insertWallInZones wl = wallsZone . znObjects insertWallInZones wl = wallsZone . znObjects
%~ (runIdentity . (\wlzns -> S.fold_ doinsert wlzns id (zoneOfWall wl))) %~ (runIdentity . (\wlzns -> S.fold_ doinsert wlzns id (zoneOfWall wl)))
src/Dodge/WallCreatureCollisions.hs
+3 -3
View File
@@ -47,8 +47,8 @@ colCrWall w c
p2 = _crPos c p2 = _crPos c
ls = _wlLine <$> wls ls = _wlLine <$> wls
ls' = filter (uncurry $ isLHS p1) ls ls' = filter (uncurry $ isLHS p1) ls
wls' = S.filter (not . _wlWalkable) $ wallsNearPoint p2 w wls' = S.filter (not . _wlWalkable) $ wlsNearPoint p2 w
wls = runIdentity . S.toList_ . S.filter (not . _wlWalkable) $ wallsNearPoint p2 w wls = runIdentity . S.toList_ . S.filter (not . _wlWalkable) $ wlsNearPoint p2 w
--wallPoints = map fst ls --wallPoints = map fst ls
-- the amount to push creatures out from walls, extra to their radius -- the amount to push creatures out from walls, extra to their radius
@@ -88,7 +88,7 @@ crOnWall :: Creature -> World -> Bool
crOnWall cr = runIdentity crOnWall cr = runIdentity
. S.any_ (uncurry (circOnSeg p r) . _wlLine) . S.any_ (uncurry (circOnSeg p r) . _wlLine)
. S.filter (not . _wlWalkable) . S.filter (not . _wlWalkable)
. wallsNearPoint p . wlsNearPoint p
where where
p = _crPos cr p = _crPos cr
r = _crRad cr r = _crRad cr
src/Dodge/WorldEvent/Shockwave.hs
+1 -1
View File
@@ -70,7 +70,7 @@ mvShockwave is w pt
w' w'
id id
hitBlocks hitBlocks
hitBlocks = S.map snd . overlapCircWalls p rad $ wallsInsideCirc p rad w hitBlocks = S.map snd . overlapCircWalls p rad $ wlsInsideCirc p rad w
-- this is not expansive enough -- this is not expansive enough
damCr cr damCr cr
| _crID cr `elem` is || dist (_crPos cr) p >= rad + _crRad cr = cr | _crID cr `elem` is || dist (_crPos cr) p >= rad + _crRad cr = cr
src/Dodge/WorldEvent/SpawnParticle.hs
+1 -1
View File
@@ -214,7 +214,7 @@ damageInArea crt wlt pt w = damwls damcrs
w' w'
id id
. S.filter wlt . S.filter wlt
$ wallsNearPoint p w' $ wlsNearPoint p w'
hiteff = _ptHitEff pt pt hiteff = _ptHitEff pt pt
-- | At writing the radius is half the size of the effect area -- | At writing the radius is half the size of the effect area
src/Dodge/WorldEvent/ThingsHit.hs
+1 -1
View File
@@ -60,4 +60,4 @@ wlsHit sp ep
| sp == ep = const mempty | sp == ep = const mempty
| otherwise = sortStreamOn (dist sp . fst) | otherwise = sortStreamOn (dist sp . fst)
. overlapSegWalls sp ep . overlapSegWalls sp ep
. wallsAlongLine sp ep . wlsNearSeg sp ep
src/Dodge/Zone.hs
+57 -78
View File
@@ -1,22 +1,21 @@
module Dodge.Zone module Dodge.Zone
( crZoneOfPoint ( zoneOfSeg
, wallsNearPoint , zoneOfCreature
, wallsAlongLine , zoneOfWall
, zoneOfSight
, zoneAroundPoint
, wlsNearPoint
, crsNearPoint
, clsNearPoint
, wlsNearSeg
, crsNearSeg , crsNearSeg
, wallsInsideCirc , wlsInsideCirc
, crsInsideCirc , crsInsideCirc
, lookLookups , lookLookups
, zoneOfSeg
, zoneNearPointIP , zoneNearPointIP
, zoneNearPoint
, zoneOfCreature
, clZoneOfPoint , clZoneOfPoint
, clsNearPoint , crZoneOfPoint
, zoneOfSight
, flattenIMIMIM
, wlZoneOfPoint , wlZoneOfPoint
, crsNearPoint
, creaturesAlongLine
, module Dodge.Zone.Size , module Dodge.Zone.Size
) )
where where
@@ -25,7 +24,6 @@ import Dodge.Data
--import Dodge.Base.Window --import Dodge.Base.Window
import Geometry import Geometry
import Geometry.Zone import Geometry.Zone
import qualified FoldlHelp as L
import qualified Streaming.Prelude as S import qualified Streaming.Prelude as S
import StreamingHelp import StreamingHelp
@@ -33,34 +31,27 @@ import Data.Maybe
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
import Control.Lens import Control.Lens
wlZoneOfPoint :: Point2 -> Int2
wlZoneOfPoint = zoneOfPoint wlZoneSize
clZoneOfPoint :: Point2 -> Int2
clZoneOfPoint = zoneOfPoint clZoneSize
crZoneOfPoint :: Point2 -> Int2
crZoneOfPoint = zoneOfPoint crZoneSize
zoneOfSeg :: Float -> Point2 -> Point2 -> StreamOf Int2 zoneOfSeg :: Float -> Point2 -> Point2 -> StreamOf Int2
--zoneOfLineStream = ddaSqStream zoneSize
zoneOfSeg = ddaStream zoneOfSeg = ddaStream
zoneOfCreature :: Creature -> StreamOf Int2
zoneOfCreature cr = zoneInsideCirc crZoneSize (_crPos cr) (_crRad cr)
zoneInsideCirc :: Float -> Point2 -> Float -> StreamOf Int2 zoneInsideCirc :: Float -> Point2 -> Float -> StreamOf Int2
zoneInsideCirc x p r = ddaSqStream x (p +.+ V2 r r) (p -.- V2 r r) zoneInsideCirc x p r = ddaSqStream x (p +.+ V2 r r) (p -.- V2 r r)
zoneOfWall :: Wall -> Stream (Of (V2 Int)) Identity ()
zoneOfWall = uncurry (zoneOfSeg wlZoneSize) . _wlLine
zoneOfCreature :: Creature -> StreamOf Int2
zoneOfCreature cr = zoneInsideCirc crZoneSize (_crPos cr) (_crRad cr)
zoneNearPointIP :: Point2 -> [(Int,Int)] zoneNearPointIP :: Point2 -> [(Int,Int)]
zoneNearPointIP p = [(a,b) | a <- [x-1..x+1] , b <- [y-1..y+1] ] zoneNearPointIP p = [(a,b) | a <- [x-1..x+1] , b <- [y-1..y+1] ]
where where
V2 x y = wlZoneOfPoint p V2 x y = wlZoneOfPoint p
zoneNearPoint :: Point2 -> Stream (Of (V2 Int)) Identity () zoneAroundPoint :: Float -> Point2 -> StreamOf Int2
zoneNearPoint 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 = wlZoneOfPoint p V2 x y = zoneOfPoint s p
--zoneOfBounds :: Float -> (Float,Float,Float,Float) -> Stream (Of Int2) Identity () --zoneOfBounds :: Float -> (Float,Float,Float,Float) -> Stream (Of Int2) Identity ()
--zoneOfBounds x (n,s,e,w) = ddaSqStream x (V2 n e) (V2 s w) --zoneOfBounds x (n,s,e,w) = ddaSqStream x (V2 n e) (V2 s w)
@@ -87,59 +78,47 @@ lookLookup i j z = case IM.lookup i z of
lookLookups :: [(Int,Int)] -> IM.IntMap (IM.IntMap a) -> [a] lookLookups :: [(Int,Int)] -> IM.IntMap (IM.IntMap a) -> [a]
lookLookups xs z = mapMaybe (flip (uncurry lookLookup) z) xs lookLookups xs z = mapMaybe (flip (uncurry lookLookup) z) xs
clsNearPoint :: Point2 -> World -> Stream (Of Cloud) Identity () extractFromZone :: Zone a -> Int2 -> Maybe a
clsNearPoint p w = S.each . fromMaybe mempty $ w ^? cloudsZone . znObjects . ix x . ix y extractFromZone zn (V2 x y) = zn ^? znObjects . ix x . ix y
where
V2 x y = clZoneOfPoint p
-- TODO check whether/when nubbing of walls is necessary nearPoint :: (Foldable t,Monoid (t a))
wallsAlongLine :: Point2 -> Point2 -> World -> Stream (Of Wall) Identity () => Float -> (World -> Zone (t a)) -> Point2 -> World -> StreamOf a
wallsAlongLine sp ep w = S.concat $ S.mapMaybe f $ zoneOfSeg wlZoneSize sp ep nearPoint s f p w = S.each . fromMaybe mempty $ extractFromZone (f w) (zoneOfPoint s p)
where
f (V2 i j) = w ^? wallsZone . znObjects . ix i . ix j
crsNearSeg :: Point2 -> Point2 -> World -> StreamOf Creature clsNearPoint :: Point2 -> World -> StreamOf Cloud
crsNearSeg sp ep w = S.concat $ S.mapMaybe f $ zoneOfSeg crZoneSize sp ep clsNearPoint = nearPoint clZoneSize _cloudsZone
where
f (V2 i j) = w ^? creaturesZone . znObjects . ix i . ix j
crsInsideCirc :: Point2 -> Float -> World -> StreamOf Creature wlsNearPoint :: Point2 -> World -> StreamOf Wall
crsInsideCirc p r w = S.concat $ S.mapMaybe f $ zoneInsideCirc crZoneSize p r wlsNearPoint = nearPoint wlZoneSize _wallsZone
where
f (V2 i j) = w ^? creaturesZone . znObjects . ix i . ix j
wallsInsideCirc :: Point2 -> Float -> World -> Stream (Of Wall) Identity ()
wallsInsideCirc p r w = S.concat $ S.mapMaybe f $ zoneInsideCirc wlZoneSize p r
where
f (V2 i j) = w ^? wallsZone . znObjects . ix i . ix j
wallsNearPoint :: Point2 -> World -> StreamOf Wall
wallsNearPoint p = S.each . fromMaybe mempty . (^? wallsZone . znObjects . ix x . ix y)
where
V2 x y = wlZoneOfPoint p
flattenIMIMIM :: IM.IntMap (IM.IntMap (IM.IntMap a)) -> IM.IntMap a
flattenIMIMIM = IM.unions . fmap IM.unions
creatureNearPoint :: Point2 -> World -> Maybe Creature
creatureNearPoint = creatureNearPointI 1
creatureNearPointI :: Int -> Point2 -> World -> Maybe Creature
creatureNearPointI n p = L.fold (L.minimumOn (dist p . _crPos)) . creaturesNearPointI n p
crsNearPoint :: Point2 -> World -> StreamOf Creature crsNearPoint :: Point2 -> World -> StreamOf Creature
crsNearPoint p = S.each . fromMaybe mempty . (^? creaturesZone . znObjects . ix x . ix y) crsNearPoint = nearPoint crZoneSize _creaturesZone
where
V2 x y = crZoneOfPoint p
creaturesNearPointI :: Int -> Point2 -> World -> IM.IntMap Creature nearSeg :: Foldable t => Float -> (World -> Zone (t a)) -> Point2 -> Point2 -> World -> StreamOf a
creaturesNearPointI n p w = IM.unions nearSeg s f p r w = S.concat $ S.mapMaybe (extractFromZone (f w))
[f b $ f a $ _znObjects $ _creaturesZone w | a<-[x-n..x+n] , b<-[y-n..y+n]] $ zoneOfSeg s p r
where
V2 x y = crZoneOfPoint p
f i m = fromMaybe IM.empty $ IM.lookup i m
creaturesAlongLine :: Point2 -> Point2 -> World -> Stream (Of Creature) Identity () wlsNearSeg :: Point2 -> Point2 -> World -> Stream (Of Wall) Identity ()
creaturesAlongLine sp ep w = S.concat $ S.mapMaybe f $ zoneOfSeg crZoneSize sp ep wlsNearSeg = nearSeg wlZoneSize _wallsZone
where
f (V2 i j) = w ^? creaturesZone . znObjects . ix i . ix j crsNearSeg :: Point2 -> Point2 -> World -> StreamOf Creature
crsNearSeg = nearSeg crZoneSize _creaturesZone
insideCirc :: Foldable t => Float -> (World -> Zone (t a)) -> Point2 -> Float -> World -> StreamOf a
insideCirc s f p r w = S.concat $ S.mapMaybe (extractFromZone (f w))
$ zoneInsideCirc s p r
wlsInsideCirc :: Point2 -> Float -> World -> Stream (Of Wall) Identity ()
wlsInsideCirc = insideCirc wlZoneSize _wallsZone
crsInsideCirc :: Point2 -> Float -> World -> StreamOf Creature
crsInsideCirc = insideCirc crZoneSize _creaturesZone
wlZoneOfPoint :: Point2 -> Int2
wlZoneOfPoint = zoneOfPoint wlZoneSize
clZoneOfPoint :: Point2 -> Int2
clZoneOfPoint = zoneOfPoint clZoneSize
crZoneOfPoint :: Point2 -> Int2
crZoneOfPoint = zoneOfPoint crZoneSize