Cleanup, move towards unifying zones

appHetris/Hetris.hs

@@ -1,21 +0,0 @@
-module Main where
-import Loop
-import Hetris.Base
-
-import Control.Lens
---import Foreign (Word32)
-import Control.Monad
---import System.Random
-import qualified Data.Map                  as M
-import qualified Data.IntMap               as IM
-import Graphics.Rendering.OpenGL hiding (color, rotate, scale, translate)
-import qualified SDL
-import qualified SDL.Mixer                 as Mix
-
-main :: IO ()
-main = setupMiniLoop
-    (600,600)
-    initWorld
-    (const $ return ())
-    (\w _ -> return w)
-    return

package.yaml

@@ -83,23 +83,6 @@ executables:
 #    - -hiedir=.hie
     dependencies:
     - loop
-  hetris:
-    main:        Hetris.hs
-    source-dirs: appHetris
-    ghc-options:
-    - -threaded
-    - -O2
-    - -rtsopts
-    - -with-rtsopts=-N
-    - -flate-dmd-anal
-    - -fno-liberate-case 
-    - -fno-state-hack
-    - -funfolding-use-threshold1000 
-    - -funfolding-keeness-factor1000 
-    - -fllvm 
-    - -optlo-O3
-    dependencies:
-    - loop
 
 tests:
   loop-test:

src/Dodge/Base.hs

@@ -6,7 +6,8 @@ Consider splitting. -}
 module Dodge.Base 
     where
 import Dodge.Data
-import Dodge.Base.Zone
+import Dodge.Zone
+import Dodge.Zone.Data
 import Dodge.Base.Window
 import Geometry
 --import Picture
@@ -68,10 +69,10 @@ wallsOnCirc p r = IM.filter f
     f wl = uncurry circOnSeg (_wlLine wl) p r
 
 allWalls :: World -> IM.IntMap Wall
-allWalls w = IM.unions $ concatMap IM.elems $ IM.elems $ _wallsZone w
+allWalls w = IM.unions $ concatMap IM.elems $ IM.elems $ _znObjects $ _wallsZone w
 
 creaturesNearPoint :: Point2 -> World -> IM.IntMap Creature
