71 lines
2.1 KiB
Haskell
71 lines
2.1 KiB
Haskell
module Dodge.Zoning.Wall
|
|
( wlsNearSeg
|
|
, wlsNearPoint
|
|
, wlsNearRect
|
|
, wlsNearCirc
|
|
, wlsFromIXs
|
|
, wlZoneSize
|
|
, zoneWall
|
|
, deZoneWall
|
|
) where
|
|
|
|
import Control.Lens
|
|
import qualified Data.IntSet as IS
|
|
import Dodge.Data.World
|
|
import Dodge.Zoning.Base
|
|
import FoldableHelp
|
|
import Geometry
|
|
import qualified IntMapHelp as IM
|
|
import Dodge.Zoning.Common
|
|
|
|
wlIXsNearPoint :: Point2 -> World -> IS.IntSet
|
|
wlIXsNearPoint = nearPoint wlZoneSize _wlZoning
|
|
|
|
wlIXsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet
|
|
{-# INLINE wlIXsNearSeg #-}
|
|
wlIXsNearSeg = nearSeg wlZoneSize _wlZoning
|
|
|
|
wlIXsNearRect :: Point2 -> Point2 -> World -> IS.IntSet
|
|
wlIXsNearRect = nearRect wlZoneSize _wlZoning
|
|
|
|
wlIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet
|
|
wlIXsNearCirc p r = wlIXsNearRect (p +.+ V2 r r) (p -.- V2 r r)
|
|
|
|
wlsFromIXs :: World -> IS.IntSet -> IM.IntMap Wall
|
|
{-# INLINE wlsFromIXs #-}
|
|
wlsFromIXs w = IM.restrictKeys (w ^. cWorld . lWorld . walls)
|
|
|
|
wlsNearPoint :: Point2 -> World -> IM.IntMap Wall
|
|
wlsNearPoint p w = wlsFromIXs w $ wlIXsNearPoint p w
|
|
|
|
wlsNearSeg :: Point2 -> Point2 -> World -> IM.IntMap Wall
|
|
{-# INLINE wlsNearSeg #-}
|
|
wlsNearSeg sp ep w = wlsFromIXs w $ wlIXsNearSeg sp ep w
|
|
|
|
wlsNearRect :: Point2 -> Point2 -> World -> IM.IntMap Wall
|
|
wlsNearRect sp ep w = wlsFromIXs w $ wlIXsNearRect sp ep w
|
|
|
|
wlsNearCirc :: Point2 -> Float -> World -> IM.IntMap Wall
|
|
wlsNearCirc p r w = wlsFromIXs w $ wlIXsNearCirc p r w
|
|
|
|
wlZoneSize :: Float
|
|
wlZoneSize = 50
|
|
|
|
zoneOfWl :: Wall -> [Int2]
|
|
zoneOfWl = uncurry (zoneOfSeg wlZoneSize) . _wlLine
|
|
|
|
--minCrIXOn :: Ord a => (Creature -> a) -> IS.IntSet -> World -> Maybe Creature
|
|
--minCrIXOn f is w = fmap fst $ IS.foldl' g Nothing is
|
|
-- where
|
|
-- g mcrx cid = minOn snd <$> getpair cid <*> mcrx
|
|
-- getpair cid = fmap h $ w ^? creatures . ix cid
|
|
-- h cr = (cr, f cr)
|
|
|
|
zoneWall :: Wall -> IM.IntMap (IM.IntMap IS.IntSet) -> IM.IntMap (IM.IntMap IS.IntSet)
|
|
zoneWall wl im = foldl' f im (zoneOfWl wl)
|
|
where
|
|
f im' i2 = zoneMonoid i2 (IS.singleton $ _wlID wl) im'
|
|
|
|
deZoneWall :: Wall -> IM.IntMap (IM.IntMap IS.IntSet) -> IM.IntMap (IM.IntMap IS.IntSet)
|
|
deZoneWall wl im = foldl' (deZoneIX (_wlID wl)) im (zoneOfWl wl)
|