Remove old zoning code

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

src/Dodge/Data/Zoning.hs

@@ -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

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 :: World -> Picture
-drawNodesNearSelect w =
+--drawNodesNearSelect w =
-    setLayer DebugLayer $
+--    setLayer DebugLayer $
-        runIdentity (S.foldMap_ (drawZoneCol orange pnZoneSize) (zoneAroundPoint pnZoneSize sp))
+--        runIdentity (S.foldMap_ (drawZoneCol orange pnZoneSize) (zoneAroundPoint pnZoneSize sp))
-            <> color green (drawCross sp)
+--            <> color green (drawCross sp)
-  where
+--  where
-    sp = _lSelect w
+--    sp = _lSelect w
 
 drawInspectWalls :: World -> Picture
 drawInspectWalls w =

src/Dodge/Zone.hs

@@ -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

src/Dodge/Zone/Update.hs

@@ -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