From 6973663055c6efda3968dbd3fcb4afbd7075e6d4 Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 24 Aug 2022 14:01:39 +0100 Subject: [PATCH] Make pathedge zoning use sets, probably doesn't help --- src/Dodge/Block.hs | 3 ++- src/Dodge/Data/Block.hs | 3 ++- src/Dodge/Data/CWorld.hs | 4 ++- src/Dodge/Data/Door.hs | 3 ++- src/Dodge/Data/PathGraph.hs | 9 +++++++ src/Dodge/Default/Block.hs | 2 +- src/Dodge/Humanoid.hs | 4 --- src/Dodge/Path.hs | 8 +++--- src/Dodge/Placement/PlaceSpot/Block.hs | 8 +++--- src/Dodge/Placement/PlaceSpot/TriggerDoor.hs | 5 ++-- src/Dodge/Render/ShapePicture.hs | 8 +++--- src/Dodge/Zoning/Base.hs | 26 ++++++++++---------- src/Dodge/Zoning/Cloud.hs | 4 +-- src/Dodge/Zoning/Creature.hs | 4 +-- src/Dodge/Zoning/Pathing.hs | 24 +++++++++--------- src/Dodge/Zoning/Wall.hs | 6 ++--- 16 files changed, 68 insertions(+), 53 deletions(-) diff --git a/src/Dodge/Block.hs b/src/Dodge/Block.hs index 5d7919191..83455f3f6 100644 --- a/src/Dodge/Block.hs +++ b/src/Dodge/Block.hs @@ -1,5 +1,6 @@ module Dodge.Block where +import Data.Set (Set) import Dodge.Data.MountedObject import Control.Lens import Data.Foldable @@ -64,7 +65,7 @@ destroyBlock bl w = ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w -- this does not handle eg doors blocking the path as well -maybeClearPaths :: [(Int, Int, PathEdge)] -> World -> World +maybeClearPaths :: Set (Int, Int, PathEdge) -> World -> World maybeClearPaths ps w = foldl' maybeClearPath w ps maybeClearPath :: World -> (Int, Int, PathEdge) -> World diff --git a/src/Dodge/Data/Block.hs b/src/Dodge/Data/Block.hs index da4b5efbf..2847292fb 100644 --- a/src/Dodge/Data/Block.hs +++ b/src/Dodge/Data/Block.hs @@ -9,6 +9,7 @@ module Dodge.Data.Block ( module Dodge.Data.PathGraph, ) where +import Data.Set (Set) import Color import Control.Lens import Data.Aeson @@ -30,7 +31,7 @@ data Block = Block , _blHeight :: Float , _blMaterial :: Material , _blDraw :: BlockDraw --Block -> SPic - , _blObstructs :: [(Int, Int, PathEdge)] + , _blObstructs :: Set (Int, Int, PathEdge) } deriving (Eq, Ord, Show, Read) --Generic, Flat) diff --git a/src/Dodge/Data/CWorld.hs b/src/Dodge/Data/CWorld.hs index 2d5175305..22eca2218 100644 --- a/src/Dodge/Data/CWorld.hs +++ b/src/Dodge/Data/CWorld.hs @@ -48,6 +48,7 @@ module Dodge.Data.CWorld ( module Dodge.Data.WorldEffect, ) where +import Data.Set (Set) import Control.Lens import Data.Aeson import Data.Aeson.TH @@ -176,7 +177,8 @@ data CWorld = CWorld , _corpses :: IM.IntMap Corpse , _pathGraph :: Gr Point2 PathEdge , _pnZoning :: IM.IntMap (IM.IntMap [(Int, Point2)]) --Zoning IM.IntMap Creature - , _peZoning :: IM.IntMap (IM.IntMap [(Int, Int, PathEdge)]) --Zoning IM.IntMap Creature + --, _peZoning :: IM.IntMap (IM.IntMap [(Int, Int, PathEdge)]) --Zoning IM.IntMap Creature + , _peZoning :: IM.IntMap (IM.IntMap (Set (Int, Int, PathEdge))) --Zoning IM.IntMap Creature , _hud :: HUD , _lightSources :: IM.IntMap LightSource , _tempLightSources :: [TempLightSource] diff --git a/src/Dodge/Data/Door.hs b/src/Dodge/Data/Door.hs index 435de7273..d29287bcd 100644 --- a/src/Dodge/Data/Door.hs +++ b/src/Dodge/Data/Door.hs @@ -10,6 +10,7 @@ module Dodge.Data.Door ( module Dodge.Data.WorldEffect, ) where +import Data.Set (Set) import Control.Lens import Data.Aeson import Data.Aeson.TH @@ -45,7 +46,7 @@ data Door = Door , _drPushedBy :: PushSource , _drPushes :: Maybe Int , _drMounts :: [MountedObject] - , _drObstructs :: [(Int, Int, PathEdge)] + , _drObstructs :: Set (Int, Int, PathEdge) , _drObstacleType :: EdgeObstacle } --deriving (Eq, Ord, Show, Read) --Generic, Flat) diff --git a/src/Dodge/Data/PathGraph.hs b/src/Dodge/Data/PathGraph.hs index 0252f9aac..c2904d1b7 100644 --- a/src/Dodge/Data/PathGraph.hs +++ b/src/Dodge/Data/PathGraph.hs @@ -30,6 +30,13 @@ data PathGraph = PathGraph } deriving (Eq, Show, Read) --, Generic) +data PathEdgeNodes = PathEdgeNodes + { _penStart :: Int + , _penEnd :: Int + , _penPathEdge :: PathEdge + } + deriving (Eq, Ord, Show, Read) --Generic, Flat) + data PathEdge = PathEdge { _peStart :: Point2 , _peEnd :: Point2 @@ -54,7 +61,9 @@ data EdgeObstacle makeLenses ''PathGraph makeLenses ''PathEdge +makeLenses ''PathEdgeNodes deriveJSON defaultOptions ''EdgeObstacle deriveJSON defaultOptions ''PathEdge +deriveJSON defaultOptions ''PathEdgeNodes deriveJSON defaultOptions ''Gr deriveJSON defaultOptions ''PathGraph diff --git a/src/Dodge/Default/Block.hs b/src/Dodge/Default/Block.hs index 4e84d1e69..88d8a9ec2 100644 --- a/src/Dodge/Default/Block.hs +++ b/src/Dodge/Default/Block.hs @@ -14,7 +14,7 @@ defaultBlock = Block , _blDraw = BlockDrawMempty , _blHeight = 100 , _blMaterial = Stone - , _blObstructs = [] + , _blObstructs = mempty } defaultDirtBlock :: Block defaultDirtBlock = defaultBlock & blHP .~ 50 diff --git a/src/Dodge/Humanoid.hs b/src/Dodge/Humanoid.hs index 7c5045276..e24aec097 100644 --- a/src/Dodge/Humanoid.hs +++ b/src/Dodge/Humanoid.hs @@ -188,11 +188,7 @@ defaultImpulsive :: World -> World defaultImpulsive - --xs cr = id - -- updateRandGen -- . stateUpdate (const id) cr = fmap (fmap updateRandGen) . stateUpdate . impulsiveAIBefore . chainCreatureUpdates - --xs cr = updateRandGen . stateUpdate (const id) cr - --xs cr = stateUpdate (const id) cr where updateRandGen w = let (_, g) = randomR (0, 1 :: Int) (_randGen w) diff --git a/src/Dodge/Path.hs b/src/Dodge/Path.hs index fc2a3aa40..05eeb1117 100644 --- a/src/Dodge/Path.hs +++ b/src/Dodge/Path.hs @@ -12,6 +12,8 @@ module Dodge.Path ( fusePairs, ) where +import Data.Set (Set) +import qualified Data.Set as Set import Control.Lens import Data.Foldable import Data.Graph.Inductive hiding ((&)) @@ -19,8 +21,6 @@ import Data.List import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Maybe -import Data.Set (Set) -import qualified Data.Set as Set import Dodge.Base.Collide import Dodge.Data.World import Dodge.Zoning.Base @@ -131,13 +131,13 @@ addEdges nodemap gr = foldl' f (mempty, gr) theedge = (g a, g b, PathEdge a b (dist a b) mempty) g a = nodemap M.! a -obstructPathsCrossing :: EdgeObstacle -> Point2 -> Point2 -> World -> (World, [(Int, Int, PathEdge)]) +obstructPathsCrossing :: EdgeObstacle -> Point2 -> Point2 -> World -> (World, Set (Int, Int, PathEdge)) obstructPathsCrossing obstacletype sp' ep w = ( w & cWorld . pathGraph %~ updateedges , es ) where - es = filter edgecrosses $ pesNearSeg sp' ep w + es = Set.filter edgecrosses $ pesNearSeg sp' ep w edgecrosses (_, _, pe) = isJust $ intersectSegSeg sp' ep (_peStart pe) (_peEnd pe) updateedges gr = foldl' updateedge gr es updateedge gr (x, y, pe) = diff --git a/src/Dodge/Placement/PlaceSpot/Block.hs b/src/Dodge/Placement/PlaceSpot/Block.hs index f1281cda4..c3c0b8a63 100644 --- a/src/Dodge/Placement/PlaceSpot/Block.hs +++ b/src/Dodge/Placement/PlaceSpot/Block.hs @@ -4,6 +4,8 @@ module Dodge.Placement.PlaceSpot.Block ( plLineBlock, ) where +import Data.Set (Set) +import qualified Data.Set as Set import Control.Lens import qualified Data.IntSet as IS import Data.List @@ -85,7 +87,7 @@ plLineBlock basePane blwidth a b gw = , _blShadows = shadowsAt i , _blDir = 0 -- THIS IS NOT SENSIBLE. TODO rethink block positioning , _blFootprint = cornersAt p -- TODO check winding (clockwise, anticlockwise) - , _blObstructs = [] + , _blObstructs = mempty , _blMaterial = _wlMaterial basePane , _blHeight = 100 , _blPos = p @@ -113,11 +115,11 @@ plLineBlock basePane blwidth a b gw = -- | Must be done after inserting the block insertWalls :: Int -> [Wall] -> World -> World -insertWalls blid wls w = w' & cWorld . blocks . ix blid . blObstructs .~ concat paths +insertWalls blid wls w = w' & cWorld . blocks . ix blid . blObstructs .~ Set.unions paths where (w', paths) = mapAccumR (flip insertWall) w wls -insertWall :: Wall -> World -> (World, [(Int, Int, PathEdge)]) +insertWall :: Wall -> World -> (World, Set (Int, Int, PathEdge)) insertWall wl = uncurry (obstructPathsCrossing BlockObstacle) (_wlLine wl) . (cWorld . walls . at (_wlID wl) ?~ wl) diff --git a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs index ca064b4b0..6afe80d09 100644 --- a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs +++ b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs @@ -4,6 +4,7 @@ module Dodge.Placement.PlaceSpot.TriggerDoor ( maybeClearDoorPaths, ) where +import Data.Set (Set) import qualified Data.Graph.Inductive as FGL import qualified Data.IntSet as IS import Data.List @@ -60,11 +61,11 @@ addDoorWall eo drid wl w (wlid, wlps) = , _wlID = wlid , _wlStructure = DoorPart drid } - & cWorld . doors . ix drid . drObstructs .++~ es + & cWorld . doors . ix drid . drObstructs <>~ es where (w', es) = uncurry (obstructPathsCrossing eo) wlps w -maybeClearDoorPaths :: EdgeObstacle -> [(Int, Int, PathEdge)] -> World -> World +maybeClearDoorPaths :: EdgeObstacle -> Set (Int, Int, PathEdge) -> World -> World maybeClearDoorPaths eo es w = foldl' (maybeClearDoorPath eo) w es maybeClearDoorPath :: EdgeObstacle -> World -> (Int, Int, PathEdge) -> World diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index b216d1bf1..393f30cf7 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -188,9 +188,9 @@ drawCollisionTest cfig w = <> foldMap (drawCross . fst) (crHit a b w) <> foldMap (drawCross . _crPos) (crsNearSeg a b w) -- <> foldMap (drawZoneCol green crZoneSize) (zoneOfSeg' crZoneSize a b) - <> foldMap (drawZoneCol green crZoneSize . zoneOfPoint' crZoneSize) (xIntercepts' crZoneSize a b) - <> foldMap (drawZoneCol yellow crZoneSize . zoneOfPoint' crZoneSize) (yIntercepts' crZoneSize a b) - <> foldMap (drawLabCrossCol cfig w blue) (xIntercepts' crZoneSize a b) + <> foldMap (drawZoneCol green crZoneSize . zoneOfPoint crZoneSize) (xIntercepts crZoneSize a b) + <> foldMap (drawZoneCol yellow crZoneSize . zoneOfPoint crZoneSize) (yIntercepts' crZoneSize a b) + <> foldMap (drawLabCrossCol cfig w blue) (xIntercepts crZoneSize a b) where (a, b) = _lrLine w @@ -290,7 +290,7 @@ drawDDATest w = cvf = w ^. cWorld . cwCam . cwcViewFrom mwp = mouseWorldPos w --ps = ddaStreamX 50 cvf mwp - ps = zoneOfSeg' 50 cvf mwp + ps = zoneOfSeg 50 cvf mwp --ps' = ddaStreamY 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w) --qs = xIntercepts 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w) diff --git a/src/Dodge/Zoning/Base.hs b/src/Dodge/Zoning/Base.hs index e6f327dd6..420af9a22 100644 --- a/src/Dodge/Zoning/Base.hs +++ b/src/Dodge/Zoning/Base.hs @@ -13,8 +13,8 @@ zoneOfCirc zsize p r = zoneOfRect' zsize (p +.+ V2 r r) (p -.- V2 r r) zoneOfRect' :: Float -> Point2 -> Point2 -> [Int2] zoneOfRect' s sp ep = [V2 x y | x <- makeIntInterval sx ex, y <- makeIntInterval sy ey] where - V2 sx sy = zoneOfPoint' s sp - V2 ex ey = zoneOfPoint' s ep + V2 sx sy = zoneOfPoint s sp + V2 ex ey = zoneOfPoint s ep makeIntInterval :: Int -> Int -> [Int] makeIntInterval x y @@ -25,12 +25,12 @@ makeInt2Interval :: Int2 -> Int2 -> [Int2] makeInt2Interval (V2 x1 y1) (V2 x2 y2) = [V2 x y | x <- makeIntInterval x1 x2, y <- makeIntInterval y1 y2] -zoneOfPoint' :: Float -> Point2 -> Int2 -zoneOfPoint' = fmap . divTo +zoneOfPoint :: Float -> Point2 -> Int2 +zoneOfPoint = fmap . divTo -zoneOfSeg' :: Float -> Point2 -> Point2 -> [Int2] -{-# INLINE zoneOfSeg' #-} -zoneOfSeg' s sp ep = map (zoneOfPoint' s) (sp : xIntercepts' s sp ep ++ yIntercepts' s sp ep) +zoneOfSeg :: Float -> Point2 -> Point2 -> [Int2] +{-# INLINE zoneOfSeg #-} +zoneOfSeg s sp ep = map (zoneOfPoint s) (sp : xIntercepts s sp ep ++ yIntercepts' s sp ep) zoneExtract :: Monoid m => Int2 -> IM.IntMap (IM.IntMap m) -> m zoneExtract (V2 x y) = fromMaybe mempty . (^? ix x . ix y) @@ -39,9 +39,9 @@ zonesExtract :: Monoid m => IM.IntMap (IM.IntMap m) -> [Int2] -> m {-# INLINE zonesExtract #-} zonesExtract = foldMap . flip zoneExtract -xIntercepts' :: Float -> Point2 -> Point2 -> [Point2] -{-# INLINE xIntercepts' #-} -xIntercepts' s (V2 sx sy) (V2 ex ey) +xIntercepts :: Float -> Point2 -> Point2 -> [Point2] +{-# INLINE xIntercepts #-} +xIntercepts s (V2 sx sy) (V2 ex ey) | xdx == 0 = [] | otherwise = zipWith V2 [halfstep + sx', halfstep + sx' + xdx * s .. ex] ([sy', sy' + ydx * s .. ey] ++ repeat ey) where @@ -57,12 +57,12 @@ xIntercepts' s (V2 sx sy) (V2 ex ey) yIntercepts' :: Float -> Point2 -> Point2 -> [Point2] {-# INLINE yIntercepts' #-} -yIntercepts' s sp ep = map f $ xIntercepts' s (f sp) (f ep) +yIntercepts' s sp ep = map f $ xIntercepts s (f sp) (f ep) where f (V2 x y) = V2 y x zoneMonoid :: Semigroup m => Int2 -> m -> IM.IntMap (IM.IntMap m) -> IM.IntMap (IM.IntMap m) -zoneMonoid (V2 x y) a = IM.insertWith f x $ IM.singleton y a +zoneMonoid (V2 x y) a = IM.insertWith f x $! IM.singleton y a where f _ = IM.insertWith (<>) y a @@ -76,4 +76,4 @@ 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 + V2 x y = zoneOfPoint s p diff --git a/src/Dodge/Zoning/Cloud.hs b/src/Dodge/Zoning/Cloud.hs index 245825acf..e89777e0b 100644 --- a/src/Dodge/Zoning/Cloud.hs +++ b/src/Dodge/Zoning/Cloud.hs @@ -8,10 +8,10 @@ import Geometry import qualified IntMapHelp as IM clsNearPoint :: Point2 -> World -> [Cloud] -clsNearPoint p w = zoneExtract (zoneOfPoint' clZoneSize p) (w ^. cWorld . clZoning) +clsNearPoint p w = zoneExtract (zoneOfPoint clZoneSize p) (w ^. cWorld . clZoning) clsNearSeg :: Point2 -> Point2 -> World -> [Cloud] -clsNearSeg sp ep w = zonesExtract (w ^. cWorld . 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 ^. cWorld . clZoning) $ zoneOfRect' clZoneSize sp ep diff --git a/src/Dodge/Zoning/Creature.hs b/src/Dodge/Zoning/Creature.hs index 5e034f944..caf08bc24 100644 --- a/src/Dodge/Zoning/Creature.hs +++ b/src/Dodge/Zoning/Creature.hs @@ -10,7 +10,7 @@ import Geometry import qualified IntMapHelp as IM crIXsNearPoint :: Point2 -> World -> IS.IntSet -crIXsNearPoint p w = zoneExtract (zoneOfPoint' crZoneSize p) (w ^. cWorld . crZoning) +crIXsNearPoint p w = zoneExtract (zoneOfPoint crZoneSize p) (w ^. cWorld . crZoning) crsNearPoint :: Point2 -> World -> [Creature] crsNearPoint p w = mapMaybe (\cid -> w ^? cWorld . creatures . ix cid) . IS.toList $ crIXsNearPoint p w @@ -22,7 +22,7 @@ crsNearSeg sp ep w = $ crixsNearSeg sp ep w crixsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet -crixsNearSeg sp ep w = zonesExtract (w ^. cWorld . crZoning) (zoneOfSeg' crZoneSize sp ep) +crixsNearSeg 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) diff --git a/src/Dodge/Zoning/Pathing.hs b/src/Dodge/Zoning/Pathing.hs index 5e6dae317..344e21ab6 100644 --- a/src/Dodge/Zoning/Pathing.hs +++ b/src/Dodge/Zoning/Pathing.hs @@ -6,12 +6,14 @@ import Dodge.Data.World import Dodge.Zoning.Base import Geometry import qualified IntMapHelp as IM +import Data.Set (Set) +import qualified Data.Set as Set pnsNearPoint :: Point2 -> World -> [(Int, Point2)] -pnsNearPoint p w = zoneExtract (zoneOfPoint' pnZoneSize p) (w ^. cWorld . pnZoning) +pnsNearPoint p w = zoneExtract (zoneOfPoint pnZoneSize p) (w ^. cWorld . pnZoning) pnsNearSeg :: Point2 -> Point2 -> World -> [(Int, Point2)] -pnsNearSeg sp ep w = zonesExtract (w ^. cWorld . 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 ^. cWorld . pnZoning) $ zoneOfRect' pnZoneSize sp ep @@ -28,25 +30,25 @@ 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 ^. cWorld . peZoning) +pesNearPoint :: Point2 -> World -> Set (Int, Int, PathEdge) +pesNearPoint p w = zoneExtract (zoneOfPoint peZoneSize p) (w ^. cWorld . peZoning) -pesNearSeg :: Point2 -> Point2 -> World -> [(Int, Int, PathEdge)] -pesNearSeg sp ep w = zonesExtract (w ^. cWorld . peZoning) (zoneOfSeg' peZoneSize sp ep) +pesNearSeg :: Point2 -> Point2 -> World -> Set (Int, Int, PathEdge) +pesNearSeg sp ep w = zonesExtract (w ^. cWorld . peZoning) (zoneOfSeg peZoneSize sp ep) -pesNearRect :: Point2 -> Point2 -> World -> [(Int, Int, PathEdge)] +pesNearRect :: Point2 -> Point2 -> World -> Set (Int, Int, PathEdge) pesNearRect sp ep w = zonesExtract (w ^. cWorld . peZoning) $ zoneOfRect' peZoneSize sp ep -pesNearCirc :: Point2 -> Float -> World -> [(Int, Int, PathEdge)] +pesNearCirc :: Point2 -> Float -> World -> Set (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) +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 :: (Int, Int, PathEdge) -> IM.IntMap (IM.IntMap (Set (Int, Int, PathEdge))) -> IM.IntMap (IM.IntMap (Set (Int, Int, PathEdge))) zonePe pe im = foldl' f im (zoneOfPe pe) where - f im' i2 = zoneMonoid i2 [pe] im' + f im' i2 = zoneMonoid i2 (Set.singleton pe) im' diff --git a/src/Dodge/Zoning/Wall.hs b/src/Dodge/Zoning/Wall.hs index 7dd44b001..df387253c 100644 --- a/src/Dodge/Zoning/Wall.hs +++ b/src/Dodge/Zoning/Wall.hs @@ -10,11 +10,11 @@ import Geometry import qualified IntMapHelp as IM wlIXsNearPoint :: Point2 -> World -> IS.IntSet -wlIXsNearPoint p w = zoneExtract (zoneOfPoint' wlZoneSize p) (w ^. cWorld . wlZoning) +wlIXsNearPoint p w = zoneExtract (zoneOfPoint wlZoneSize p) (w ^. cWorld . wlZoning) wlIXsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet {-# INLINE wlIXsNearSeg #-} -wlIXsNearSeg sp ep w = zonesExtract (w ^. cWorld . 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 ^. cWorld . wlZoning) $ zoneOfRect' wlZoneSize sp ep @@ -41,7 +41,7 @@ wlZoneSize :: Float wlZoneSize = 50 zoneOfWl :: Wall -> [Int2] -zoneOfWl = uncurry (zoneOfSeg' wlZoneSize) . _wlLine +zoneOfWl = uncurry (zoneOfSeg wlZoneSize) . _wlLine --minCrIXOn :: Ord a => (Creature -> a) -> IS.IntSet -> World -> Maybe Creature --minCrIXOn f is w = fmap fst $ IS.foldl' g Nothing is