diff --git a/data/texture/charMap.png b/data/texture/charMap.png index fabef9ac6..660d71aee 100644 Binary files a/data/texture/charMap.png and b/data/texture/charMap.png differ diff --git a/src/Dodge/Data/CWorld.hs b/src/Dodge/Data/CWorld.hs index b6014e588..a14ce5880 100644 --- a/src/Dodge/Data/CWorld.hs +++ b/src/Dodge/Data/CWorld.hs @@ -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 diff --git a/src/Dodge/Data/LWorld.hs b/src/Dodge/Data/LWorld.hs index 0aad7ba60..71324355e 100644 --- a/src/Dodge/Data/LWorld.hs +++ b/src/Dodge/Data/LWorld.hs @@ -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) diff --git a/src/Dodge/Data/World.hs b/src/Dodge/Data/World.hs index 857c6017d..01823c5df 100644 --- a/src/Dodge/Data/World.hs +++ b/src/Dodge/Data/World.hs @@ -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) diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index a4fb1c75a..49e8876bf 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -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 = diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 282670c9d..f27791d34 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -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 . diff --git a/src/Dodge/Path.hs b/src/Dodge/Path.hs index 1224fe114..4e59b55cd 100644 --- a/src/Dodge/Path.hs +++ b/src/Dodge/Path.hs @@ -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 diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 98e7f17e1..f3156d2c8 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -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) diff --git a/src/Dodge/Render/Walls.hs b/src/Dodge/Render/Walls.hs index 4800d65f1..48bcb0449 100644 --- a/src/Dodge/Render/Walls.hs +++ b/src/Dodge/Render/Walls.hs @@ -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 diff --git a/src/Dodge/Save.hs b/src/Dodge/Save.hs index 4c4f7a939..a6384a5d6 100644 --- a/src/Dodge/Save.hs +++ b/src/Dodge/Save.hs @@ -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" diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 0732743f6..e5a566435 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -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)) diff --git a/src/Dodge/Wall/Zone.hs b/src/Dodge/Wall/Zone.hs index 41ea3ffe0..d4b2868bb 100644 --- a/src/Dodge/Wall/Zone.hs +++ b/src/Dodge/Wall/Zone.hs @@ -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) diff --git a/src/Dodge/Zoning/Cloud.hs b/src/Dodge/Zoning/Cloud.hs index 8478bb16a..275f56520 100644 --- a/src/Dodge/Zoning/Cloud.hs +++ b/src/Dodge/Zoning/Cloud.hs @@ -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) diff --git a/src/Dodge/Zoning/Common.hs b/src/Dodge/Zoning/Common.hs index c9faae335..24803aab7 100644 --- a/src/Dodge/Zoning/Common.hs +++ b/src/Dodge/Zoning/Common.hs @@ -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) diff --git a/src/Dodge/Zoning/Creature.hs b/src/Dodge/Zoning/Creature.hs index e76c9de25..adcbbe635 100644 --- a/src/Dodge/Zoning/Creature.hs +++ b/src/Dodge/Zoning/Creature.hs @@ -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 diff --git a/src/Dodge/Zoning/Pathing.hs b/src/Dodge/Zoning/Pathing.hs index 08142ad21..c474e2fcf 100644 --- a/src/Dodge/Zoning/Pathing.hs +++ b/src/Dodge/Zoning/Pathing.hs @@ -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) diff --git a/src/Dodge/Zoning/Wall.hs b/src/Dodge/Zoning/Wall.hs index d5c5633e6..ada254c0d 100644 --- a/src/Dodge/Zoning/Wall.hs +++ b/src/Dodge/Zoning/Wall.hs @@ -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)