Move zoning up world spheres
This commit is contained in:
Binary file not shown.
|
Before Width: | Height: | Size: 3.4 KiB After Width: | Height: | Size: 3.4 KiB |
@@ -9,6 +9,7 @@ module Dodge.Data.CWorld (
|
||||
module Dodge.Data.CamPos
|
||||
) where
|
||||
|
||||
import Geometry.Data
|
||||
import Dodge.Data.LWorld
|
||||
import Control.Lens
|
||||
import Data.Aeson
|
||||
@@ -27,6 +28,7 @@ data CWorld = CWorld
|
||||
, _pastWorlds :: [LWorld]
|
||||
, _timeFlow :: TimeFlowStatus
|
||||
, _seenWalls :: IS.IntSet
|
||||
, _floorTiles :: [(Point3, Point3)]
|
||||
}
|
||||
|
||||
data TimeFlowStatus
|
||||
|
||||
@@ -47,12 +47,10 @@ module Dodge.Data.LWorld (
|
||||
module Dodge.Data.WorldEffect,
|
||||
) where
|
||||
|
||||
import Data.Set (Set)
|
||||
import Control.Lens
|
||||
import Data.Aeson
|
||||
import Data.Aeson.TH
|
||||
import Data.Graph.Inductive
|
||||
import qualified Data.IntSet as IS
|
||||
import Dodge.Data.Beam
|
||||
import Dodge.Data.Block
|
||||
import Dodge.Data.Bounds
|
||||
@@ -99,13 +97,10 @@ import Picture.Data
|
||||
|
||||
data LWorld = LWorld
|
||||
{ _creatures :: IM.IntMap Creature
|
||||
, _crZoning :: IM.IntMap (IM.IntMap IS.IntSet)
|
||||
, _creatureGroups :: IM.IntMap CrGroupParams
|
||||
, _itemLocations :: IM.IntMap ItemLocation
|
||||
, _clouds :: [Cloud]
|
||||
, _clZoning :: IM.IntMap (IM.IntMap [Cloud])
|
||||
, _gusts :: IM.IntMap Gust
|
||||
, _gsZoning :: IM.IntMap (IM.IntMap IS.IntSet)
|
||||
, _props :: IM.IntMap Prop
|
||||
, _projectiles :: IM.IntMap Proj
|
||||
, _instantBullets :: [Bullet]
|
||||
@@ -134,9 +129,7 @@ data LWorld = LWorld
|
||||
, _blocks :: IM.IntMap Block
|
||||
, _coordinates :: IM.IntMap Point2
|
||||
, _triggers :: IM.IntMap Bool
|
||||
, _wlZoning :: IM.IntMap (IM.IntMap IS.IntSet) -- Zoning IM.IntMap Wall
|
||||
, _floorItems :: IM.IntMap FloorItem
|
||||
, _floorTiles :: [(Point3, Point3)]
|
||||
, _modifications :: IM.IntMap Modification
|
||||
, _worldEvents :: [WdWd]
|
||||
, _delayedEvents :: [(Int, WdWd)]
|
||||
@@ -146,8 +139,6 @@ data LWorld = LWorld
|
||||
, _foregroundShapes :: IM.IntMap ForegroundShape
|
||||
, _corpses :: IM.IntMap Corpse
|
||||
, _pathGraph :: Gr Point2 PathEdge
|
||||
, _pnZoning :: IM.IntMap (IM.IntMap [(Int, Point2)]) --Zoning IM.IntMap Creature
|
||||
, _peZoning :: IM.IntMap (IM.IntMap (Set PathEdgeNodes))
|
||||
, _lightSources :: IM.IntMap LightSource
|
||||
, _tempLightSources :: [TempLightSource]
|
||||
, _seenLocations :: IM.IntMap (WdP2, String)
|
||||
|
||||
@@ -13,6 +13,9 @@ module Dodge.Data.World (
|
||||
module Dodge.Data.Input,
|
||||
) where
|
||||
|
||||
import Geometry.Data
|
||||
import Data.IntMap.Strict (IntMap)
|
||||
import Data.IntSet (IntSet)
|
||||
import Data.Set (Set)
|
||||
import Dodge.Data.SaveSlot
|
||||
import Control.Lens
|
||||
@@ -39,6 +42,12 @@ data World = World
|
||||
, _rbOptions :: RightButtonOptions
|
||||
, _hud :: HUD
|
||||
, _worldEventFlags :: Set WorldEventFlag
|
||||
, _crZoning :: IntMap (IntMap IntSet)
|
||||
, _clZoning :: IntMap (IntMap [Cloud])
|
||||
, _wlZoning :: IntMap (IntMap IntSet) -- Zoning IM.IntMap Wall
|
||||
, _pnZoning :: IntMap (IntMap [(Int, Point2)]) --Zoning IM.IntMap Creature
|
||||
, _peZoning :: IntMap (IntMap (Set PathEdgeNodes))
|
||||
, _gsZoning :: IntMap (IntMap IntSet)
|
||||
}
|
||||
|
||||
-- deriving (Eq, Ord, Show, Read) --Generic, Flat)
|
||||
|
||||
@@ -41,6 +41,12 @@ defaultWorld =
|
||||
, _rbOptions = NoRightButtonOptions
|
||||
, _hud = defaultHUD
|
||||
, _worldEventFlags = mempty
|
||||
, _crZoning = mempty
|
||||
, _clZoning = mempty
|
||||
, _wlZoning = mempty
|
||||
, _pnZoning = mempty
|
||||
, _peZoning = mempty
|
||||
, _gsZoning = mempty --Zoning IM.empty clZoneSize (zonePos _guPos)
|
||||
}
|
||||
|
||||
defaultCWGen :: CWGen
|
||||
@@ -77,6 +83,7 @@ defaultCWorld =
|
||||
, _pastWorlds = []
|
||||
, _timeFlow = NormalTimeFlow
|
||||
, _seenWalls = mempty
|
||||
, _floorTiles = mempty
|
||||
}
|
||||
|
||||
defaultLWorld :: LWorld
|
||||
@@ -85,12 +92,9 @@ defaultLWorld =
|
||||
{ _magnets = IM.empty
|
||||
, _modifications = IM.empty
|
||||
, _creatures = IM.empty
|
||||
, _crZoning = mempty --Zoning IM.empty crZoneSize zoneOfCreature
|
||||
, _creatureGroups = IM.empty
|
||||
, _clouds = mempty
|
||||
, _clZoning = mempty
|
||||
, _gusts = IM.empty
|
||||
, _gsZoning = mempty --Zoning IM.empty clZoneSize (zonePos _guPos)
|
||||
, _itemLocations = IM.empty
|
||||
, _props = IM.empty
|
||||
, _projectiles = IM.empty
|
||||
@@ -119,9 +123,7 @@ defaultLWorld =
|
||||
, _doors = IM.empty
|
||||
, _coordinates = IM.empty
|
||||
, _triggers = IM.empty
|
||||
, _wlZoning = IM.empty --Zoning IM.empty wlZoneSize zoneOfWall
|
||||
, _floorItems = IM.empty
|
||||
, _floorTiles = []
|
||||
, _worldEvents = []
|
||||
, _delayedEvents = []
|
||||
, _pressPlates = IM.empty
|
||||
@@ -129,8 +131,6 @@ defaultLWorld =
|
||||
, _corpses = IM.empty
|
||||
, _decorations = IM.empty
|
||||
, _pathGraph = Data.Graph.Inductive.Graph.empty
|
||||
, _pnZoning = mempty
|
||||
, _peZoning = mempty
|
||||
, _lightSources = IM.empty
|
||||
, _tempLightSources = []
|
||||
, _seenLocations =
|
||||
|
||||
+7
-17
@@ -4,7 +4,6 @@ module Dodge.Layout (
|
||||
) where
|
||||
|
||||
import qualified Control.Foldl as L
|
||||
import Dodge.Item.Location.Initialize
|
||||
import Control.Lens
|
||||
import Data.Foldable
|
||||
import Data.Function
|
||||
@@ -16,6 +15,7 @@ import Data.Traversable
|
||||
import Dodge.Data.GenWorld
|
||||
import Dodge.Default.Wall
|
||||
import Dodge.GameRoom
|
||||
import Dodge.Item.Location.Initialize
|
||||
import Dodge.LevelGen.LevelStructure
|
||||
import Dodge.LevelGen.StaticWalls
|
||||
import Dodge.Path
|
||||
@@ -45,8 +45,8 @@ generateLevelFromRoomList gr' w =
|
||||
$ w & cWorld . lWorld . walls .~ wallsFromRooms rs
|
||||
& cWorld . cwGen . cwgGameRooms .~ gameRoomsFromRooms (IM.elems rs')
|
||||
& cWorld . lWorld . pathGraph .~ path
|
||||
& cWorld . lWorld . pnZoning .~ foldl' (flip zonePn) mempty (labNodes path)
|
||||
& cWorld . lWorld . peZoning .~ foldl' (flip zonePe) mempty (map fromEdgeTuple $ labEdges path)
|
||||
& pnZoning .~ foldl' (flip zonePn) mempty (labNodes path)
|
||||
& peZoning .~ foldl' (flip zonePe) mempty (map fromEdgeTuple $ labEdges path)
|
||||
where
|
||||
(_, path) = pairsToGraph pairPath'
|
||||
pairPath = foldMap _rmPath rs
|
||||
@@ -54,14 +54,14 @@ generateLevelFromRoomList gr' w =
|
||||
rs = map doRoomShift $ IM.elems rs'
|
||||
rs' = mapM shuffleRoomPos gr' & evalState $ _randGen w
|
||||
|
||||
fromEdgeTuple :: (Int,Int,PathEdge) -> PathEdgeNodes
|
||||
fromEdgeTuple (a,b,pe) = PathEdgeNodes a b pe
|
||||
fromEdgeTuple :: (Int, Int, PathEdge) -> PathEdgeNodes
|
||||
fromEdgeTuple (a, b, pe) = PathEdgeNodes a b pe
|
||||
|
||||
randomCompass :: World -> World
|
||||
randomCompass w = w & cWorld . camPos . camRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w)
|
||||
|
||||
putFloorTiles :: GenWorld -> GenWorld
|
||||
putFloorTiles gw = gw & gwWorld . cWorld . lWorld . floorTiles .~ floorsFromGenWorld gw
|
||||
putFloorTiles gw = gw & gwWorld . cWorld . floorTiles .~ floorsFromGenWorld gw
|
||||
|
||||
setFloors :: GenWorld -> GenWorld
|
||||
setFloors = putFloorTiles . setTiles
|
||||
@@ -139,7 +139,7 @@ setupWorldBounds w =
|
||||
)
|
||||
where
|
||||
f = fromMaybe 0
|
||||
ps = IM.map (fst . _wlLine) $ w ^. cWorld . lWorld . walls-- _walls (_cWorld w)
|
||||
ps = IM.map (fst . _wlLine) $ w ^. cWorld . lWorld . walls -- _walls (_cWorld w)
|
||||
(minx, maxx, miny, maxy) =
|
||||
L.fold
|
||||
( (,,,)
|
||||
@@ -150,16 +150,6 @@ setupWorldBounds w =
|
||||
)
|
||||
ps
|
||||
|
||||
--polyhedrasToEdges :: [Polyhedra] -> [Point3]
|
||||
--polyhedrasToEdges = concatMap tflat4 . concatMap polyToEdges
|
||||
|
||||
initWallZoning :: World -> World
|
||||
initWallZoning w = foldl' (flip insertWallInZones) (w & cWorld . lWorld . wlZoning .~ IM.empty)
|
||||
(w ^. cWorld . lWorld . walls)
|
||||
|
||||
--makePath :: Tree Room -> [(Point2,Point2)]
|
||||
--makePath = concatMap _rmPath . flatten
|
||||
|
||||
wallsFromRooms :: [Room] -> IM.IntMap Wall
|
||||
wallsFromRooms =
|
||||
-- divideWalls .
|
||||
|
||||
+1
-1
@@ -49,7 +49,7 @@ walkableNodeNear :: World -> Point2 -> Maybe Int
|
||||
{-# INLINE walkableNodeNear #-}
|
||||
walkableNodeNear w p = fmap fst . find (flip (isWalkable p) w . snd) $ nodesNear
|
||||
where
|
||||
nodesNear = zonesExtract (w ^. cWorld . lWorld . pnZoning) $ zonesAroundPoint pnZoneSize p
|
||||
nodesNear = zonesExtract (w ^. pnZoning) $ zonesAroundPoint pnZoneSize p
|
||||
|
||||
makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2]
|
||||
--makePathBetweenPs a b w = mapMaybe (lab $ _pathGraph (_cWorld w)) <$> makePathBetween a b w
|
||||
|
||||
+1
-1
@@ -63,7 +63,7 @@ doDrawing pdata u = do
|
||||
(shadVBOptr $ _textureArrayShader pdata)
|
||||
wallPointsCol
|
||||
windowPoints
|
||||
(w ^. cWorld . lWorld . floorTiles)
|
||||
(w ^. cWorld . floorTiles)
|
||||
)
|
||||
( pokeShape
|
||||
(_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata)
|
||||
|
||||
@@ -25,7 +25,7 @@ wallsToDraw w =
|
||||
<*> L.prefilter wlSeeThroughDraw (L.premap f L.list)
|
||||
<*> L.premap getWallSPic L.mconcat
|
||||
)
|
||||
(wlsFromIXs w $ zonesExtract (w ^. cWorld . lWorld . wlZoning) $ zoneOfSight wlZoneSize cam)
|
||||
(wlsFromIXs w $ zonesExtract (w ^. wlZoning) $ zoneOfSight wlZoneSize cam)
|
||||
cam = w ^. cWorld . camPos
|
||||
|
||||
--wallsToDraw
|
||||
|
||||
+13
-1
@@ -8,6 +8,10 @@ module Dodge.Save (
|
||||
reloadLevelStart,
|
||||
) where
|
||||
|
||||
import Data.Graph.Inductive (labEdges, labNodes)
|
||||
import Dodge.Zoning.Pathing
|
||||
import Data.Foldable
|
||||
import Dodge.Wall.Zone
|
||||
import Dodge.Concurrent
|
||||
import Control.Lens
|
||||
import Dodge.Data.SaveSlot
|
||||
@@ -32,7 +36,6 @@ writeSaveSlot ss u = do
|
||||
(u ^. uvWorld . cWorld)
|
||||
return Just
|
||||
|
||||
|
||||
readSaveSlot :: SaveSlot -> IO (Universe -> Maybe Universe)
|
||||
readSaveSlot ss = do
|
||||
fExists <- doesFileExist $ saveSlotPath ss
|
||||
@@ -42,11 +45,20 @@ readSaveSlot ss = do
|
||||
case cwstr of
|
||||
Nothing -> putStrLn "loadSaveSlot failed to read saved file" >> return removescreenlayers
|
||||
Just cw -> return $ \uv -> Just $ uv & uvWorld . cWorld .~ cw
|
||||
& uvWorld %~ initWallZoning
|
||||
& uvWorld . pnZoning .~ foldl' (flip zonePn) mempty
|
||||
(labNodes $ path uv)
|
||||
& uvWorld . peZoning .~ foldl' (flip zonePe) mempty
|
||||
(map fromEdgeTuple $ labEdges $ path uv)
|
||||
& uvScreenLayers .~ []
|
||||
else putStrLn "loadSaveSlot failed to find saved file" >> return removescreenlayers
|
||||
where
|
||||
path uv = uv ^. uvWorld . cWorld . lWorld . pathGraph
|
||||
removescreenlayers = Just . (uvScreenLayers .~ [])
|
||||
|
||||
fromEdgeTuple :: (Int, Int, PathEdge) -> PathEdgeNodes
|
||||
fromEdgeTuple (a, b, pe) = PathEdgeNodes a b pe
|
||||
|
||||
saveSlotPath :: SaveSlot -> String
|
||||
saveSlotPath (SaveSlotNum i) = "saveSlot/" ++ show i
|
||||
saveSlotPath QuicksaveSlot = "saveSlot/QuickSave"
|
||||
|
||||
+4
-8
@@ -202,7 +202,6 @@ functionalUpdate w =
|
||||
. over uvWorld ppEvents
|
||||
. colCrsWalls
|
||||
. over uvWorld simpleCrSprings
|
||||
. over uvWorld zoneCreatures
|
||||
. over uvWorld (updateIMl (_doors . _lWorld . _cWorld) (doDrWdWd . _drMech))
|
||||
. over uvWorld doWorldEvents
|
||||
. over uvWorld updateDelayedEvents
|
||||
@@ -226,7 +225,6 @@ functionalUpdate w =
|
||||
. over uvWorld updateLightSources
|
||||
. over uvWorld updateClouds
|
||||
. over uvWorld updateGusts
|
||||
. over uvWorld zoneClouds
|
||||
. over uvWorld (updateMIM (cWorld . lWorld . magnets) (doMagnetUpdate . _mgUpdate))
|
||||
. over uvWorld (updateIMl' (_terminals . _lWorld . _cWorld) tmUpdate)
|
||||
-- . updateIMl _machines mcChooseUpdate
|
||||
@@ -241,6 +239,8 @@ functionalUpdate w =
|
||||
. over uvWorld updateRBList
|
||||
. over uvWorld updateCloseObjects
|
||||
. over uvWorld updateWheelEvents
|
||||
. over uvWorld zoneClouds
|
||||
. over uvWorld zoneCreatures
|
||||
-- . over uvWorld updateInventorySelectionList
|
||||
$ over (uvWorld . cWorld) updatePastWorlds w
|
||||
|
||||
@@ -278,11 +278,7 @@ updateLasers w =
|
||||
(w', ls) = mapAccumR updateLaser w (w ^. cWorld . lWorld . lasers)
|
||||
|
||||
zoneClouds :: World -> World
|
||||
zoneClouds w =
|
||||
w
|
||||
& cWorld . lWorld . clZoning .~ mempty
|
||||
& cWorld . lWorld . clZoning %~ \zn ->
|
||||
foldl' (flip zoneCloud) zn (w ^. cWorld . lWorld . clouds)
|
||||
zoneClouds w = w & clZoning .~ foldl' (flip zoneCloud) mempty (w ^. cWorld . lWorld . clouds)
|
||||
|
||||
updateWorldSelect' :: World -> World
|
||||
updateWorldSelect' w = over input (updateWorldSelect (w ^. cWorld . camPos)) w
|
||||
@@ -358,7 +354,7 @@ setOldPos cr =
|
||||
-- Nothing' -> w & timeFlow .~ NormalTimeFlow
|
||||
|
||||
zoneCreatures :: World -> World
|
||||
zoneCreatures w = w & cWorld . lWorld . crZoning
|
||||
zoneCreatures w = w & crZoning
|
||||
.~ foldl' (flip zoneCreature) mempty (w ^. cWorld . lWorld . creatures)
|
||||
|
||||
-- foldl' (flip $ updateZoning (\cr -> IM.insert (_crID cr) cr))
|
||||
|
||||
+14
-10
@@ -1,21 +1,25 @@
|
||||
module Dodge.Wall.Zone where
|
||||
module Dodge.Wall.Zone
|
||||
( initWallZoning
|
||||
, insertWallInZones
|
||||
, deleteWallFromZones
|
||||
) where
|
||||
|
||||
import Data.Foldable
|
||||
import Control.Lens
|
||||
import Dodge.Data.World
|
||||
import Dodge.Zoning.Wall
|
||||
|
||||
initWallZoning :: World -> World
|
||||
initWallZoning w = foldl'
|
||||
(flip insertWallInZones)
|
||||
(w & wlZoning .~ mempty)
|
||||
(w ^. cWorld . lWorld . walls)
|
||||
|
||||
-- need to verify that this not only inserts but also overwrites (updates) any
|
||||
-- already existing walls
|
||||
insertWallInZones :: Wall -> World -> World
|
||||
insertWallInZones wl = cWorld . lWorld . wlZoning %~ zoneWall wl
|
||||
|
||||
--insertWallInZones wl = wlZoning %~ updateZoning (IM.insert (_wlID wl)) wl
|
||||
--insertWallInZones wl = wlZoning .updatets
|
||||
-- %~ (runIdentity . (\wlzns -> S.fold_ doinsert wlzns id (zoneOfWall wl)))
|
||||
-- where
|
||||
-- doinsert wlzns (V2 x y) = insertIMInZone x y (_wlID wl) wl wlzns
|
||||
insertWallInZones = over wlZoning . zoneWall
|
||||
|
||||
deleteWallFromZones :: Wall -> World -> World
|
||||
deleteWallFromZones wl = cWorld . lWorld . wlZoning %~ deZoneWall wl
|
||||
deleteWallFromZones = over wlZoning . deZoneWall
|
||||
|
||||
-- %~ flip (foldl' (flip $ \(a,b) updateeIMInZone a b (_wlID wl))) (zoneOfWall wl)
|
||||
|
||||
@@ -7,14 +7,13 @@ import qualified IntMapHelp as IM
|
||||
import Dodge.Zoning.Common
|
||||
|
||||
clsNearPoint :: Point2 -> World -> [Cloud]
|
||||
--clsNearPoint p w = zoneExtract (zoneOfPoint clZoneSize p) (w ^. cWorld . lWorld . clZoning)
|
||||
clsNearPoint = nearPoint clZoneSize _clZoning
|
||||
clsNearPoint = nearPoint' clZoneSize _clZoning
|
||||
|
||||
clsNearSeg :: Point2 -> Point2 -> World -> [Cloud]
|
||||
clsNearSeg = nearSeg clZoneSize _clZoning
|
||||
clsNearSeg = nearSeg' clZoneSize _clZoning
|
||||
|
||||
clsNearRect :: Point2 -> Point2 -> World -> [Cloud]
|
||||
clsNearRect = nearRect clZoneSize _clZoning
|
||||
clsNearRect = nearRect' clZoneSize _clZoning
|
||||
|
||||
clsNearCirc :: Point2 -> Float -> World -> [Cloud]
|
||||
clsNearCirc p r = clsNearRect (p +.+ V2 r r) (p -.- V2 r r)
|
||||
|
||||
@@ -10,10 +10,22 @@ nearPoint :: Monoid m => Float -> (LWorld -> IM.IntMap (IM.IntMap m)) -> Point2
|
||||
{-# INLINE nearPoint #-}
|
||||
nearPoint size f p w = zoneExtract (zoneOfPoint size p) (f $ w ^. cWorld . lWorld)
|
||||
|
||||
nearPoint' :: Monoid m => Float -> (World -> IM.IntMap (IM.IntMap m)) -> Point2 -> World -> m
|
||||
{-# INLINE nearPoint' #-}
|
||||
nearPoint' size f p w = zoneExtract (zoneOfPoint size p) (f w)
|
||||
|
||||
nearSeg :: Monoid m => Float -> (LWorld -> IM.IntMap (IM.IntMap m)) -> Point2 -> Point2 -> World -> m
|
||||
{-# INLINE nearSeg #-}
|
||||
nearSeg size f sp ep w = zonesExtract (f $ w ^. cWorld . lWorld) (zoneOfSeg size sp ep)
|
||||
|
||||
nearSeg' :: Monoid m => Float -> (World -> IM.IntMap (IM.IntMap m)) -> Point2 -> Point2 -> World -> m
|
||||
{-# INLINE nearSeg' #-}
|
||||
nearSeg' size f sp ep w = zonesExtract (f w) (zoneOfSeg size sp ep)
|
||||
|
||||
nearRect :: Monoid m => Float -> (LWorld -> IM.IntMap (IM.IntMap m)) -> Point2 -> Point2 -> World -> m
|
||||
{-# INLINE nearRect #-}
|
||||
nearRect size f sp ep w = zonesExtract (f $ w ^. cWorld . lWorld) (zoneOfRect size sp ep)
|
||||
|
||||
nearRect' :: Monoid m => Float -> (World -> IM.IntMap (IM.IntMap m)) -> Point2 -> Point2 -> World -> m
|
||||
{-# INLINE nearRect' #-}
|
||||
nearRect' size f sp ep w = zonesExtract (f w) (zoneOfRect size sp ep)
|
||||
|
||||
@@ -12,7 +12,7 @@ import Dodge.Zoning.Common
|
||||
|
||||
crIXsNearPoint :: Point2 -> World -> IS.IntSet
|
||||
--crIXsNearPoint p w = zoneExtract (zoneOfPoint crZoneSize p) (w ^. cWorld . lWorld . crZoning)
|
||||
crIXsNearPoint = nearPoint crZoneSize _crZoning
|
||||
crIXsNearPoint = nearPoint' crZoneSize _crZoning
|
||||
|
||||
crsNearPoint :: Point2 -> World -> [Creature]
|
||||
crsNearPoint p w = mapMaybe (\cid -> w ^? cWorld . lWorld . creatures . ix cid) . IS.toList $ crIXsNearPoint p w
|
||||
@@ -24,7 +24,7 @@ crsNearSeg sp ep w =
|
||||
$ crixsNearSeg sp ep w
|
||||
|
||||
crixsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet
|
||||
crixsNearSeg = nearSeg crZoneSize _crZoning
|
||||
crixsNearSeg = nearSeg' crZoneSize _crZoning
|
||||
--crixsNearSeg sp ep w = zonesExtract (w ^. cWorld . lWorld . crZoning) (zoneOfSeg crZoneSize sp ep)
|
||||
|
||||
crIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet
|
||||
@@ -34,7 +34,7 @@ crsNearCirc :: Point2 -> Float -> World -> [Creature]
|
||||
crsNearCirc p r w = mapMaybe (\cid -> w ^? cWorld . lWorld . creatures . ix cid) . IS.toList $ crIXsNearCirc p r w
|
||||
|
||||
crsNearRect :: Point2 -> Point2 -> World -> IS.IntSet
|
||||
crsNearRect = nearRect crZoneSize _crZoning
|
||||
crsNearRect = nearRect' crZoneSize _crZoning
|
||||
|
||||
crZoneSize :: Float
|
||||
crZoneSize = 15
|
||||
|
||||
@@ -10,13 +10,13 @@ import qualified Data.Set as Set
|
||||
import Dodge.Zoning.Common
|
||||
|
||||
pnsNearPoint :: Point2 -> World -> [(Int, Point2)]
|
||||
pnsNearPoint = nearPoint pnZoneSize _pnZoning
|
||||
pnsNearPoint = nearPoint' pnZoneSize _pnZoning
|
||||
|
||||
pnsNearSeg :: Point2 -> Point2 -> World -> [(Int, Point2)]
|
||||
pnsNearSeg = nearSeg pnZoneSize _pnZoning
|
||||
pnsNearSeg = nearSeg' pnZoneSize _pnZoning
|
||||
|
||||
pnsNearRect :: Point2 -> Point2 -> World -> [(Int, Point2)]
|
||||
pnsNearRect = nearRect pnZoneSize _pnZoning
|
||||
pnsNearRect = nearRect' pnZoneSize _pnZoning
|
||||
|
||||
pnsNearCirc :: Point2 -> Float -> World -> [(Int, Point2)]
|
||||
pnsNearCirc p r = pnsNearRect (p +.+ V2 r r) (p -.- V2 r r)
|
||||
@@ -31,14 +31,14 @@ zonePn :: (Int, Point2) -> IM.IntMap (IM.IntMap [(Int, Point2)]) -> IM.IntMap (I
|
||||
zonePn pn = zoneMonoid (zoneOfPn pn) [pn]
|
||||
|
||||
pesNearPoint :: Point2 -> World -> Set PathEdgeNodes
|
||||
pesNearPoint = nearPoint peZoneSize _peZoning
|
||||
pesNearPoint = nearPoint' peZoneSize _peZoning
|
||||
--pesNearPoint p w = zoneExtract (zoneOfPoint peZoneSize p) (w ^. cWorld . lWorld . peZoning)
|
||||
|
||||
pesNearSeg :: Point2 -> Point2 -> World -> Set PathEdgeNodes
|
||||
pesNearSeg = nearSeg peZoneSize _peZoning
|
||||
pesNearSeg = nearSeg' peZoneSize _peZoning
|
||||
|
||||
pesNearRect :: Point2 -> Point2 -> World -> Set PathEdgeNodes
|
||||
pesNearRect = nearRect peZoneSize _peZoning
|
||||
pesNearRect = nearRect' peZoneSize _peZoning
|
||||
|
||||
pesNearCirc :: Point2 -> Float -> World -> Set PathEdgeNodes
|
||||
pesNearCirc p r = pesNearRect (p +.+ V2 r r) (p -.- V2 r r)
|
||||
|
||||
@@ -1,4 +1,13 @@
|
||||
module Dodge.Zoning.Wall where
|
||||
module Dodge.Zoning.Wall
|
||||
( wlsNearSeg
|
||||
, wlsNearPoint
|
||||
, wlsNearRect
|
||||
, wlsNearCirc
|
||||
, wlsFromIXs
|
||||
, wlZoneSize
|
||||
, zoneWall
|
||||
, deZoneWall
|
||||
) where
|
||||
|
||||
import Control.Lens
|
||||
import qualified Data.IntSet as IS
|
||||
@@ -11,14 +20,14 @@ import qualified IntMapHelp as IM
|
||||
import Dodge.Zoning.Common
|
||||
|
||||
wlIXsNearPoint :: Point2 -> World -> IS.IntSet
|
||||
wlIXsNearPoint = nearPoint wlZoneSize _wlZoning
|
||||
wlIXsNearPoint = nearPoint' wlZoneSize _wlZoning
|
||||
|
||||
wlIXsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet
|
||||
{-# INLINE wlIXsNearSeg #-}
|
||||
wlIXsNearSeg = nearSeg wlZoneSize _wlZoning
|
||||
wlIXsNearSeg = nearSeg' wlZoneSize _wlZoning
|
||||
|
||||
wlIXsNearRect :: Point2 -> Point2 -> World -> IS.IntSet
|
||||
wlIXsNearRect = nearRect wlZoneSize _wlZoning
|
||||
wlIXsNearRect = nearRect' wlZoneSize _wlZoning
|
||||
|
||||
wlIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet
|
||||
wlIXsNearCirc p r = wlIXsNearRect (p +.+ V2 r r) (p -.- V2 r r)
|
||||
|
||||
Reference in New Issue
Block a user