diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 227898d8e..1b1994922 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -236,8 +236,10 @@ data World = World , _corpses :: IM.IntMap Corpse , _clickMousePos :: Point2 , _pathGraph :: Gr Point2 PathEdge - , _pnZoning :: Zoning [] (Int,Point2) - , _peZoning :: Zoning [] (Int,Int,PathEdge) + --, _pnZoning :: Zoning [] (Int,Point2) + --, _peZoning :: Zoning [] (Int,Int,PathEdge) + , _pnZoning :: IM.IntMap (IM.IntMap [(Int,Point2)]) --Zoning IM.IntMap Creature + , _peZoning :: IM.IntMap (IM.IntMap [(Int,Int,PathEdge)]) --Zoning IM.IntMap Creature , _hud :: HUD , _lightSources :: IM.IntMap LightSource , _tempLightSources :: [TempLightSource] diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 9fe86dd6f..0a4aefb5c 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -1,9 +1,5 @@ module Dodge.Default.World where import Dodge.Data -import Dodge.Zone.Size -import Dodge.Zone.Object ---import Geometry.Vector3D -import Geometry.Zone import Geometry.Data import Geometry.Polygon @@ -76,8 +72,8 @@ defaultWorld = World , _clickMousePos = V2 0 0 , _pathGraph = Data.Graph.Inductive.Graph.empty -- , _pathGraphP = mempty - , _pnZoning = Zoning mempty peZoneSize (zonePos snd) - , _peZoning = Zoning mempty peZoneSize (\x (_,_,e) -> zoneOfSeg x (_peStart e) (_peEnd e)) + , _pnZoning = mempty + , _peZoning = mempty , _hud = HUD { _hudElement = DisplayInventory NoSubInventory , _carteCenter = V2 0 0 diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 1d804710e..0e1e30ef7 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -2,10 +2,10 @@ module Dodge.Layout ( generateLevelFromRoomList ) where +import Dodge.Zoning.Pathing import Data.Tile import Dodge.Data import Dodge.Path -import Dodge.Zone.Update import Dodge.ShiftPoint import Dodge.Placement.PlaceSpot --import Dodge.LevelGen.Data @@ -45,10 +45,8 @@ generateLevelFromRoomList gr' w = initWallZoning , _gameRooms = gameRoomsFromRooms (IM.elems rs') , _pathGraph = path } - & pnZoning %~ (\zn -> foldl' (flip $ updateZoning (:)) (zn & znObjects .~ mempty) - (labNodes path)) - & peZoning %~ (\zn -> foldl' (flip $ updateZoning (:)) (zn & znObjects .~ mempty) - (labEdges path)) + & pnZoning .~ foldl' (flip $ zonePn) mempty (labNodes path) + & peZoning .~ foldl' (flip $ zonePe) mempty (labEdges path) where (_,path) = pairsToGraph pairPath' pairPath = foldMap _rmPath rs diff --git a/src/Dodge/Path.hs b/src/Dodge/Path.hs index d3409cd04..a2f83752f 100644 --- a/src/Dodge/Path.hs +++ b/src/Dodge/Path.hs @@ -11,9 +11,10 @@ module Dodge.Path , bfsNodePoints , fusePairs ) where +import Dodge.Zoning.Pathing +import Dodge.Zoning.Base import Dodge.Data import Dodge.Base.Collide -import Dodge.Zone import Geometry.Data import Geometry @@ -52,7 +53,7 @@ walkableNodeNear :: World -> Point2 -> Maybe Int walkableNodeNear w p = fmap fst . find (flip (isWalkable p) w . snd) $ nodesNear where --nodesNear = runIdentity . S.toList_ $ nearPoint _pnZoning p w - nodesNear = runIdentity . S.toList_ $ aroundPoint _pnZoning p w + nodesNear = zonesExtract (w ^. pnZoning) $ zonesAroundPoint pnZoneSize p makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2] makePathBetweenPs a b w = mapMaybe (lab $ _pathGraph w) <$> makePathBetween a b w @@ -137,12 +138,12 @@ addEdges nodemap gr = runIdentity . S.fold_ f (mempty,gr) id obstructPathsCrossing :: EdgeObstacle -> Point2 -> Point2 -> World -> ( World, [(Int,Int,PathEdge)]) obstructPathsCrossing obstacletype sp' ep w = ( w & pathGraph %~ updateedges - , runIdentity $ S.toList_ es + , es ) where - es = S.filter edgecrosses $ nearSeg _peZoning sp' ep w + es = filter edgecrosses $ pesNearSeg sp' ep w edgecrosses (_,_,pe) = isJust $ intersectSegSeg sp' ep (_peStart pe) (_peEnd pe) - updateedges gr = runIdentity $ S.fold_ updateedge gr id es + updateedges gr = foldl' updateedge gr es updateedge gr (x,y,pe) = insEdge (x,y,pe & peObstacles . at obstacletype ?~ ()) $ delEdge (x,y) gr diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 6b1f6e30b..e89841153 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -1,7 +1,7 @@ module Dodge.Render.ShapePicture ( worldSPic ) where -import Dodge.Zoning.Wall +import Dodge.Zoning import Dodge.Button.Draw import Dodge.LightSource.Draw import Dodge.Targeting.Draw diff --git a/src/Dodge/Zone/Size.hs b/src/Dodge/Zone/Size.hs index ed610ae41..2fef27f2b 100644 --- a/src/Dodge/Zone/Size.hs +++ b/src/Dodge/Zone/Size.hs @@ -1,10 +1,10 @@ module Dodge.Zone.Size where -pnZoneSize :: Float -pnZoneSize = 100 +--pnZoneSize :: Float +--pnZoneSize = 100 clZoneSize :: Float clZoneSize = 20 -peZoneSize :: Float -peZoneSize = 50 +--peZoneSize :: Float +--peZoneSize = 50 diff --git a/src/Dodge/Zoning.hs b/src/Dodge/Zoning.hs index cde4fe3e1..f1c01a136 100644 --- a/src/Dodge/Zoning.hs +++ b/src/Dodge/Zoning.hs @@ -1,7 +1,9 @@ module Dodge.Zoning ( module Dodge.Zoning.Creature , module Dodge.Zoning.Wall + , module Dodge.Zoning.Pathing ) where import Dodge.Zoning.Creature import Dodge.Zoning.Wall +import Dodge.Zoning.Pathing diff --git a/src/Dodge/Zoning/Base.hs b/src/Dodge/Zoning/Base.hs index 7c6455448..2242bd2c8 100644 --- a/src/Dodge/Zoning/Base.hs +++ b/src/Dodge/Zoning/Base.hs @@ -65,6 +65,11 @@ zoneMonoid (V2 x y) a = IM.insertWith f x $ IM.singleton y a deZoneIX :: Int -> IM.IntMap (IM.IntMap IS.IntSet) -> Int2 -> IM.IntMap (IM.IntMap IS.IntSet) deZoneIX i im (V2 x y) = im & ix x . ix y %~ IS.delete i -zoneOfPoint'' :: Float -> Point2 -> V2 Int +zoneOfPoint'' :: Float -> Point2 -> Int2 {-# INLINE zoneOfPoint'' #-} zoneOfPoint'' s = fmap (divTo s) + +zonesAroundPoint :: Float -> Point2 -> [Int2] +zonesAroundPoint s p = [V2 a b | a <- [x-1..x+1] , b <- [y-1..y+1] ] + where + V2 x y = zoneOfPoint' s p diff --git a/src/Dodge/Zoning/Cloud.hs b/src/Dodge/Zoning/Cloud.hs index 843e619fe..c81c293de 100644 --- a/src/Dodge/Zoning/Cloud.hs +++ b/src/Dodge/Zoning/Cloud.hs @@ -5,7 +5,7 @@ import Dodge.Zoning.Base import Dodge.Data import Geometry -import Data.Foldable +--import Data.Foldable import Control.Lens import qualified IntMapHelp as IM diff --git a/src/Dodge/Zoning/Pathing.hs b/src/Dodge/Zoning/Pathing.hs new file mode 100644 index 000000000..134017d79 --- /dev/null +++ b/src/Dodge/Zoning/Pathing.hs @@ -0,0 +1,56 @@ +module Dodge.Zoning.Pathing + where +import Geometry.Vector +import Dodge.Zoning.Base +import Dodge.Data +import Geometry + +import Data.Foldable +import Control.Lens +import qualified IntMapHelp as IM + +pnsNearPoint :: Point2 -> World -> [(Int,Point2)] +pnsNearPoint p w = zoneExtract (zoneOfPoint' pnZoneSize p) (w ^. pnZoning) + +pnsNearSeg :: Point2 -> Point2 -> World -> [(Int,Point2)] +pnsNearSeg sp ep w = zonesExtract (w ^. pnZoning) (zoneOfSeg' pnZoneSize sp ep) + +pnsNearRect :: Point2 -> Point2 -> World -> [(Int,Point2)] +pnsNearRect sp ep w = zonesExtract (w ^. pnZoning) $ zoneOfRect' pnZoneSize sp ep + +pnsNearCirc :: Point2 -> Float -> World -> [(Int,Point2)] +pnsNearCirc p r = pnsNearRect (p +.+ V2 r r) (p -.- V2 r r) + +pnZoneSize :: Float +pnZoneSize = 50 + +zoneOfPn :: (Int,Point2) -> Int2 +zoneOfPn = zoneOfPoint'' pnZoneSize . snd + +zonePn :: (Int,Point2) -> IM.IntMap (IM.IntMap [(Int,Point2)]) -> IM.IntMap (IM.IntMap [(Int,Point2)]) +zonePn pn = zoneMonoid (zoneOfPn pn) [pn] + + + +pesNearPoint :: Point2 -> World -> [(Int,Int,PathEdge)] +pesNearPoint p w = zoneExtract (zoneOfPoint' peZoneSize p) (w ^. peZoning) + +pesNearSeg :: Point2 -> Point2 -> World -> [(Int,Int,PathEdge)] +pesNearSeg sp ep w = zonesExtract (w ^. peZoning) (zoneOfSeg' peZoneSize sp ep) + +pesNearRect :: Point2 -> Point2 -> World -> [(Int,Int,PathEdge)] +pesNearRect sp ep w = zonesExtract (w ^. peZoning) $ zoneOfRect' peZoneSize sp ep + +pesNearCirc :: Point2 -> Float -> World -> [(Int,Int,PathEdge)] +pesNearCirc p r = pesNearRect (p +.+ V2 r r) (p -.- V2 r r) + +peZoneSize :: Float +peZoneSize = 50 + +zoneOfPe :: (Int,Int,PathEdge) -> [Int2] +zoneOfPe (_,_,pe) = zoneOfSeg' peZoneSize (_peStart pe) (_peEnd pe) + +zonePe :: (Int,Int,PathEdge) -> IM.IntMap (IM.IntMap [(Int,Int,PathEdge)]) -> IM.IntMap (IM.IntMap [(Int,Int,PathEdge)]) +zonePe pe im = foldl' f im (zoneOfPe pe) + where + f im' i2 = zoneMonoid i2 [pe] im'