Cleanup, move towards unifying zones

This commit is contained in:
2021-09-11 15:52:43 +01:00
parent 27e4f16dd9
commit aa7413a29f
57 changed files with 157 additions and 331 deletions
+6 -12
View File
@@ -6,7 +6,8 @@ Consider splitting. -}
module Dodge.Base
where
import Dodge.Data
import Dodge.Base.Zone
import Dodge.Zone
import Dodge.Zone.Data
import Dodge.Base.Window
import Geometry
--import Picture
@@ -68,10 +69,10 @@ wallsOnCirc p r = IM.filter f
f wl = uncurry circOnSeg (_wlLine wl) p r
allWalls :: World -> IM.IntMap Wall
allWalls w = IM.unions $ concatMap IM.elems $ IM.elems $ _wallsZone w
allWalls w = IM.unions $ concatMap IM.elems $ IM.elems $ _znObjects $ _wallsZone w
creaturesNearPoint :: Point2 -> World -> IM.IntMap Creature
creaturesNearPoint p w = IM.unions [f b $ f a $ _creaturesZone w | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
creaturesNearPoint p w = IM.unions [f b $ f a $ _znObjects $ _creaturesZone w | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
where
(x,y) = crZoneOfPoint p
f i m = case IM.lookup i m of
@@ -79,27 +80,20 @@ creaturesNearPoint p w = IM.unions [f b $ f a $ _creaturesZone w | a<-[x-1,x,x+
_ -> IM.empty
creaturesNearPointI :: Int -> Point2 -> World -> IM.IntMap Creature
creaturesNearPointI n p w = IM.unions [f b $ f a $ _creaturesZone w | a<-[x-n..x+n] , b<-[y-n..y+n]]
creaturesNearPointI n p w = IM.unions [f b $ f a $ _znObjects $ _creaturesZone w | a<-[x-n..x+n] , b<-[y-n..y+n]]
where
(x,y) = crZoneOfPoint p
f i m = case IM.lookup i m of
Just val -> val
_ -> IM.empty
cloudsNearPoint :: Point2 -> World -> [Cloud]
--cloudsNearPoint p w = IM.unions [f b $ f a $ _cloudsZone w | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
cloudsNearPoint p w = f (IM.lookup x (_cloudsZone w) >>= IM.lookup y)
where
(x,y) = cloudZoneOfPoint p
f Nothing = []
f (Just l) = l
-- possible BUG, occurs when used in thingsHitLongLine
creaturesAlongLine :: Point2 -> Point2 -> World -> IM.IntMap Creature
--creaturesAlongLine a b w = IM.unions [f y $ f x $ _creaturesZone w | (x,y) <- zoneOfLine a b]
-- where f i m = case IM.lookup i m of Just val -> val
-- _ -> IM.empty
creaturesAlongLine a b w = IM.foldrWithKey' g IM.empty kps
where g x s = IM.union (IM.unions (IM.restrictKeys (f x $ _creaturesZone w) s))
where g x s = IM.union (IM.unions (IM.restrictKeys (f x $ _znObjects $ _creaturesZone w) s))
kps = zoneOfLineIntMap a b
f i m = case IM.lookup i m of Just val -> val
_ -> IM.empty