59 lines
2.0 KiB
Haskell
59 lines
2.0 KiB
Haskell
module Dodge.Zoning.Wall where
|
|
import FoldableHelp
|
|
import Dodge.Data
|
|
import Geometry
|
|
import Dodge.Zoning.Base
|
|
import qualified IntMapHelp as IM
|
|
|
|
import Data.Maybe
|
|
import qualified Data.IntSet as IS
|
|
import Control.Lens
|
|
|
|
wlIXsNearPoint :: Point2 -> World -> IS.IntSet
|
|
wlIXsNearPoint p w = zoneExtract (zoneOfPoint' wlZoneSize p) (w ^. wlZoning)
|
|
|
|
wlIXsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet
|
|
wlIXsNearSeg sp ep w = zonesExtract (w ^. wlZoning) (zoneOfSeg' wlZoneSize sp ep)
|
|
|
|
wlIXsNearRect :: Point2 -> Point2 -> World -> IS.IntSet
|
|
wlIXsNearRect sp ep w = zonesExtract (w ^. wlZoning) $ zoneOfRect' wlZoneSize sp ep
|
|
|
|
wlIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet
|
|
wlIXsNearCirc p r = wlIXsNearRect (p +.+ V2 r r) (p -.- V2 r r)
|
|
|
|
wlsFromIXs :: World -> IS.IntSet -> [Wall]
|
|
wlsFromIXs w = mapMaybe (\wlid -> w ^? walls . ix wlid) . IS.toList
|
|
|
|
wlsNearPoint :: Point2 -> World -> [Wall]
|
|
wlsNearPoint p w = wlsFromIXs w $ wlIXsNearPoint p w
|
|
|
|
wlsNearSeg :: Point2 -> Point2 -> World -> [Wall]
|
|
wlsNearSeg sp ep w = wlsFromIXs w $ wlIXsNearSeg sp ep w
|
|
|
|
wlsNearRect :: Point2 -> Point2 -> World -> [Wall]
|
|
wlsNearRect sp ep w = wlsFromIXs w $ wlIXsNearRect sp ep w
|
|
|
|
wlsNearCirc :: Point2 -> Float -> World -> [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)
|