Separate out concrete part of world

This commit is contained in:
2022-07-25 12:10:50 +01:00
parent 3354d108be
commit b2efbd2b3e
134 changed files with 933 additions and 930 deletions
+3 -3
View File
@@ -10,13 +10,13 @@ import Control.Lens
import qualified IntMapHelp as IM
clsNearPoint :: Point2 -> World -> [Cloud]
clsNearPoint p w = zoneExtract (zoneOfPoint' clZoneSize p) (w ^. clZoning)
clsNearPoint p w = zoneExtract (zoneOfPoint' clZoneSize p) (w ^. cWorld . clZoning)
clsNearSeg :: Point2 -> Point2 -> World -> [Cloud]
clsNearSeg sp ep w = zonesExtract (w ^. clZoning) (zoneOfSeg' clZoneSize sp ep)
clsNearSeg sp ep w = zonesExtract (w ^. cWorld . clZoning) (zoneOfSeg' clZoneSize sp ep)
clsNearRect :: Point2 -> Point2 -> World -> [Cloud]
clsNearRect sp ep w = zonesExtract (w ^. clZoning) $ zoneOfRect' clZoneSize sp ep
clsNearRect sp ep w = zonesExtract (w ^. cWorld . clZoning) $ zoneOfRect' clZoneSize sp ep
clsNearCirc :: Point2 -> Float -> World -> [Cloud]
clsNearCirc p r = clsNearRect (p +.+ V2 r r) (p -.- V2 r r)
+6 -6
View File
@@ -12,22 +12,22 @@ import qualified Data.IntSet as IS
import Control.Lens
crIXsNearPoint :: Point2 -> World -> IS.IntSet
crIXsNearPoint p w = zoneExtract (zoneOfPoint' crZoneSize p) (w ^. crZoning)
crIXsNearPoint p w = zoneExtract (zoneOfPoint' crZoneSize p) (w ^. cWorld . crZoning)
crsNearPoint :: Point2 -> World -> [Creature]
crsNearPoint p w = mapMaybe (\cid -> w ^? creatures . ix cid) . IS.toList $ crIXsNearPoint p w
crsNearPoint p w = mapMaybe (\cid -> w ^? cWorld . creatures . ix cid) . IS.toList $ crIXsNearPoint p w
crsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet
crsNearSeg sp ep w = zonesExtract (w ^. crZoning) (zoneOfSeg' crZoneSize sp ep)
crsNearSeg sp ep w = zonesExtract (w ^. cWorld . crZoning) (zoneOfSeg' crZoneSize sp ep)
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 ^? creatures . ix cid) . IS.toList $ crIXsNearCirc p r w
crsNearCirc p r w = mapMaybe (\cid -> w ^? cWorld . creatures . ix cid) . IS.toList $ crIXsNearCirc p r w
crsNearRect :: Point2 -> Point2 -> World -> IS.IntSet
crsNearRect sp ep w = zonesExtract (w ^. crZoning) $ zoneOfRect' crZoneSize sp ep
crsNearRect sp ep w = zonesExtract (w ^. cWorld . crZoning) $ zoneOfRect' crZoneSize sp ep
crZoneSize :: Float
crZoneSize = 15
@@ -39,7 +39,7 @@ 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 ^? creatures . ix cid
getpair cid = fmap h $ w ^? cWorld . creatures . ix cid
h cr = (cr, f cr)
zoneCreature :: Creature -> IM.IntMap (IM.IntMap IS.IntSet) -> IM.IntMap (IM.IntMap IS.IntSet)
+6 -6
View File
@@ -10,13 +10,13 @@ import Control.Lens
import qualified IntMapHelp as IM
pnsNearPoint :: Point2 -> World -> [(Int,Point2)]
pnsNearPoint p w = zoneExtract (zoneOfPoint' pnZoneSize p) (w ^. pnZoning)
pnsNearPoint p w = zoneExtract (zoneOfPoint' pnZoneSize p) (w ^. cWorld . pnZoning)
pnsNearSeg :: Point2 -> Point2 -> World -> [(Int,Point2)]
pnsNearSeg sp ep w = zonesExtract (w ^. pnZoning) (zoneOfSeg' pnZoneSize sp ep)
pnsNearSeg sp ep w = zonesExtract (w ^. cWorld . pnZoning) (zoneOfSeg' pnZoneSize sp ep)
pnsNearRect :: Point2 -> Point2 -> World -> [(Int,Point2)]
pnsNearRect sp ep w = zonesExtract (w ^. pnZoning) $ zoneOfRect' pnZoneSize sp ep
pnsNearRect sp ep w = zonesExtract (w ^. cWorld . pnZoning) $ zoneOfRect' pnZoneSize sp ep
pnsNearCirc :: Point2 -> Float -> World -> [(Int,Point2)]
pnsNearCirc p r = pnsNearRect (p +.+ V2 r r) (p -.- V2 r r)
@@ -33,13 +33,13 @@ zonePn pn = zoneMonoid (zoneOfPn pn) [pn]
pesNearPoint :: Point2 -> World -> [(Int,Int,PathEdge)]
pesNearPoint p w = zoneExtract (zoneOfPoint' peZoneSize p) (w ^. peZoning)
pesNearPoint p w = zoneExtract (zoneOfPoint' peZoneSize p) (w ^. cWorld . peZoning)
pesNearSeg :: Point2 -> Point2 -> World -> [(Int,Int,PathEdge)]
pesNearSeg sp ep w = zonesExtract (w ^. peZoning) (zoneOfSeg' peZoneSize sp ep)
pesNearSeg sp ep w = zonesExtract (w ^. cWorld . peZoning) (zoneOfSeg' peZoneSize sp ep)
pesNearRect :: Point2 -> Point2 -> World -> [(Int,Int,PathEdge)]
pesNearRect sp ep w = zonesExtract (w ^. peZoning) $ zoneOfRect' peZoneSize sp ep
pesNearRect sp ep w = zonesExtract (w ^. cWorld . peZoning) $ zoneOfRect' peZoneSize sp ep
pesNearCirc :: Point2 -> Float -> World -> [(Int,Int,PathEdge)]
pesNearCirc p r = pesNearRect (p +.+ V2 r r) (p -.- V2 r r)
+4 -4
View File
@@ -10,19 +10,19 @@ import qualified Data.IntSet as IS
import Control.Lens
wlIXsNearPoint :: Point2 -> World -> IS.IntSet
wlIXsNearPoint p w = zoneExtract (zoneOfPoint' wlZoneSize p) (w ^. wlZoning)
wlIXsNearPoint p w = zoneExtract (zoneOfPoint' wlZoneSize p) (w ^. cWorld . wlZoning)
wlIXsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet
wlIXsNearSeg sp ep w = zonesExtract (w ^. wlZoning) (zoneOfSeg' wlZoneSize sp ep)
wlIXsNearSeg sp ep w = zonesExtract (w ^. cWorld . wlZoning) (zoneOfSeg' wlZoneSize sp ep)
wlIXsNearRect :: Point2 -> Point2 -> World -> IS.IntSet
wlIXsNearRect sp ep w = zonesExtract (w ^. wlZoning) $ zoneOfRect' wlZoneSize sp ep
wlIXsNearRect sp ep w = zonesExtract (w ^. cWorld . 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
wlsFromIXs w = mapMaybe (\wlid -> w ^? cWorld . walls . ix wlid) . IS.toList
wlsNearPoint :: Point2 -> World -> [Wall]
wlsNearPoint p w = wlsFromIXs w $ wlIXsNearPoint p w
+1 -1
View File
@@ -10,7 +10,7 @@ zoneOfSight' s w =
]
where
--(xs,ys) = unzip $ map zoneOfPoint $ screenPolygon cfig w -- ++ [_cameraViewFrom w]
(xs,ys) = unzip $ map sizeZoneOfPoint $ _boundBox w -- ++ [_cameraViewFrom w]
(xs,ys) = unzip $ map sizeZoneOfPoint $ _boundBox (_cWorld w) -- ++ [_cameraViewFrom w]
sizeZoneOfPoint (V2 x y) = (f x, f y)
where
f = floor . (/ s)