64 lines
1.9 KiB
Haskell
64 lines
1.9 KiB
Haskell
module Dodge.Zoning.Creature where
|
|
|
|
import Control.Lens
|
|
import qualified Data.IntSet as IS
|
|
import Data.Maybe
|
|
import Dodge.Creature.Radius
|
|
import Dodge.Data.World
|
|
import Dodge.Zoning.Base
|
|
import Dodge.Zoning.Common
|
|
import FoldableHelp
|
|
import Geometry
|
|
import qualified IntMapHelp as IM
|
|
import Linear
|
|
|
|
crIXsNearPoint :: Point2 -> World -> IS.IntSet
|
|
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
|
|
|
|
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 (cr ^. crPos . _xy) (crRad $ cr ^. crType)
|
|
|
|
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 ::
|
|
IM.IntMap (IM.IntMap IS.IntSet) ->
|
|
Creature ->
|
|
IM.IntMap (IM.IntMap IS.IntSet)
|
|
{-# INLINE zoneCreature #-}
|
|
zoneCreature im cr = foldl' f im (zoneOfCr cr)
|
|
where
|
|
f im' i2 = zoneMonoid i2 (IS.singleton $! _crID cr) im'
|