57 lines
2.0 KiB
Haskell
57 lines
2.0 KiB
Haskell
module Dodge.Zoning.Creature where
|
|
|
|
import Control.Lens
|
|
import qualified Data.IntSet as IS
|
|
import Data.Maybe
|
|
import Dodge.Data.World
|
|
import Dodge.Zoning.Base
|
|
import FoldableHelp
|
|
import Geometry
|
|
import qualified IntMapHelp as IM
|
|
import Dodge.Zoning.Common
|
|
|
|
crIXsNearPoint :: Point2 -> World -> IS.IntSet
|
|
--crIXsNearPoint p w = zoneExtract (zoneOfPoint crZoneSize p) (w ^. cWorld . lWorld . crZoning)
|
|
crIXsNearPoint = nearPoint crZoneSize _crZoning
|
|
|
|
crsNearPoint :: Point2 -> World -> [Creature]
|
|
crsNearPoint p w = mapMaybe (\cid -> w ^? cWorld . lWorld . creatures . ix cid) . IS.toList $ crIXsNearPoint p w
|
|
|
|
crsNearSeg :: Point2 -> Point2 -> World -> [Creature]
|
|
crsNearSeg sp ep w =
|
|
mapMaybe (\cid -> w ^? cWorld . lWorld . creatures . ix cid)
|
|
. IS.toList
|
|
$ crixsNearSeg sp ep w
|
|
|
|
crixsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet
|
|
crixsNearSeg = nearSeg crZoneSize _crZoning
|
|
--crixsNearSeg sp ep w = zonesExtract (w ^. cWorld . lWorld . crZoning) (zoneOfSeg crZoneSize sp ep)
|
|
|
|
crIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet
|
|
crIXsNearCirc p r = crsNearRect (p +.+ V2 r r) (p -.- V2 r r)
|
|
|
|
crsNearCirc :: Point2 -> Float -> World -> [Creature]
|
|
crsNearCirc p r w = mapMaybe (\cid -> w ^? cWorld . lWorld . creatures . ix cid) . IS.toList $ crIXsNearCirc p r w
|
|
|
|
crsNearRect :: Point2 -> Point2 -> World -> IS.IntSet
|
|
crsNearRect = nearRect crZoneSize _crZoning
|
|
|
|
crZoneSize :: Float
|
|
crZoneSize = 15
|
|
|
|
zoneOfCr :: Creature -> [Int2]
|
|
zoneOfCr cr = zoneOfCirc crZoneSize (_crPos cr) (_crRad cr)
|
|
|
|
minCrIXOn :: Ord a => (Creature -> a) -> IS.IntSet -> World -> Maybe Creature
|
|
minCrIXOn f is w = fst <$> IS.foldl' g Nothing is
|
|
where
|
|
g mcrx cid = minOn snd <$> getpair cid <*> mcrx
|
|
getpair cid = fmap h $ w ^? cWorld . lWorld . creatures . ix cid
|
|
h cr = (cr, f cr)
|
|
|
|
zoneCreature :: Creature -> IM.IntMap (IM.IntMap IS.IntSet) -> IM.IntMap (IM.IntMap IS.IntSet)
|
|
{-# INLINE zoneCreature #-}
|
|
zoneCreature cr im = foldl' f im (zoneOfCr cr)
|
|
where
|
|
f im' i2 = zoneMonoid i2 (IS.singleton $ _crID cr) im'
|