-creaturesNearPoint p w =  IM.unions [f b $ f a $ _creaturesZone w | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
+creaturesNearPoint p w =  IM.unions [f b $ f a $ _znObjects $ _creaturesZone w | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
   where 
     (x,y) = crZoneOfPoint p
     f i m = case IM.lookup i m of 
@@ -79,27 +80,20 @@ creaturesNearPoint p w =  IM.unions [f b $ f a $ _creaturesZone w | a<-[x-1,x,x+
         _        -> IM.empty
 
 creaturesNearPointI :: Int -> Point2 -> World -> IM.IntMap Creature
-creaturesNearPointI n p w =  IM.unions [f b $ f a $ _creaturesZone w | a<-[x-n..x+n] , b<-[y-n..y+n]]
+creaturesNearPointI n p w =  IM.unions [f b $ f a $ _znObjects $ _creaturesZone w | a<-[x-n..x+n] , b<-[y-n..y+n]]
   where 
     (x,y) = crZoneOfPoint p
     f i m = case IM.lookup i m of 
         Just val -> val
         _        -> IM.empty
 
-cloudsNearPoint :: Point2 -> World -> [Cloud]
---cloudsNearPoint p w =  IM.unions [f b $ f a $ _cloudsZone w | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
-cloudsNearPoint p w = f (IM.lookup x (_cloudsZone w) >>= IM.lookup y)
-  where 
-    (x,y) = cloudZoneOfPoint p
-    f Nothing = []
-    f (Just l) = l
 -- possible BUG, occurs when used in thingsHitLongLine
 creaturesAlongLine :: Point2 -> Point2 -> World -> IM.IntMap Creature
 --creaturesAlongLine a b w = IM.unions [f y $ f x $ _creaturesZone w | (x,y) <- zoneOfLine a b]
 --    where f i m = case IM.lookup i m of Just val -> val
 --                                        _        -> IM.empty
 creaturesAlongLine a b w = IM.foldrWithKey' g IM.empty kps
-    where g x s = IM.union (IM.unions (IM.restrictKeys (f x $ _creaturesZone w) s))
+    where g x s = IM.union (IM.unions (IM.restrictKeys (f x $ _znObjects $ _creaturesZone w) s))
           kps = zoneOfLineIntMap a b
           f i m = case IM.lookup i m of Just val -> val
                                         _        -> IM.empty

src/Dodge/Base/Collide.hs

@@ -3,7 +3,7 @@
 module Dodge.Base.Collide
     where
 import Dodge.Data
-import Dodge.Base.Zone
+import Dodge.Zone
 import Geometry
 import FoldableHelp
 

src/Dodge/Creature/Action.hs

@@ -14,8 +14,9 @@ import Dodge.Path
 import Dodge.Creature.Stance.Data
 import Dodge.WorldEvent.Shockwave
 import Dodge.Data
+import Dodge.Data.SoundOrigin
 import Dodge.Base
-import Dodge.Base.Zone
+import Dodge.Zone
 import Dodge.Base.Collide
 import Dodge.SoundLogic
 import Dodge.SoundLogic.Synonyms

src/Dodge/Creature/Impulse.hs

@@ -3,8 +3,10 @@ module Dodge.Creature.Impulse
     )
     where
 import Dodge.Data
+import Dodge.Data.SoundOrigin
 import Dodge.Creature.Impulse.Movement
 import Dodge.Creature.Impulse.UseItem
+import Dodge.Data.DamageType
 --import Dodge.Creature.Action.UseItem
 import Dodge.Creature.State.Data
 import Dodge.Creature.Stance.Data

src/Dodge/Creature/Perception.hs

@@ -10,6 +10,7 @@ import Dodge.Creature.Memory.Data
 import Dodge.Base.Collide
 import Geometry.Vector
 --import Geometry.Data
+import Geometry.Data
 import Sound.Data
 --import StrictHelp
 

src/Dodge/Creature/Picture.hs

@@ -8,6 +8,7 @@ module Dodge.Creature.Picture
     , picAtCrPosNoRot
     ) where
 import Dodge.Data
+import Dodge.Data.DamageType
 --import Dodge.Base
 --import Dodge.Creature.Stance.Data
 import Dodge.Creature.Perception.Data

src/Dodge/Creature/State.hs

@@ -1,5 +1,7 @@
 module Dodge.Creature.State where
 import Dodge.Data
+import Dodge.Data.DamageType
+import Dodge.Data.SoundOrigin
 import Dodge.Item.Data
 import Dodge.Creature.State.Data
 import Dodge.Creature.State.WalkCycle

src/Dodge/Creature/State/WalkCycle.hs

@@ -1,8 +1,10 @@
 module Dodge.Creature.State.WalkCycle
     where
 import Dodge.Data
+import Dodge.Data.SoundOrigin
 import Dodge.Creature.Stance.Data
 import Dodge.SoundLogic
+import Geometry.Data
 
 import Control.Lens
 

src/Dodge/Data.hs

@@ -4,17 +4,11 @@ different modules because they are interdependent;
 circular imports are probably not a good idea.
  -}
 {-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE DeriveGeneric #-}
 module Dodge.Data 
-    ( module Dodge.Data
+    where
-    , module Dodge.Data.DamageType
-    , module Dodge.Data.SoundOrigin
-    , Point2 
-    , Sound (..)
-    , soundTime
-    ) where
 import Dodge.Creature.State.Data
 import Dodge.Creature.Stance.Data
 import Dodge.Creature.Perception.Data
@@ -22,6 +16,7 @@ import Dodge.Creature.Memory.Data
 import Dodge.Debug.Flag.Data
 import Dodge.Data.SoundOrigin
 import Dodge.Data.DamageType
+import Dodge.Zone.Data
 import Dodge.Config.Data
 import Dodge.Config.KeyConfig
 import Dodge.Item.Attachment.Data
@@ -55,17 +50,15 @@ data World = World
     , _cameraZoom           :: !Float
     , _cameraViewFrom       :: !Point2
     , _creatures            :: IM.IntMap Creature
-    , _creaturesZone        :: IM.IntMap (IM.IntMap (IM.IntMap Creature))
+    , _creaturesZone        :: Zone (IM.IntMap Creature)
     , _creatureGroups       :: IM.IntMap CrGroupParams
     , _itemPositions        :: IM.IntMap ItemPos
     , _clouds               :: [Cloud]
-    , _cloudsZone           :: IM.IntMap (IM.IntMap [Cloud])
+    , _cloudsZone           :: Zone [Cloud]
     , _projectiles          :: IM.IntMap Projectile
     , _particles            :: ![Particle]
-    , _staticWalls          :: IM.IntMap (IM.IntMap [Wall'])
-    , _seenStaticWalls      :: IM.IntMap (IM.IntMap [Wall'])
     , _walls                :: !(IM.IntMap Wall)
-    , _wallsZone            :: IM.IntMap (IM.IntMap (IM.IntMap Wall))
+    , _wallsZone            :: Zone (IM.IntMap Wall)
     , _forceFields          :: IM.IntMap ForceField
     , _floorItems           :: IM.IntMap FloorItem
     , _floorTiles           :: [(Point3,Point3)]
@@ -81,12 +74,11 @@ data World = World
     , _decorations          :: IM.IntMap Picture
     , _foregroundDecorations :: [Polyhedra]
     , _foregroundEdgeVerx   :: [Point3]
-    , _corpses              :: IM.IntMap (IM.IntMap [Corpse])
+    , _corpses              :: Zone [Corpse]
     , _clickMousePos        :: !Point2
     , _pathGraph            :: ~(Gr Point2 Float)
     , _pathGraph'           :: ~[(Point2,Point2)]
     , _pathPoints           :: ~(IM.IntMap (IM.IntMap [(Int,Point2)]))
-    , _pathInc              :: ~(M.Map Point2 [Point2])
     , _storedLevel          :: Maybe World
     , _menuLayers           :: [ScreenLayer]
     , _worldState           :: M.Map WorldState Bool

src/Dodge/Debug.hs

@@ -2,7 +2,7 @@ module Dodge.Debug where
 import Dodge.Data
 import Dodge.Picture
 import Dodge.Picture.Layer
-import Dodge.Base.Zone
+import Dodge.Zone
 import Dodge.Base
 import Geometry.Zone
 import Geometry.Data

src/Dodge/Debug/LinkDecoration.hs

@@ -8,6 +8,7 @@ import Dodge.Room.Data
 import Dodge.Picture.Layer
 import Picture
 import qualified IntMapHelp as IM
+import Geometry.Data
 import Geometry.Vector
 
 import Control.Lens

src/Dodge/Default.hs

@@ -7,6 +7,8 @@ This module contains prototypical data structures.
 module Dodge.Default where
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Data
+import Dodge.Data.DamageType
+import Dodge.Data.SoundOrigin
 import Dodge.Item.Data
 import Dodge.Creature.Stance.Data
 import Dodge.Creature.State.Data

src/Dodge/Default/World.hs

@@ -2,6 +2,7 @@ module Dodge.Default.World
     where
 import Dodge.Data
 import Dodge.Base
+import Dodge.Zone.Data
 import Dodge.Debug.Flag.Data
 import Dodge.Config.Data
 import Dodge.Config.KeyConfig
@@ -28,17 +29,15 @@ defaultWorld = World
     , _cameraZoom = 1
     , _cameraViewFrom = V2 0 0
     , _creatures = IM.empty
-    , _creaturesZone = IM.empty
+    , _creaturesZone = Zone IM.empty 15
     , _creatureGroups = IM.empty
     , _clouds = []
-    , _cloudsZone = IM.empty
+    , _cloudsZone = Zone IM.empty 20
     , _itemPositions = IM.empty
     , _projectiles = IM.empty
     , _particles = []
-    , _staticWalls = IM.empty
-    , _seenStaticWalls = IM.empty
     , _walls = IM.empty
-    , _wallsZone = IM.empty
+    , _wallsZone = Zone IM.empty 50
     , _forceFields = IM.empty
     , _floorItems = IM.empty
     , _floorTiles = []
@@ -51,7 +50,7 @@ defaultWorld = World
     , _buttons = IM.empty
     , _sounds = M.empty
     , _playingSounds = M.empty
-    , _corpses = IM.empty
+    , _corpses = Zone IM.empty 50
     , _decorations = IM.empty
     , _storedLevel = Nothing
     , _menuLayers = []
@@ -61,7 +60,6 @@ defaultWorld = World
     , _pathGraph = Data.Graph.Inductive.Graph.empty
     , _pathGraph' = []
     , _pathPoints = IM.empty
-    , _pathInc = M.empty
     , _carteDisplay = False
     , _carteCenter = V2 0 0
     , _carteZoom = 0.5

src/Dodge/Event.hs

@@ -16,6 +16,7 @@ module Dodge.Event
 import Dodge.Event.Keyboard
 --import Dodge.Event.Menu
 import Dodge.Data
+import Dodge.Data.SoundOrigin
 import Dodge.Base
 import Dodge.Base.Window
 --import Dodge.Creature.Action

src/Dodge/Initialisation.hs

@@ -1,8 +1,9 @@
 module Dodge.Initialisation where
 import Dodge.Default.World
 import Dodge.Data
+import Dodge.Data.SoundOrigin
 import Dodge.Creature
-import Dodge.Base.Zone
+import Dodge.Zone
 import Dodge.Floor
 import Dodge.Layout
 import Dodge.Story

src/Dodge/Item/Consumable.hs

@@ -1,6 +1,7 @@
 module Dodge.Item.Consumable
     where
 import Dodge.Data
+import Dodge.Data.SoundOrigin
 import Dodge.Item.Data
 import Dodge.Picture.Layer
 import Dodge.Default

src/Dodge/Item/Weapon.hs

@@ -3,8 +3,9 @@ In progress: move out effects into other modules.  -}
 module Dodge.Item.Weapon 
     where
 import Dodge.Data
+import Dodge.Data.SoundOrigin
 import Dodge.Base
-import Dodge.Base.Zone
+import Dodge.Zone
 import Dodge.Picture.Layer
 import Dodge.SoundLogic
 import Dodge.SoundLogic.Synonyms

src/Dodge/Item/Weapon/Booster.hs

@@ -2,7 +2,7 @@ module Dodge.Item.Weapon.Booster
     where
 import Dodge.Data
 import Dodge.Base
-import Dodge.Base.Zone
+import Dodge.Zone
 import Dodge.Base.Collide
 import Geometry
 import qualified IntMapHelp as IM

src/Dodge/Item/Weapon/Decoration.hs

@@ -6,7 +6,7 @@ module Dodge.Item.Weapon.Decoration
 import Dodge.Data
 import Dodge.Picture.Layer
 import Dodge.Picture
---import Geometry.Data
+import Geometry.Data
 import Picture
 
 import Control.Lens

src/Dodge/Item/Weapon/Grenade.hs

@@ -1,9 +1,10 @@
 module Dodge.Item.Weapon.Grenade
     where
 import Dodge.Data
+import Dodge.Data.SoundOrigin
 import Dodge.Item.Data
 import Dodge.Base
-import Dodge.Base.Zone
+import Dodge.Zone
 import Dodge.Picture.Layer
 import Dodge.SoundLogic
 import Dodge.SoundLogic.Synonyms

src/Dodge/Item/Weapon/Laser.hs

@@ -2,6 +2,7 @@
 module Dodge.Item.Weapon.Laser
     where
 import Dodge.Data
+import Dodge.Data.DamageType
 import Dodge.Picture
 --import Dodge.Picture.Layer
 import Dodge.Item.Attachment.Data

src/Dodge/Item/Weapon/Launcher.hs

@@ -1,6 +1,7 @@
 module Dodge.Item.Weapon.Launcher
     where
 import Dodge.Data
+import Dodge.Data.SoundOrigin
 import Dodge.Default.Weapon
 import Dodge.Default.Shell
 import Dodge.SoundLogic.Synonyms
@@ -11,7 +12,7 @@ import Dodge.Item.Draw
 import Dodge.Item.Weapon.Shell
 import Dodge.Item.Weapon.TriggerType
 import Dodge.Base
-import Dodge.Base.Zone
+import Dodge.Zone
 import Dodge.SoundLogic
 import Dodge.WorldEvent.SpawnParticle
 import Dodge.WorldEvent.Cloud

src/Dodge/Item/Weapon/Targeting.hs

@@ -1,6 +1,7 @@
 module Dodge.Item.Weapon.Targeting
     where
 import Dodge.Data
+import Geometry.Data
 
 import Control.Lens
 --import qualified Data.IntMap.Strict as IM

src/Dodge/Item/Weapon/TriggerType.hs

@@ -35,6 +35,7 @@ module Dodge.Item.Weapon.TriggerType
     )
     where
 import Dodge.Data
+import Dodge.Data.SoundOrigin
 import Dodge.SoundLogic
 import Dodge.Creature.Action (startReloadingWeapon)
 import Dodge.WorldEvent (tempLightForAt)

src/Dodge/Item/Weapon/UseEffect.hs

@@ -5,7 +5,7 @@ module Dodge.Item.Weapon.UseEffect
     where
 import Dodge.Data
 import Dodge.Base
-import Dodge.Base.Zone
+import Dodge.Zone
 import Dodge.Base.Collide
 import Dodge.Picture.Layer
 --import Dodge.Item.Weapon.Decoration

src/Dodge/Layout.hs

@@ -5,11 +5,12 @@ import Dodge.LevelGen
 import Dodge.LevelGen.StaticWalls
 --import Dodge.LevelGen.Data
 import Dodge.Base
-import Dodge.Base.Zone
+import Dodge.Zone
+import Dodge.Zone.Data
 import Dodge.GameRoom
 import Dodge.Bounds
 --import Dodge.RandomHelp
-import Dodge.Graph
+--import Dodge.Graph
 import Dodge.Layout.Tree.Polymorphic (applyToRoot)
 import Dodge.Room.Data
 import Dodge.Room.AddTile
@@ -31,13 +32,14 @@ import System.Random
 --import Data.Maybe
 import Data.Tree
 import Data.Graph.Inductive.Graph (labNodes)
-import qualified Data.Map as M
+--import qualified Data.Map as M
 import Data.Foldable
 import qualified Control.Foldl as L
 import Data.Maybe
 
 generateLevelFromRoomList :: State StdGen [Room] -> World -> World
-generateLevelFromRoomList gr w = updateWallZoning 
+generateLevelFromRoomList gr w 
+    = updateWallZoning 
     . setupWorldBounds
 --    . initializeStaticWalls
     . setupForegroundEdgeVerxs
@@ -87,7 +89,6 @@ generateFromTree t w = updateWallZoning $ placeSpots plmnts
         ,_pathGraph     = path
         ,_pathGraph'    = pairGraph
         ,_pathPoints    = foldl' (flip insertPoint) IM.empty (labNodes path) 
-        ,_pathInc       = pinc
         }
   where 
     tr = evalState t $ _randGen w
@@ -95,15 +96,7 @@ generateFromTree t w = updateWallZoning $ placeSpots plmnts
     path = pairsToGraph dist pairGraph
     pairGraph = makePath tr
     insertPoint  pp@(_,V2 x y) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
-    pinc = M.fromList $ pairsToIncidence pairGraph
+    --pinc = M.fromList $ pairsToIncidence pairGraph
-
-initializeStaticWalls :: World -> World
-initializeStaticWalls w = w & staticWalls %~ (\wls' -> foldl' (flip wallToWall) wls' wls)
-    & walls %~ IM.filter (not . wlIsWall)
-  where
-    wls = [wl | wl@Wall{} <- IM.elems $ _walls w]
-    wlIsWall Wall{} = True
-    wlIsWall _ = False
 
 wallToWall :: Wall -> IM.IntMap (IM.IntMap [Wall']) -> IM.IntMap (IM.IntMap [Wall'])
 wallToWall wl wls = foldl' (flip f) wls is
@@ -113,7 +106,7 @@ wallToWall wl wls = foldl' (flip f) wls is
     f (x,y) = insertInZoneWith x y (++) [wl']
 
 updateWallZoning :: World -> World
-updateWallZoning w = set wallsZone (foldl' (flip wallInZone) IM.empty (_walls w)) w
+updateWallZoning w = set (wallsZone . znObjects) (foldl' (flip wallInZone) IM.empty (_walls w)) w
   where
     wallInZone wl 
         | uncurry dist (_wlLine wl) <= 2*zoneSize = insertIMInZone x y wlid wl

src/Dodge/LevelGen/AutoDoor.hs

@@ -12,6 +12,7 @@ import Dodge.Creature.Property
 import Dodge.LevelGen.DoorPane
 --import Geometry
 import Picture
+import Geometry.Data
 --import qualified DoubleStack as DS
 import qualified IntMapHelp as IM
 

src/Dodge/LevelGen/Block.hs

@@ -1,8 +1,10 @@
 {- | Creation, update and destruction of destructible walls.  -}
 module Dodge.LevelGen.Block where
 import Dodge.Data
+import Dodge.Data.SoundOrigin
 import Dodge.Base
-import Dodge.Base.Zone
+import Dodge.Zone
+import Dodge.Zone.Data
 import Dodge.SoundLogic
 import Dodge.WorldEvent.Sound
 import Dodge.LevelGen.Pathing
@@ -24,7 +26,7 @@ updateBlocks w = (\w' -> seq (_wallsZone w') w') $ flip (foldr removeFromZone) d
  where  
     degradeBlocks = deadBlocks `seq` foldr killBlock w deadBlocks
     removeFromZone :: Wall -> World -> World
-    removeFromZone bl = over (wallsZone . ix x . ix y) (IM.delete (_wlID bl))
+    removeFromZone bl = over (wallsZone . znObjects . ix x . ix y) (IM.delete (_wlID bl))
       where 
         (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine bl)
     deadPanes = filter blockIsDead (IM.elems $ _walls w)
@@ -54,7 +56,7 @@ killBlock bl w =  f bl . flip (foldr unshadow) (_blShadows bl) $ w
     unshadow bid w' = case w' ^? walls . ix bid of 
         Just b -> 
             let (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine b)
-            in w & wallsZone . ix x . ix y . ix bid . blVisible %~ const True
+            in w & wallsZone . znObjects . ix x . ix y . ix bid . blVisible %~ const True
                  & walls . ix bid . blVisible %~ const True
         Nothing -> w
 
@@ -100,7 +102,7 @@ addBlock (p:ps) hp col isSeeThrough degradability w
     | hp <= 0 && null degradability = w
     | hp <= 0 = addBlock (p:ps) (head degradability + hp) col isSeeThrough (tail degradability) w
     | otherwise = w  
-        & wallsZone %~ flip (IM.foldr wallInZone) panes
+        & wallsZone . znObjects %~ flip (IM.foldr wallInZone) panes
         & walls     %~ IM.union panes
   where 
     lns = zip (p:ps) (ps ++ [p])

src/Dodge/LevelGen/Data.hs

@@ -20,6 +20,7 @@ module Dodge.LevelGen.Data
 import Dodge.Data
 import Picture
 import Polyhedra.Data
+import Geometry.Data
 
 import Control.Lens
 import Control.Monad.State

src/Dodge/LevelGen/DoorPane.hs

@@ -8,6 +8,7 @@ import Dodge.LevelGen.MoveDoor
 import Picture
 import qualified DoubleStack as DS
 import Geometry.Vector
+import Geometry.Data
 
 import Data.Bifunctor
 

src/Dodge/LevelGen/MoveDoor.hs

@@ -6,8 +6,10 @@ module Dodge.LevelGen.MoveDoor
     , addSoundToDoor
     ) where
 import Dodge.Data
+import Dodge.Data.SoundOrigin
 import Dodge.Base
-import Dodge.Base.Zone
+import Dodge.Zone
+import Dodge.Zone.Data
 import Dodge.SoundLogic
 import Dodge.SoundLogic.Synonyms
 import Geometry
@@ -58,7 +60,7 @@ changeZonedWall
     -> (Int,Int)
     -> World
     -> World
-changeZonedWall eff n (x,y) = over wallsZone $ adjustIMZone eff x y n
+changeZonedWall eff n (x,y) = over (wallsZone . znObjects) $ adjustIMZone eff x y n
 
 addSoundToDoor :: Int -> Point2 -> Point2 -> [Wall] -> [Wall]
 addSoundToDoor _   _   _ [] = error "When creating door tried to add sound to nothing"

src/Dodge/LevelGen/Pathing.hs

@@ -2,7 +2,7 @@ module Dodge.LevelGen.Pathing
     where
 import Dodge.Data
 import Dodge.Base
-import Dodge.Base.Zone
+import Dodge.Zone
 import Geometry
 
 import Control.Lens

src/Dodge/LevelGen/StaticWalls.hs

@@ -1,20 +1,15 @@
---{-# LANGUAGE TupleSections #-}
 {-|
 Module      : Dodge.LevelGen.StaticWalls
 Description : Concerns carving out of static walls to create the general room plan of the level.
 -}
 module Dodge.LevelGen.StaticWalls 
     where
-import Dodge.Data
 import Geometry
 import Geometry.ConvexPoly
---import Geometry.Data
 import FoldableHelp
 
---import Control.Lens
 import Data.List.Extra
 import Data.Maybe
-import Data.Bifunctor
 -- | Describe a wall as two points.
 -- Order is important: the wall face is to the left of the line going from 
 -- 'fst' to 'snd'.
@@ -43,20 +38,14 @@ cutWalls :: [Point2] -> [WallP] -> [WallP]
 cutWalls ps wls = case mapMaybe (`checkWallRight` newWalls) newWalls of
     [] -> newWalls
     _  -> cutWallsRetry 0 ps wls
---    _  -> wls
---    _  -> error $ show ps 
   where
     newWalls = cutPoly ps wls
 cutWallsRetry :: Int -> [Point2] -> [WallP] -> [WallP]
---cutWallsRetry 200 ps wls = error $ show ps ++ show wls
 cutWallsRetry i ps wls = case mapMaybe (`checkWallRight` newWalls) newWalls of
     [] -> newWalls
     _  -> cutWallsRetry (i+1) ps wls
---    _  -> wls
---    _  -> error $ show ps 
   where
     newWalls = cutPoly ps' wls
-    --ps' = map (rotateV a) $ expandPolyBy 0.1 ps
     ps' = map (rotateV a) $ expandPolyBy x ps
     x = fromIntegral i / 100
     a | even i    = 0.001
@@ -137,7 +126,6 @@ cutPoly qs wls =
 expandPolyBy :: Float -> [Point2] -> [Point2]
 expandPolyBy x ps = map f ps
   where
-    --cp = 1/fromIntegral (length ps) *.* foldl' (+.+) (V2 0 0) ps
     cp = centroid ps
     f p = p +.+ x *.* (p -.- cp)
 -- | Given a value and a poly, pushes the poly points out from the center by the
@@ -145,7 +133,6 @@ expandPolyBy x ps = map f ps
 expandPolyByFixed :: Float -> [Point2] -> [Point2]
 expandPolyByFixed x ps = map f ps
   where
-    --cp = 1/fromIntegral (length ps) *.* foldl' (+.+) (V2 0 0) ps
     cp = centroid ps
     f p = p +.+ x *.* safeNormalizeV (p -.- cp)
 -- | Given a polygon expressed as a list of points and a collection of walls,
@@ -189,13 +176,10 @@ addPolyWall wls (p1,p2) =
             else (p1,p2) : wls
         Nothing -> (p1,p2) : wls
   where 
-    --maybeWs = safeMinimumOn (dist p3 . fromJust . f) $ filter (isJust . f) wls
-    --maybeWs = fmap fst $ safeMinimumOn (dist p3 . snd) $ mapMaybe (\x -> (x,) <$> f x) wls
     maybeWs = safeMinimumOnMaybe (fmap (dist p3) . f) wls
     p3 = 0.5 *.* (p1 +.+ p2)
     p4 = p3 +.+ 10000 *.* vNormal (p2 -.- p1)
     f = uncurry $ myIntersectSegSeg p3 p4
-    --g = uncurry $ intersectSegSegTest p3 p4
 -- | Given a list of points and a point, returns a point in the list if any is close
 -- to the point.
 findClosePoint :: [Point2] -> Point2 -> Maybe Point2
@@ -243,88 +227,9 @@ findWallsInPolygon ps = filter cond
   where 
     cond wall = pointInOrOnPolygon (0.5 *.* uncurry (+.+) wall) ps
 
-brokenWalls :: [(Point2,Point2)]
-brokenWalls = map (bimap toV2 toV2)
-    [((330.12192,3032.2456),(190.52365,2995.8352)),((190.52365,2995.8352),(203.94716,2945.9377)),((214.33855,2907.311),(230.12193,2859.0405)),((230.12193,2859.0405),(366.7245,2895.643)),((366.7245,2895.643),(330.12192,3032.2456)),((366.7245,2895.643),(230.12193,2859.0405)),((230.12193,2859.0405),(266.7245,2722.438)),((266.7245,2722.438),(403.32703,2759.0405)),((403.32703,2759.0405),(503.32703,2932.2456)),((466.72446,3068.8481),(330.12192,3032.2456)),((330.12192,3032.2456),(366.7245,2895.643)),((503.32703,2932.2456),(466.72446,3068.8481)),((203.94716,2945.9377),(145.99155,2930.4084)),((156.38292,2891.7817),(214.33855,2907.311)),((107.47222,2920.979),(34.06077,2901.2295)),((34.06077,2901.2295),(52.571453,2832.4224)),((70.17772,2796.55),(174.45558,2824.6025)),((174.45558,2824.6025),(156.38292,2891.7817)),((100.76944,2955.4202),(107.47222,2920.979)),((145.99155,2930.4084),(140.79587,2949.722)),((52.571453,2832.4224),(35.882084,2827.9504)),((31.745949,2785.4312),(70.17772,2796.55)),((88.14497,3002.5354),(100.76944,2955.4202)),((140.79587,2949.722),(120.21855,3027.0303)),((35.882084,2827.9504),(-22.07344,2812.4214)),((-31.039248,2768.608),(31.745949,2785.4312)),((-261.32483,3408.5737),(-303.9881,3451.237)),((-303.9881,3451.237),(-332.27234,3422.9526)),((-332.27234,3422.9526),(-289.84595,3380.5264)),((-261.56174,3352.242),(88.14497,3002.5354)),((120.21855,3027.0303),(-233.27742,3380.5264)),((-289.84595,3380.5264),(-332.2724,3338.0999)),((-332.2724,3338.0999),(-303.9881,3309.8157)),((-303.9881,3309.8157),(-261.56174,3352.242)),((-22.07344,2812.4214),(-89.68823,2794.304)),((-79.335526,2755.667),(-31.039248,2768.608)),((-210.16953,3456.4133),(-261.32483,3408.5737)),((-233.27742,3380.5264),(-194.64026,3419.1633)),((-128.32533,2783.9514),(-200.79468,3054.4106)),((-200.79468,3054.4106),(-780.35016,2899.1191)),((-780.35016,2899.1191),(-625.05865,2319.5635)),((-625.05865,2319.5635),(-45.503174,2474.855)),((-45.503174,2474.855),(-117.97253,2745.3142)),((-89.68823,2794.304),(-128.32533,2783.9514)),((-117.97253,2745.3142),(-79.335526,2755.667)),((-178.49438,3590.2566),(-241.50847,3573.372)),((-241.50847,3573.372),(-210.16953,3456.4133)),((-194.64026,3419.1633),(-136.80266,3434.6611)),((-98.165634,3445.014),(-139.85736,3600.6094)),((-92.98925,3425.6953),(-98.165634,3445.014)),((-136.80266,3434.6611),(-127.74397,3400.8535)),((-187.553,3624.064),(-178.49438,3590.2566)),((-139.85736,3600.6094),(-148.91603,3634.4167)),((-127.74397,3400.8535),(-111.20285,3339.121)),((-78.55679,3371.8325),(-92.98925,3425.6953)),((-349.5008,4383.0093),(-388.13782,4372.6563)),((-388.13782,4372.6563),(-485.18823,3653.0168)),((-485.18823,3653.0168),(-477.42368,3624.039)),((-477.42368,3624.039),(-206.96445,3696.5085)),((-168.32744,3706.861),(102.131805,3779.3306)),((102.131805,3779.3306),(94.36725,3808.308)),((94.36725,3808.308),(-349.5008,4383.0093)),((-206.96445,3696.5085),(-187.553,3624.064)),((-148.91603,3634.4167),(-168.32744,3706.861)),((299.35522,3346.2668),(97.2383,3547.9797)),((97.2383,3547.9797),(-78.55679,3371.8325)),((-111.20285,3339.121),(116.74672,3110.6904)),((116.74672,3110.6904),(320.08704,3314.438)),((352.084,3395.578),(299.35522,3346.2668)),((320.08704,3314.438),(367.6133,3358.328)),((495.06226,3666.979),(293.8115,3613.054)),((293.8115,3613.054),(352.084,3395.578)),((367.6133,3358.328),(563.6875,3410.866)),((563.6875,3410.866),(495.06226,3666.979))]
-
---intersectingBrokenWalls :: [(Point2,Point2)]
---intersectingBrokenWalls = filter (uncurry test) brokenWalls
---  where
---    polyPairs = zip brokenPoly (tail brokenPoly ++ [head brokenPoly])
---    test a b = any (isJust . uncurry (myIntersectSegSeg a b)) polyPairs
-
---brokenPoly :: [Point2]
---brokenPoly = [(434.66675,2833.3225),(503.9488,2793.3225),(523.9488,2827.9636),(454.66675,2867.9636)]
-
---iBWall :: (Point2,Point2)
---iBWall = ((403.32703,2759.0405),(503.32703,2932.2456))
-
 expandToSquare :: (Point2,Point2) -> [(Point2,Point2)]
 expandToSquare (a,b) = [(a,b),(b,c),(c,d),(d,a)]
   where
     v = a -.- b
     c = b +.+ vNormal v
     d = a +.+ vNormal v
-
---minWalls :: [(Point2,Point2)]
---minWalls = expandToSquare iBWall
-
---brokenZs :: [Point2]
---brokenCwals :: [WallP]
---(brokenZs,brokenCwals) = cutWallsWithPoints brokenPoly brokenWalls
-
---minZs :: [Point2]
---minCwals :: [WallP]
---(minZs,minCwals) = cutWallsWithPoints brokenPoly minWalls
---
---brokenRs :: [Point2]
---brokenRs = orderPolygon $ nub $ minZs ++ brokenPoly
---
---brokenAfterRemovedWalls :: [WallP]
---brokenAfterRemovedWalls = removeWallsInPolygon (orderPolygon brokenPoly) brokenCwals
---minAfterRemovedWalls :: [WallP]
---minAfterRemovedWalls = removeWallsInPolygon (orderPolygon brokenPoly) minCwals
---
---brokenRemovedWalls :: [WallP]
---brokenRemovedWalls = findWallsInPolygon (orderPolygon brokenPoly) brokenCwals
---minRemovedWalls :: [WallP]
---minRemovedWalls = findWallsInPolygon (orderPolygon brokenPoly) minCwals
---
---addedPolyWalls :: [Point2] -> [WallP] -> [WallP]
---addedPolyWalls ps wls = addPolyWalls ps wls \\ wls
---
---brokenAddedWalls :: [WallP]
---brokenAddedWalls = addedPolyWalls brokenRs brokenAfterRemovedWalls
---minAddedWalls :: [WallP]
---minAddedWalls = addedPolyWalls brokenRs minAfterRemovedWalls
---
---brokenAdd :: WallP
---brokenAdd = head brokenAddedWalls
---
---findShadowWall :: WallP -> [WallP] -> Maybe WallP
---findShadowWall (p1,p2) wls = safeMinimumOn (dist p3 . fromJust . f) $ filter (isJust . f) wls
---  where 
---    p3 = 0.5 *.* (p1 +.+ p2)
---    p4 = p3 +.+ 10000 *.* rotateV (negate $ pi/4) (vNormal (p2 -.- p1))
---    f = uncurry $ myIntersectSegSeg p3 p4
---
---findShadowWalls :: WallP -> [WallP] -> [WallP]
---findShadowWalls (p1,p2) wls = hitWls
---  where 
---    hitWls = sortOn (dist p3 . fromJust . f) $ filter (isJust . f) wls
---    p3 = 0.5 *.* (p1 +.+ p2)
---    p4 = p3 +.+ 10000 *.* vNormal (p2 -.- p1)
---    f = uncurry $ myIntersectSegSeg p3 p4
---
---addWallDebug :: WallP -> [WallP] -> [WallP]
---addWallDebug (p1,p2) wls =
---    case maybeWs of 
---        Just ws -> if uncurry isLHS ws p3
---            then wls
---            else (p1,p2) : wls
---        Nothing -> (p1,p2) : wls
---  where 
---    maybeWs = safeMinimumOn (dist p3 . fromJust . f) $ filter (isJust . f) wls
---    p3 = 0.5 *.* (p1 +.+ p2)
---    p4 = p3 +.+ 10000 *.* vNormal (p2 -.- p1)
---    f = uncurry $ myIntersectSegSeg p3 p4

src/Dodge/LevelGen/SwarmPlacement.hs

@@ -7,6 +7,7 @@ import Dodge.LevelGen.Data
 import Dodge.Creature.State.Data
 --import Geometry
 import Geometry.ConvexPoly
+import Geometry.Data
 import qualified IntMapHelp as IM
 
 import Data.List

src/Dodge/LevelGen/Switch.hs

@@ -1,6 +1,7 @@
 module Dodge.LevelGen.Switch
     where
 import Dodge.Data
+import Dodge.Data.SoundOrigin
 import Dodge.SoundLogic
 import Dodge.Picture.Layer
 import Picture

src/Dodge/LevelGen/TriggerDoor.hs

@@ -8,7 +8,7 @@ module Dodge.LevelGen.TriggerDoor
     ) where
 import Dodge.Data
 import Dodge.Base
-import Dodge.Base.Zone
+import Dodge.Zone
 import Dodge.LevelGen.Switch
 import Dodge.LevelGen.Pathing
 import Dodge.LevelGen.MoveDoor

src/Dodge/Particle/Bullet/HitEffect.hs

@@ -4,6 +4,8 @@ Effects of bullets upon impact with walls or creatures, and possibly force field
 module Dodge.Particle.Bullet.HitEffect
     where
 import Dodge.Data
+import Dodge.Data.DamageType
+import Dodge.Data.SoundOrigin
 --import Dodge.Base
 import Dodge.WorldEvent
 import Dodge.Particle.Bullet.Spawn

src/Dodge/Path.hs

@@ -7,7 +7,8 @@ module Dodge.Path
     where
 import Dodge.Data
 import Dodge.Base.Collide
-import Dodge.Base.Zone
+import Dodge.Zone
+import Geometry.Data
 
 import Data.List
 import Data.Maybe

src/Dodge/Render/Picture.hs

@@ -4,13 +4,13 @@ module Dodge.Render.Picture
 import Dodge.Data
 import Dodge.Base
 import Dodge.Base.Window
-import Dodge.Base.Zone
+import Dodge.Zone
 import Dodge.Picture
 import Dodge.Picture.SizeInvariant
 import Dodge.Picture.Layer
 import Dodge.Render.HUD
 import Dodge.Render.MenuScreen
---import Dodge.Graph
+import Sound.Data
 import Geometry
 import Picture
 import Polyhedra.Data

src/Dodge/Room.hs

@@ -5,7 +5,6 @@ module Dodge.Room
     ( module Dodge.Room
     , module Dodge.Room.Corridor
     ) where
-import Dodge.Data
 import Dodge.Default.Room
 import Dodge.Item.Weapon
 import Dodge.Item.Weapon.AutoGun

src/Dodge/Room/Path.hs

@@ -5,7 +5,6 @@ module Dodge.Room.Path
     , createPathGrid
     )
     where
-import Dodge.Data
 import Dodge.Room.Data
 import Dodge.LevelGen.StaticWalls
 import Geometry

src/Dodge/SoundLogic.hs

@@ -18,7 +18,9 @@ module Dodge.SoundLogic (
     , pauseSound
     ) where
 import Dodge.Data
-import Sound.Data (SoundStatus (..))
+import Dodge.Data.SoundOrigin
+import Sound.Data
+import Geometry.Data
 import Geometry.Vector
 import Dodge.SoundLogic.Synonyms
 

src/Dodge/Update.hs

@@ -7,10 +7,11 @@ module Dodge.Update
     ) where
 import Dodge.Data
 import Dodge.Menu
+import Dodge.Zone.Data
 import Dodge.World.Trigger.Data
 --import Dodge.Config.Data
 import Dodge.Base
-import Dodge.Base.Zone
+import Dodge.Zone
 import Dodge.WallCreatureCollisions
 import Dodge.LevelGen.Block
 import Dodge.Update.Camera
@@ -76,12 +77,13 @@ functionalUpdate w = case _menuLayers w of
         . updateSoundQueue
         $ updateCloseObjects w
   where 
-    zoneCreatures = set creaturesZone (IM.foldl' (flip creatureInZone) IM.empty (_creatures w))
+    zoneCreatures = set (creaturesZone . znObjects) 
+        (IM.foldl' (flip creatureInZone) IM.empty (_creatures w))
     creatureInZone cr = insertIMInZone x y cid cr
       where 
         (x,y) = crZoneOfPoint $ _crPos cr
         cid = _crID cr
-    zoneClouds = set cloudsZone (foldl' (flip cloudInZone) IM.empty (_clouds w))
+    zoneClouds = set (cloudsZone . znObjects) (foldl' (flip cloudInZone) IM.empty (_clouds w))
     cloudInZone cl = insertInZoneWith x y (++) [cl]
       where 
         (x,y) = cloudZoneOfPoint $ stripZ $ _clPos cl

src/Dodge/Update/Camera.hs

@@ -8,7 +8,7 @@ module Dodge.Update.Camera
     where
 import Dodge.Data
 import Dodge.Base
-import Dodge.Base.Zone
+import Dodge.Zone
 import Dodge.Base.Window
 import Dodge.Base.Collide
 import Dodge.Config.KeyConfig

src/Dodge/WallCreatureCollisions.hs

@@ -1,9 +1,10 @@
 {- | Deals with moving creature wall collisions.  -}
 module Dodge.WallCreatureCollisions where
 import Dodge.Data
+import Dodge.Data.DamageType
 import Dodge.Creature.State.Data
 import Dodge.Debug.Flag.Data
-import Dodge.Base.Zone
+import Dodge.Zone
 import Geometry
 
 import Data.List
@@ -31,14 +32,6 @@ colCrWall w c
     wallPoints = nub $ concatMap (\(x,y) -> [x,y]) ls
     noclipIsOn = _noClip $ _debugFlags w
 
--- colCrPushThrough :: World -> Creature -> Creature
--- colCrPushThrough w cr = set crPos (checkPushThroughs rad p1 p2 ls) cr
---     where rad = _crRad cr + wallBuffer
---           p1  = _crOldPos cr
---           p2  = _crPos cr
---           ls  = IM.elems $ fmap _wlLine $ wallsNearPoint p2 w
--- -- probably best to push check pushing through walls before creature springs
-
 -- the amount to push creatures out from walls, extra to their radius
 wallBuffer :: Float
 wallBuffer = 0
@@ -108,8 +101,4 @@ checkPushThrough cp1 cp2 (wp1,wp2)
     | isPushedThrough = intersectSegSeg cp1 cp2 wp1 wp2
     | otherwise = Nothing
   where
-    --norm = errorNormalizeV 61 $ vNormal (wp1 -.- wp2)
-    --wp1' = (rad *.* norm) +.+ wp1
-    --wp2' = (rad *.* norm) +.+ wp2
-    --newP = errorClosestPointOnLine 5 wp1' wp2' cp2
     isPushedThrough = isRHS wp1 wp2 cp2 && isJust (intersectSegSeg cp1 cp2 wp1 wp2)

src/Dodge/WorldEvent.hs

@@ -21,6 +21,7 @@ import Dodge.WorldEvent.SpawnParticle
 import Dodge.LightSources
 import Dodge.Creature.State.Data
 import Dodge.Data
+import Dodge.Data.DamageType
 --import Dodge.Base
 import Geometry
 --import Picture

src/Dodge/WorldEvent/Explosion.hs

@@ -4,8 +4,9 @@ Explosions: creation of shockwave and particles at a given point.
 module Dodge.WorldEvent.Explosion
   where
 import Dodge.Data
+import Dodge.Data.SoundOrigin
 import Dodge.Default
-import Dodge.Base.Zone
+import Dodge.Zone
 import Dodge.Base.Collide
 import Dodge.WorldEvent.SpawnParticle
 --import Dodge.WorldEvent.Flash

src/Dodge/WorldEvent/HitEffect.hs

@@ -1,6 +1,7 @@
 module Dodge.WorldEvent.HitEffect
     where
 import Dodge.Data
+import Dodge.Data.DamageType
 import Dodge.Creature.State.Data
 import Geometry
 

src/Dodge/WorldEvent/Shockwave.hs

@@ -4,10 +4,11 @@ module Dodge.WorldEvent.Shockwave
     )
   where
 import Dodge.Data
+import Dodge.Data.DamageType
 import Dodge.WorldEvent.DamageBlock
 import Dodge.Creature.State.Data
 import Dodge.Base
-import Dodge.Base.Zone
+import Dodge.Zone
 import Dodge.Picture.Layer
 import Geometry
 import Picture

src/Dodge/WorldEvent/Sound.hs

@@ -1,8 +1,10 @@
 module Dodge.WorldEvent.Sound
   where
 import Dodge.Data
+import Dodge.Data.SoundOrigin
 import Dodge.SoundLogic
 import System.Random
+import Geometry.Data
 
 import Control.Lens
 

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -4,10 +4,12 @@ Creation of particles in the world.
 module Dodge.WorldEvent.SpawnParticle
   where
 import Dodge.Data
+import Dodge.Data.DamageType
+import Dodge.Data.SoundOrigin
 import Dodge.Default
 import Dodge.Creature.State.Data
 import Dodge.Base
-import Dodge.Base.Zone
+import Dodge.Zone
 import Dodge.Base.Collide
 import Dodge.Picture
 --import Dodge.Picture.Layer

src/Dodge/WorldEvent/ThingsHit.hs

@@ -5,7 +5,8 @@ module Dodge.WorldEvent.ThingsHit
     where
 import Dodge.Data
 import Dodge.Base
-import Dodge.Base.Zone
+import Dodge.Zone
+import Dodge.Zone.Data
 import Geometry
 
 import qualified Data.IntMap.Strict as IM
@@ -27,7 +28,7 @@ thingsHit sp ep w
     --    $ creaturesAlongLine sp ep w
     crPs     = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
     crs   = zip crPs (map E3x1 hitCrs)
-    hitWls   = wallsOnLine sp ep (IM.unions [f b $ f a $ _wallsZone w | a<-[x-1,x,x+1]
+    hitWls   = wallsOnLine sp ep (IM.unions [f b $ f a $ _znObjects $ _wallsZone w | a<-[x-1,x,x+1]
                                                                       , b<-[y-1,y,y+1]])
     (x,y) = zoneOfPoint (0.5 *.* (sp +.+ ep))
     f i m = case IM.lookup i m of 

src/Dodge/Zone.hs

@@ -1,10 +1,8 @@
-{- | Deals with the specific implementations of zoning for Dodge.
+module Dodge.Zone
- - These are not yet fixed down. -}
-module Dodge.Base.Zone
     where
 import Dodge.Data
+import Dodge.Zone.Data
 import Dodge.Base.Window
-import Dodge.Bounds
 import Geometry
 import Geometry.Zone
 
@@ -13,29 +11,9 @@ import Data.List
 import Data.Bifunctor
 import qualified Data.IntMap.Strict as IM
 import qualified Data.IntSet as IS
-import qualified Data.Vector as V
+
 zoneSize :: Float
 zoneSize = 50
---zoneSize = 100
-          
-data Zoning a = Zoning
-    { _znObjects :: V.Vector (V.Vector a)
-    , _znSize :: Int
-    , _znBounds :: Bounds
-    }
-
-setupZoning :: Int -> Bounds -> a -> Zoning a
-setupZoning size bounds x = Zoning
-    { _znObjects = V.replicate xsize (V.replicate ysize x)
-    , _znSize = size
-    , _znBounds = bounds
-    }
-  where
-    toInt y = (ceiling y `div` size) + 1
-    xFloatSize = _bdMaxX bounds - _bdMinX bounds
-    yFloatSize = _bdMaxX bounds - _bdMinX bounds
-    xsize = toInt xFloatSize
-    ysize = toInt yFloatSize
 
 floorHun :: Float -> Int
 floorHun x = floor $ x / zoneSize
@@ -74,18 +52,6 @@ zoneAroundPoint' i (V2 x' y') = IM.fromSet (const ys) xs
     xs = IS.fromAscList [x-i..x+i]
     ys = IS.fromAscList [y-i..y+i]
 
--- the laser seemed to be occasionally missing creatures,
--- if this reoccurs, maybe change
--- divide line factor from 2 to 1.5
-bres :: Point2 -> Point2 -> [(Int,Int)]
-bres a b = digitalLine (zoneOfPoint a) (zoneOfPoint b)
-
-bresx :: Point2 -> Point2 -> [(Int,Int)]
-bresx a b = digitalLine (x-1,y-1) (x'-1,y'-1)
-  where 
-    (x,y) = zoneOfPoint a
-    (x',y') = zoneOfPoint b
-
 zoneOfLine :: Point2 -> Point2 -> [(Int,Int)]
 zoneOfLine (V2 aa ab) (V2 ba bb) 
     = nub 
@@ -97,11 +63,6 @@ zoneOfLine (V2 aa ab) (V2 ba bb)
 zoneOfLineIntMap :: Point2 -> Point2 -> IM.IntMap IS.IntSet
 --{-# INLINE zoneOfLineIntMap #-}
 zoneOfLineIntMap = ddaExt zoneSize
---zoneOfLineIntMap a b = expandLine $ digitalLine (x-1,y-1) (x'-1,y'-1)
---  where 
---    (x,y) = zoneOfPoint a
---    (x',y') = zoneOfPoint b
-
 
 expandLine :: [(Int,Int)] -> IM.IntMap IS.IntSet
 --{-# INLINE expandLine #-}
@@ -115,19 +76,17 @@ expandLine xs = IM.map expandSet
       where 
         mk = IS.findMax s
 
-                        
---zoneOfLine a b = concatMap zoneNearPoint $ divideLine (2 * zoneSize) a b
---zoneOfLine a b = concatMap zoneNearPoint $ divideLine zoneSize a b
-
 zoneOfCircle :: Point2 -> Float -> [(Int,Int)]
 zoneOfCircle p r = concatMap zoneNearPoint $ divideCircle (1.5 * zoneSize) p r
 
 -- looking at this again, I am not convinced it deals correctly with the
 -- rotation of the world
 zoneOfScreen :: World -> [(Int,Int)]
-zoneOfScreen w = [(a,b) | a <- [x - n .. x + n]
+zoneOfScreen w = 
-                        , b <- [y - n .. y + n]
+    [(a,b) 
-                 ]
+        | a <- [x - n .. x + n]
+        , b <- [y - n .. y + n]
+    ]
   where 
     (x,y) = zoneOfPoint $ _cameraCenter w
     n = ceiling $ wh / (_cameraZoom w * zoneSize)
@@ -135,9 +94,6 @@ zoneOfScreen w = [(a,b) | a <- [x - n .. x + n]
 
 zoneOfDoubleScreen :: World -> [(Int,Int)]
 zoneOfDoubleScreen w = (,) <$> xs <*> ys
---    [(a,b) | a <- xs
---           , b <- ys
---    ]
   where 
     (x,y) = zoneOfPoint $ _cameraCenter w
     n = ceiling (wh / (_cameraZoom w * zoneSize)) * 2
@@ -154,28 +110,25 @@ zoneOfSight w =
   where 
     (xs,ys) = unzip $ map zoneOfPoint $ screenPolygon w ++ [_cameraViewFrom w]
 
--- TODO sort out zoning of walls properly
 wallsDoubleScreen :: World -> IM.IntMap Wall
-wallsDoubleScreen w = _walls w
+wallsDoubleScreen w
---    = foldl' (flip $ IM.union . \i -> innerFold (f i (_wallsZone w))) IM.empty xs
+    = foldl' (flip $ IM.union . \i -> innerFold (f i (_znObjects $ _wallsZone w))) IM.empty xs
---  where 
---    innerFold m = foldl' (flip $ IM.union . \ j -> f j m) IM.empty ys
---
---    f i m = case IM.lookup i m of 
---        Just val -> val
---        _        -> IM.empty
---    (x,y) = zoneOfPoint $ _cameraCenter w
---    n = ceiling (wh / (_cameraZoom w * zoneSize)) * 2
---    wh = max (getWindowX w) (getWindowY w)
---    xs = [x - n .. x + n]
---    ys = [y - n .. y + n]
-
-wallsOnScreen :: World -> IM.IntMap Wall
-wallsOnScreen w -- = wallsNearZones (zoneOfScreen w) w
-    = foldl' (flip $ IM.union . \i -> innerFold (f i (_wallsZone w))) IM.empty xs
   where 
     innerFold m = foldl' (flip $ IM.union . \ j -> f j m) IM.empty ys
+    f i m = case IM.lookup i m of 
+        Just val -> val
+        _        -> IM.empty
+    (x,y) = zoneOfPoint $ _cameraCenter w
+    n = ceiling (wh / (_cameraZoom w * zoneSize)) * 2
+    wh = max (getWindowX w) (getWindowY w)
+    xs = [x - n .. x + n]
+    ys = [y - n .. y + n]
 
+wallsOnScreen :: World -> IM.IntMap Wall
+wallsOnScreen w
+    = foldl' (flip $ IM.union . \i -> innerFold (f i (_znObjects $ _wallsZone w))) IM.empty xs
+  where 
+    innerFold m = foldl' (flip $ IM.union . \ j -> f j m) IM.empty ys
     f i m = case IM.lookup i m of 
         Just val -> val
         _        -> IM.empty
@@ -188,7 +141,7 @@ wallsOnScreen w -- = wallsNearZones (zoneOfScreen w) w
 
 wallsNearZones :: [(Int,Int)] -> World -> IM.IntMap Wall
 wallsNearZones is w -- = IM.unions [f b $ f a $ _wallsZone w | (a,b) <- is]
-    = foldl' (flip $ IM.union . \(a,b) -> f b (f a (_wallsZone w))) IM.empty is
+    = foldl' (flip $ IM.union . \(a,b) -> f b (f a (_znObjects $ _wallsZone w))) IM.empty is
   where 
     f i m = case IM.lookup i m of 
         Just val -> val
@@ -208,6 +161,14 @@ lookLookup i j z = case IM.lookup i z of
 lookLookups :: [(Int,Int)] -> IM.IntMap (IM.IntMap a) -> [a]
 lookLookups xs z = mapMaybe (flip (uncurry lookLookup) z) xs
 
+cloudsNearPoint :: Point2 -> World -> [Cloud]
+--cloudsNearPoint p w =  IM.unions [f b $ f a $ _cloudsZone w | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
+cloudsNearPoint p w = f (IM.lookup x (_znObjects $ _cloudsZone w) >>= IM.lookup y)
+  where 
+    (x,y) = cloudZoneOfPoint p
+    f Nothing = []
+    f (Just l) = l
+
 -- possible BUG, was associated with thingsHitLongLine
 -- assumes _wallsZone is correct level generation
 -- there is certainly a problem somewhere here: it may be in the zoning, or
@@ -216,27 +177,26 @@ wallsAlongLine :: Point2 -> Point2 -> World -> IM.IntMap Wall
 --{-# INLINE wallsAlongLine #-}
 wallsAlongLine a b w = IM.foldlWithKey' g IM.empty kps
   where 
-    g m x s = IM.union (IM.unions (IM.restrictKeys (f x $ _wallsZone w) s)) m
+    g m x s = IM.union (IM.unions (IM.restrictKeys (f x $ _znObjects $ _wallsZone w) s)) m
     kps = zoneOfLineIntMap a b
     f i m = case IM.lookup i m of 
         Just val -> val
         _        -> IM.empty
 
-wallsNearZone' :: IM.IntMap IS.IntSet -> World -> IM.IntMap Wall
+wallsNearZone :: IM.IntMap IS.IntSet -> World -> IM.IntMap Wall
-{-# INLINE wallsNearZone' #-}
+{-# INLINE wallsNearZone #-}
-wallsNearZone' im w = IM.foldrWithKey' g IM.empty im
+wallsNearZone im w = IM.foldrWithKey' g IM.empty im
-    where g x s = IM.union (IM.unions (IM.restrictKeys (f x $ _wallsZone w) s))
+    where g x s = IM.union (IM.unions (IM.restrictKeys (f x $ _znObjects $ _wallsZone w) s))
           f i m = case IM.lookup i m of Just val -> val
                                         _        -> IM.empty
 
-
 wallsAlongCirc :: Point2 -> Float -> World -> IM.IntMap Wall
-wallsAlongCirc p r w =  IM.unions [f y $ f x $ _wallsZone w | (x,y) <- zoneOfCircle p r]
+wallsAlongCirc p r w =  IM.unions [f y $ f x $ _znObjects $ _wallsZone w | (x,y) <- zoneOfCircle p r]
     where f i m = case IM.lookup i m of Just val -> val
                                         _        -> IM.empty
 
 wallsNearPoint :: Point2 -> World -> IM.IntMap Wall
-wallsNearPoint p w =  IM.unions [f b $ f a $ _wallsZone w | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
+wallsNearPoint p w =  IM.unions [f b $ f a $ _znObjects $ _wallsZone w | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
   where 
     (x,y) = zoneOfPoint p
     f i m = case IM.lookup i m of 

src/Dodge/Zone/Data.hs

@@ -0,0 +1,13 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Zone.Data
+    where
+import Control.Lens
+import qualified Data.IntMap.Strict as IM
+
+data Zone a = Zone
+    { _znObjects :: IM.IntMap (IM.IntMap a)
+    , _znSize    :: Float
+    }
+
+makeLenses ''Zone

src/Hetris/Base.hs

@@ -1,24 +0,0 @@
-module Hetris.Base
-    where
-import Shader.Data
-import Shader.Compile
-
---import qualified Data.Vector.Unboxed.Mutable as MV
---import Control.Monad.Primitive
---import qualified Data.Array.Repa as R
-import Linear.V2
-
-data World = World
-    { _placedBlocks :: [[V2 Float]] 
-    , _polyShader :: FullShader
-    }
-
-initWorld :: IO World
-initWorld = do
-    let pb = replicate 20 [0,0,0,0,0,1,1,1,1,1]
-    theShader <- makeShader "twoD/basic" [vert,frag] [3,4] ETriangles
-    return $ World 
-        {_placedBlocks = pb
-        ,_polyShader = theShader
-        }
-