From 496066e7279cd89b178f2104ec6aa9ec0eedfc57 Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 21 Aug 2022 22:10:38 +0100 Subject: [PATCH] Remove old zoning code --- src/Dodge/Data.hs | 2 - src/Dodge/Data/Zoning.hs | 23 ------ src/Dodge/Render/ShapePicture.hs | 16 ++-- src/Dodge/Zone.hs | 130 ------------------------------- src/Dodge/Zone/Update.hs | 28 ------- 5 files changed, 8 insertions(+), 191 deletions(-) delete mode 100644 src/Dodge/Data/Zoning.hs delete mode 100644 src/Dodge/Zone.hs delete mode 100644 src/Dodge/Zone/Update.hs diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index ae0c98a3e..f0c7c5590 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -6,7 +6,6 @@ module Dodge.Data ( module Dodge.Data.WorldEffect, module Dodge.Data.ArcStep, module Dodge.Data.Config, - module Dodge.Data.Zoning, module Dodge.Data.Distortion, module Dodge.Data.Material, module Dodge.Data.GenWorld, @@ -39,5 +38,4 @@ import Dodge.Data.Room import Dodge.Data.RoomCluster import Dodge.Data.Universe import Dodge.Data.World -import Dodge.Data.Zoning import MaybeHelp diff --git a/src/Dodge/Data/Zoning.hs b/src/Dodge/Data/Zoning.hs deleted file mode 100644 index 4adfd27ce..000000000 --- a/src/Dodge/Data/Zoning.hs +++ /dev/null @@ -1,23 +0,0 @@ -{-# LANGUAGE StrictData #-} -{-# LANGUAGE TemplateHaskell #-} - -module Dodge.Data.Zoning - where - -import Control.Lens -import qualified Data.IntSet as IS -import Geometry.Data -import qualified IntMapHelp as IM -import StreamingHelp - -data Zoning t a = Zoning - { _znObjects :: IM.IntMap (IM.IntMap (t a)) - , _znSize :: Float - , _znFunc :: Float -> a -> StreamOf Int2 - -- , _znInsert :: a -> t a -> t a - } - -newtype CrZoning = CrZoning {_getCrZoning :: IM.IntMap (IM.IntMap IS.IntSet)} - -makeLenses ''Zoning -makeLenses ''CrZoning diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index c9b4b7f37..9ced0108e 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -180,7 +180,7 @@ debugDraw' cfig w bl = case bl of Mouse_position -> drawMousePosition cfig w Walls_info -> drawWlIDs cfig w Pathing -> drawPathing cfig w - Show_nodes_near_select -> drawNodesNearSelect w + Show_nodes_near_select -> undefined --drawNodesNearSelect w Show_path_between -> drawPathBetween w Collision_test -> drawCollisionTest cfig w @@ -212,13 +212,13 @@ drawPathBetween w = sp = _lSelect w ep = _rSelect w -drawNodesNearSelect :: World -> Picture -drawNodesNearSelect w = - setLayer DebugLayer $ - runIdentity (S.foldMap_ (drawZoneCol orange pnZoneSize) (zoneAroundPoint pnZoneSize sp)) - <> color green (drawCross sp) - where - sp = _lSelect w +--drawNodesNearSelect :: World -> Picture +--drawNodesNearSelect w = +-- setLayer DebugLayer $ +-- runIdentity (S.foldMap_ (drawZoneCol orange pnZoneSize) (zoneAroundPoint pnZoneSize sp)) +-- <> color green (drawCross sp) +-- where +-- sp = _lSelect w drawInspectWalls :: World -> Picture drawInspectWalls w = diff --git a/src/Dodge/Zone.hs b/src/Dodge/Zone.hs deleted file mode 100644 index 8119907a3..000000000 --- a/src/Dodge/Zone.hs +++ /dev/null @@ -1,130 +0,0 @@ -module Dodge.Zone - ( zoneOfSight - , zoneAroundPoint - , aroundPoint - , nearPoint - , nearSeg - --, wlsNearPoint - --, crsNearPoint - --, clsNearPoint - --, wlsNearSeg - --, crsNearSeg - --, wlsInsideCirc - --, crsInsideCirc - --, clZoneOfPoint - --, crZoneOfPoint - , wlZoneOfPoint - , module Dodge.Zone.Size - , module Dodge.Zone.Object - , module Dodge.Zone.Update - ) - where -import Dodge.Zone.Object -import Dodge.Zone.Update -import Dodge.Zone.Size -import Dodge.Data ---import Dodge.Base.Window -import Geometry -import Geometry.Zone - -import qualified Streaming.Prelude as S -import StreamingHelp -import Data.Maybe -import Control.Lens - -extractFromZone :: Zoning t a -> Int2 -> Maybe (t a) -{-# INLINE extractFromZone #-} -extractFromZone zn (V2 x y) = zn ^? znObjects . ix x . ix y - -streamFromZone :: Foldable t => Zoning t a -> StreamOf Int2 -> StreamOf a -{-# INLINE streamFromZone #-} -streamFromZone zn = S.concat . S.mapMaybe (extractFromZone zn) - -zoneAroundPoint :: Float -> Point2 -> StreamOf Int2 -{-# INLINE zoneAroundPoint #-} -zoneAroundPoint s p = S.each [V2 a b | a <- [x-1..x+1] , b <- [y-1..y+1] ] - where - V2 x y = zoneOfPoint s p - --- this is ugly, might be better with zoneOfBounds or somesuch -zoneOfSight :: Float -> World -> Stream (Of (V2 Int)) Identity () --(Int,Int)] -{-# INLINE zoneOfSight #-} -zoneOfSight x' w = S.each - [V2 a b - | a <- [minimum xs .. maximum xs] - , b <- [minimum ys .. maximum ys] - ] - where - --(xs,ys) = unzip $ map zoneOfPoint $ screenPolygon cfig w -- ++ [_cameraViewFrom w] - (xs,ys) = unzip $ map (sizeZoneOfPoint x') $ w ^. cWorld . cwCam . cwcBoundBox - sizeZoneOfPoint s (V2 x y) = (f x, f y) - where - f = floor . (/ s) - -nearPoint :: (Foldable t,Monoid (t a)) - => (World -> Zoning t a) -> Point2 -> World -> StreamOf a -{-# INLINE nearPoint #-} -nearPoint f p w = S.each . fromMaybe mempty $ extractFromZone zn (zoneOfPoint (_znSize zn) p) - where - zn = f w - -aroundPoint :: Foldable t => (World -> Zoning t a) -> Point2 -> World -> StreamOf a -{-# INLINE aroundPoint #-} -aroundPoint f p w = streamFromZone zn $ zoneAroundPoint (_znSize zn) p - where - zn = f w - ---clsNearPoint :: Point2 -> World -> StreamOf Cloud ---{-# INLINE clsNearPoint #-} ---clsNearPoint = nearPoint _clZoning - ---wlsNearPoint :: Point2 -> World -> StreamOf Wall ---{-# INLINE wlsNearPoint #-} ---wlsNearPoint = nearPoint _wlZoning - ---crsNearPoint :: Point2 -> World -> StreamOf Creature ---{-# INLINE crsNearPoint #-} ---crsNearPoint = nearPoint _crZoning - -nearSeg :: Foldable t => (World -> Zoning t a) -> Point2 -> Point2 -> World -> StreamOf a -{-# INLINE nearSeg #-} -nearSeg f p r w = streamFromZone zn $ zoneOfSeg (_znSize zn) p r - where - zn = f w - ---wlsNearSeg :: Point2 -> Point2 -> World -> StreamOf Wall ---{-# INLINE wlsNearSeg #-} ---wlsNearSeg = nearSeg _wlZoning - ---crsNearSeg :: Point2 -> Point2 -> World -> StreamOf Creature ---{-# INLINE crsNearSeg #-} ---crsNearSeg = nearSeg _crZoning - ---insideCirc :: Foldable t => (World -> Zoning t a) -> Point2 -> Float -> World -> StreamOf a ---{-# INLINE insideCirc #-} ---insideCirc f p r w = streamFromZone zn $ zoneInsideCirc (_znSize zn) p r --- where --- zn = f w - ---wlsInsideCirc :: Point2 -> Float -> World -> Stream (Of Wall) Identity () ---{-# INLINE wlsInsideCirc #-} ---wlsInsideCirc = insideCirc _wlZoning - ---crsInsideCirc :: Point2 -> Float -> World -> StreamOf Creature ---{-# INLINE crsInsideCirc #-} ---crsInsideCirc = insideCirc _crZoning - -wlZoneOfPoint :: Point2 -> Int2 -{-# INLINE wlZoneOfPoint #-} -wlZoneOfPoint = zoneOfPoint wlZoneSize - -wlZoneSize :: Float -wlZoneSize = 50 - ---clZoneOfPoint :: Point2 -> Int2 ---{-# INLINE clZoneOfPoint #-} ---clZoneOfPoint = zoneOfPoint clZoneSize - ---crZoneOfPoint :: Point2 -> Int2 ---{-# INLINE crZoneOfPoint #-} ---crZoneOfPoint = zoneOfPoint crZoneSize diff --git a/src/Dodge/Zone/Update.hs b/src/Dodge/Zone/Update.hs deleted file mode 100644 index f54c79c35..000000000 --- a/src/Dodge/Zone/Update.hs +++ /dev/null @@ -1,28 +0,0 @@ -module Dodge.Zone.Update ( - --updateZoning, -) where - -import Dodge.Data.Zoning -import Geometry -import qualified IntMapHelp as IM -import LensHelp -import qualified Streaming.Prelude as S - -updateZoning :: Monoid (t a) => (a -> t a -> t a) -> a -> Zoning t a -> Zoning t a -{-# INLINE updateZoning #-} -updateZoning f obj zn = runIdentity (S.fold_ doinsert zn id (_znFunc zn (_znSize zn) obj)) - where - doinsert znobs vxy = insertInZoneWith vxy (\_ -> f obj) (f obj mempty) znobs - -insertInZoneWith :: - Int2 -> - -- | Combining function - (t a -> t a -> t a) -> - -- | Value to insert - t a -> - Zoning t a -> - Zoning t a -{-# INLINE insertInZoneWith #-} -insertInZoneWith (V2 x y) fun obj = over znObjects $ IM.insertWith f x $ IM.singleton y obj - where - f _ = IM.insertWith fun y obj