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

Refactor wall zoning, remove streaming

Browse Source
This commit is contained in:
justin
2022-07-23 12:29:29 +01:00
parent 39f4555697
commit 39778f46fb
30 changed files with 396 additions and 163 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Zoning/Creature.hs
+10 -16
View File
@@ -3,22 +3,22 @@ import FoldableHelp
import Dodge.Data
import Geometry
import Dodge.Zoning.Base
import qualified FoldlHelp as L
--import qualified FoldlHelp as L
import qualified IntMapHelp as IM
import Data.Maybe
import Data.Function
--import Data.Function
import qualified Data.IntSet as IS
import Control.Lens
crIXsNearPoint :: Point2 -> World -> IS.IntSet
crIXsNearPoint p w = zoneExtract (zoneOfPoint' crZoneSize p) (w ^. crZoning . getCrZoning)
crIXsNearPoint p w = zoneExtract (zoneOfPoint' crZoneSize p) (w ^. crZoning)
crsNearPoint :: Point2 -> World -> [Creature]
crsNearPoint p w = mapMaybe (\cid -> w ^? creatures . ix cid) . IS.toList $ crIXsNearPoint p w
crsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet
crsNearSeg sp ep w = zonesExtract (w ^. crZoning . getCrZoning) (zoneOfSeg' crZoneSize sp ep)
crsNearSeg sp ep w = zonesExtract (w ^. crZoning) (zoneOfSeg' crZoneSize sp ep)
crIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet
crIXsNearCirc p r = crsNearRect (p +.+ V2 r r) (p -.- V2 r r)
@@ -27,7 +27,7 @@ crsNearCirc :: Point2 -> Float -> World -> [Creature]
crsNearCirc p r w = mapMaybe (\cid -> w ^? creatures . ix cid) . IS.toList $ crIXsNearCirc p r w
crsNearRect :: Point2 -> Point2 -> World -> IS.IntSet
crsNearRect sp ep w = zonesExtract (w ^. crZoning . getCrZoning) $ zoneOfRect' crZoneSize sp ep
crsNearRect sp ep w = zonesExtract (w ^. crZoning) $ zoneOfRect' crZoneSize sp ep
crZoneSize :: Float
crZoneSize = 15
@@ -36,19 +36,13 @@ 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 = fmap fst $ IS.foldl' (g w) Nothing is
minCrIXOn f is w = fmap fst $ IS.foldl' g Nothing is
where
g w mcrx cid = minOn snd <$> getpair cid <*> mcrx
g mcrx cid = minOn snd <$> getpair cid <*> mcrx
getpair cid = fmap h $ w ^? creatures . ix cid
h cr = (cr, f cr)
zoneCreature :: Creature -> CrZoning -> CrZoning
zoneCreature cr = over getCrZoning (zoneCr' cr)
zoneCr' :: Creature -> IM.IntMap (IM.IntMap IS.IntSet) -> IM.IntMap (IM.IntMap IS.IntSet)
zoneCr' cr im = foldl' f im (zoneOfCr cr)
zoneCreature :: Creature -> IM.IntMap (IM.IntMap IS.IntSet) -> IM.IntMap (IM.IntMap IS.IntSet)
zoneCreature cr im = foldl' f im (zoneOfCr cr)
where
f im i2 = zoneMonoid i2 (IS.singleton $ _crID cr) im
--crsInZones :: [Int2] -> CrZoning -> IS.IntSet
--crsInZones is
f im' i2 = zoneMonoid i2 (IS.singleton $ _crID cr) im'