diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 39f862441..227898d8e 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -191,10 +191,10 @@ data World = World , _creatureGroups :: IM.IntMap CrGroupParams , _itemPositions :: IM.IntMap ItemPos , _clouds :: [Cloud] - , _clZoning :: Zoning [] Cloud + --, _clZoning :: Zoning [] Cloud + , _clZoning :: IM.IntMap (IM.IntMap [Cloud]) --Zoning IM.IntMap Creature , _gusts :: IM.IntMap Gust , _gsZoning :: IM.IntMap (IM.IntMap IS.IntSet) - --, _gsZoning :: Zoning IM.IntMap Gust , _props :: IM.IntMap Prop , _projectiles :: IM.IntMap Proj , _instantBullets :: [Bullet] diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index f9a9e4a99..9fe86dd6f 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -2,7 +2,7 @@ module Dodge.Default.World where import Dodge.Data import Dodge.Zone.Size import Dodge.Zone.Object -import Geometry.Vector3D +--import Geometry.Vector3D import Geometry.Zone import Geometry.Data import Geometry.Polygon @@ -30,7 +30,7 @@ defaultWorld = World , _crZoning = mempty --Zoning IM.empty crZoneSize zoneOfCreature , _creatureGroups = IM.empty , _clouds = mempty - , _clZoning = Zoning IM.empty clZoneSize (zonePos (stripZ . _clPos)) + , _clZoning = mempty , _gusts = IM.empty , _gsZoning = mempty --Zoning IM.empty clZoneSize (zonePos _guPos) , _itemPositions = IM.empty diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index b3c6a6b8c..9ec0427f4 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -4,6 +4,7 @@ Module : Dodge.Update Description : Simulation update -} module Dodge.Update ( updateUniverse ) where +import Dodge.Zoning.Cloud import Dodge.Zoning.Creature import Dodge.WorldEffect import Dodge.Data @@ -27,7 +28,7 @@ import Dodge.Distortion import Dodge.SoundLogic import Dodge.Update.WallDamage import Dodge.Base -import Dodge.Zone +--import Dodge.Zone import Dodge.Hammer import Dodge.WallCreatureCollisions import Dodge.Update.Camera @@ -42,7 +43,7 @@ import Data.Maybe import qualified IntMapHelp as IM import qualified Data.Map.Strict as M import Control.Applicative -import qualified Streaming.Prelude as S +--import qualified Streaming.Prelude as S import SDL {- For most menus the only way to change the world is using event handling. -} @@ -116,9 +117,9 @@ doWorldEvents w = foldr doWorldEffect (w & worldEvents .~ []) (_worldEvents w) zoneClouds :: World -> World zoneClouds w = w - & clZoning . znObjects .~ mempty + & clZoning .~ mempty & clZoning %~ \zn -> - foldl' (flip $ updateZoning (:)) zn (_clouds w) + foldl' (flip zoneCloud) zn (_clouds w) --runIdentity (S.fold_ (flip $ updateZoning (:)) (zn & znObjects .~ mempty) id (_clouds w)) updateWorldSelect :: World -> World @@ -407,7 +408,7 @@ updateCloud w c newVel@(V3 _ _ nvz) = (0.95 *.*.* springVels) +.+.+ V3 0 0 (0.001 * vertVel) newVel2 = stripZ newVel vertVel = _clAlt c - opz - springVels = runIdentity $ S.fold_ (clClSpringVel c) (_clVel c) id (clsNearPoint oldPos2 w) + springVels = foldl' (clClSpringVel c) (_clVel c) (clsNearPoint oldPos2 w) oldPos@(V3 _ _ opz) = _clPos c oldPos2 = stripZ oldPos newPos@(V3 _ _ npz) = oldPos +.+.+ newVel diff --git a/src/Dodge/Zone.hs b/src/Dodge/Zone.hs index c3270fb31..e310bbc1d 100644 --- a/src/Dodge/Zone.hs +++ b/src/Dodge/Zone.hs @@ -6,12 +6,12 @@ module Dodge.Zone , nearSeg --, wlsNearPoint --, crsNearPoint - , clsNearPoint + --, clsNearPoint --, wlsNearSeg --, crsNearSeg --, wlsInsideCirc --, crsInsideCirc - , clZoneOfPoint + --, clZoneOfPoint --, crZoneOfPoint , wlZoneOfPoint , module Dodge.Zone.Size @@ -74,9 +74,9 @@ aroundPoint f p w = streamFromZone zn $ zoneAroundPoint (_znSize zn) p where zn = f w -clsNearPoint :: Point2 -> World -> StreamOf Cloud -{-# INLINE clsNearPoint #-} -clsNearPoint = nearPoint _clZoning +--clsNearPoint :: Point2 -> World -> StreamOf Cloud +--{-# INLINE clsNearPoint #-} +--clsNearPoint = nearPoint _clZoning --wlsNearPoint :: Point2 -> World -> StreamOf Wall --{-# INLINE wlsNearPoint #-} @@ -121,9 +121,9 @@ wlZoneOfPoint = zoneOfPoint wlZoneSize wlZoneSize :: Float wlZoneSize = 50 -clZoneOfPoint :: Point2 -> Int2 -{-# INLINE clZoneOfPoint #-} -clZoneOfPoint = zoneOfPoint clZoneSize +--clZoneOfPoint :: Point2 -> Int2 +--{-# INLINE clZoneOfPoint #-} +--clZoneOfPoint = zoneOfPoint clZoneSize --crZoneOfPoint :: Point2 -> Int2 --{-# INLINE crZoneOfPoint #-} diff --git a/src/Dodge/Zoning/Base.hs b/src/Dodge/Zoning/Base.hs index 9f3a73a32..7c6455448 100644 --- a/src/Dodge/Zoning/Base.hs +++ b/src/Dodge/Zoning/Base.hs @@ -3,6 +3,7 @@ import Geometry import Geometry.Zone import qualified IntMapHelp as IM +import qualified Data.IntSet as IS import Control.Lens import Data.Maybe @@ -60,3 +61,10 @@ zoneMonoid :: Semigroup m => Int2 -> m -> IM.IntMap (IM.IntMap m) -> IM.IntMap ( zoneMonoid (V2 x y) a = IM.insertWith f x $ IM.singleton y a where f _ = IM.insertWith (<>) 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 +{-# INLINE zoneOfPoint'' #-} +zoneOfPoint'' s = fmap (divTo s) diff --git a/src/Dodge/Zoning/Cloud.hs b/src/Dodge/Zoning/Cloud.hs new file mode 100644 index 000000000..843e619fe --- /dev/null +++ b/src/Dodge/Zoning/Cloud.hs @@ -0,0 +1,31 @@ +module Dodge.Zoning.Cloud + where +import Geometry.Vector +import Dodge.Zoning.Base +import Dodge.Data +import Geometry + +import Data.Foldable +import Control.Lens +import qualified IntMapHelp as IM + +clsNearPoint :: Point2 -> World -> [Cloud] +clsNearPoint p w = zoneExtract (zoneOfPoint' clZoneSize p) (w ^. clZoning) + +clsNearSeg :: Point2 -> Point2 -> World -> [Cloud] +clsNearSeg sp ep w = zonesExtract (w ^. clZoning) (zoneOfSeg' clZoneSize sp ep) + +clsNearRect :: Point2 -> Point2 -> World -> [Cloud] +clsNearRect sp ep w = zonesExtract (w ^. clZoning) $ zoneOfRect' clZoneSize sp ep + +clsNearCirc :: Point2 -> Float -> World -> [Cloud] +clsNearCirc p r = clsNearRect (p +.+ V2 r r) (p -.- V2 r r) + +clZoneSize :: Float +clZoneSize = 20 + +zoneOfCl :: Cloud -> Int2 +zoneOfCl = zoneOfPoint'' clZoneSize . xyV3 . _clPos + +zoneCloud :: Cloud -> IM.IntMap (IM.IntMap [Cloud]) -> IM.IntMap (IM.IntMap [Cloud]) +zoneCloud cl = zoneMonoid (zoneOfCl cl) [cl] diff --git a/src/Dodge/Zoning/Wall.hs b/src/Dodge/Zoning/Wall.hs index 8272bf4f3..1e2c304a7 100644 --- a/src/Dodge/Zoning/Wall.hs +++ b/src/Dodge/Zoning/Wall.hs @@ -56,6 +56,3 @@ zoneWall wl im = foldl' f im (zoneOfWl wl) deZoneWall :: Wall -> IM.IntMap (IM.IntMap IS.IntSet) -> IM.IntMap (IM.IntMap IS.IntSet) deZoneWall wl im = foldl' (deZoneIX (_wlID wl)) im (zoneOfWl wl) - -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