From aa7413a29ffe1136651f67c87106cb398ac5553a Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 11 Sep 2021 15:52:43 +0100 Subject: [PATCH] Cleanup, move towards unifying zones --- appHetris/Hetris.hs | 21 ----- package.yaml | 17 ---- src/Dodge/Base.hs | 18 ++-- src/Dodge/Base/Collide.hs | 2 +- src/Dodge/Creature/Action.hs | 3 +- src/Dodge/Creature/Impulse.hs | 2 + src/Dodge/Creature/Perception.hs | 1 + src/Dodge/Creature/Picture.hs | 1 + src/Dodge/Creature/State.hs | 2 + src/Dodge/Creature/State/WalkCycle.hs | 2 + src/Dodge/Data.hs | 22 ++--- src/Dodge/Debug.hs | 2 +- src/Dodge/Debug/LinkDecoration.hs | 1 + src/Dodge/Default.hs | 2 + src/Dodge/Default/World.hs | 12 ++- src/Dodge/Event.hs | 1 + src/Dodge/Initialisation.hs | 3 +- src/Dodge/Item/Consumable.hs | 1 + src/Dodge/Item/Weapon.hs | 3 +- src/Dodge/Item/Weapon/Booster.hs | 2 +- src/Dodge/Item/Weapon/Decoration.hs | 2 +- src/Dodge/Item/Weapon/Grenade.hs | 3 +- src/Dodge/Item/Weapon/Laser.hs | 1 + src/Dodge/Item/Weapon/Launcher.hs | 3 +- src/Dodge/Item/Weapon/Targeting.hs | 1 + src/Dodge/Item/Weapon/TriggerType.hs | 1 + src/Dodge/Item/Weapon/UseEffect.hs | 2 +- src/Dodge/Layout.hs | 23 ++--- src/Dodge/LevelGen/AutoDoor.hs | 1 + src/Dodge/LevelGen/Block.hs | 10 ++- src/Dodge/LevelGen/Data.hs | 1 + src/Dodge/LevelGen/DoorPane.hs | 1 + src/Dodge/LevelGen/MoveDoor.hs | 6 +- src/Dodge/LevelGen/Pathing.hs | 2 +- src/Dodge/LevelGen/StaticWalls.hs | 95 -------------------- src/Dodge/LevelGen/SwarmPlacement.hs | 1 + src/Dodge/LevelGen/Switch.hs | 1 + src/Dodge/LevelGen/TriggerDoor.hs | 2 +- src/Dodge/Particle/Bullet/HitEffect.hs | 2 + src/Dodge/Path.hs | 3 +- src/Dodge/Render/Picture.hs | 4 +- src/Dodge/Room.hs | 1 - src/Dodge/Room/Path.hs | 1 - src/Dodge/SoundLogic.hs | 4 +- src/Dodge/Update.hs | 8 +- src/Dodge/Update/Camera.hs | 2 +- src/Dodge/WallCreatureCollisions.hs | 15 +--- src/Dodge/WorldEvent.hs | 1 + src/Dodge/WorldEvent/Explosion.hs | 3 +- src/Dodge/WorldEvent/HitEffect.hs | 1 + src/Dodge/WorldEvent/Shockwave.hs | 3 +- src/Dodge/WorldEvent/Sound.hs | 2 + src/Dodge/WorldEvent/SpawnParticle.hs | 4 +- src/Dodge/WorldEvent/ThingsHit.hs | 5 +- src/Dodge/{Base => }/Zone.hs | 118 ++++++++----------------- src/Dodge/Zone/Data.hs | 13 +++ src/Hetris/Base.hs | 24 ----- 57 files changed, 157 insertions(+), 331 deletions(-) delete mode 100644 appHetris/Hetris.hs rename src/Dodge/{Base => }/Zone.hs (65%) create mode 100644 src/Dodge/Zone/Data.hs delete mode 100644 src/Hetris/Base.hs diff --git a/appHetris/Hetris.hs b/appHetris/Hetris.hs deleted file mode 100644 index 7bf1ed816..000000000 --- a/appHetris/Hetris.hs +++ /dev/null @@ -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 diff --git a/package.yaml b/package.yaml index 223abdddd..254d992c9 100644 --- a/package.yaml +++ b/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: diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index 10b476fb7..5381ae885 100644 --- a/src/Dodge/Base.hs +++ b/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 diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs index 45ed259f9..d73d6b40d 100644 --- a/src/Dodge/Base/Collide.hs +++ b/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 diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 049b586ad..49a8d2ed5 100644 --- a/src/Dodge/Creature/Action.hs +++ b/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 diff --git a/src/Dodge/Creature/Impulse.hs b/src/Dodge/Creature/Impulse.hs index 3a95fbae6..cc525ec87 100644 --- a/src/Dodge/Creature/Impulse.hs +++ b/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 diff --git a/src/Dodge/Creature/Perception.hs b/src/Dodge/Creature/Perception.hs index 674a1684f..c62af7a78 100644 --- a/src/Dodge/Creature/Perception.hs +++ b/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 diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index 11ef124c1..9256dacf1 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/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 diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index c396bbe7c..54730e5cd 100644 --- a/src/Dodge/Creature/State.hs +++ b/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 diff --git a/src/Dodge/Creature/State/WalkCycle.hs b/src/Dodge/Creature/State/WalkCycle.hs index c716bb4ea..522491aec 100644 --- a/src/Dodge/Creature/State/WalkCycle.hs +++ b/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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 15c889470..d0f66e0bd 100644 --- a/src/Dodge/Data.hs +++ b/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 - , module Dodge.Data.DamageType - , module Dodge.Data.SoundOrigin - , Point2 - , Sound (..) - , soundTime - ) where + 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 diff --git a/src/Dodge/Debug.hs b/src/Dodge/Debug.hs index d1b354515..5cb731c6f 100644 --- a/src/Dodge/Debug.hs +++ b/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 diff --git a/src/Dodge/Debug/LinkDecoration.hs b/src/Dodge/Debug/LinkDecoration.hs index d5dd31a63..e531f4cec 100644 --- a/src/Dodge/Debug/LinkDecoration.hs +++ b/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 diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 3f89dfc2f..ac127e3ab 100644 --- a/src/Dodge/Default.hs +++ b/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 diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index b7350c2ea..a7f05c63c 100644 --- a/src/Dodge/Default/World.hs +++ b/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 diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 57db98ec6..e1ae5ab89 100644 --- a/src/Dodge/Event.hs +++ b/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 diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index 3e4ba2c94..81514442a 100644 --- a/src/Dodge/Initialisation.hs +++ b/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 diff --git a/src/Dodge/Item/Consumable.hs b/src/Dodge/Item/Consumable.hs index be229ae7f..f01d0f8c1 100644 --- a/src/Dodge/Item/Consumable.hs +++ b/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 diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 81cf8f586..e565e7dbb 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/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 diff --git a/src/Dodge/Item/Weapon/Booster.hs b/src/Dodge/Item/Weapon/Booster.hs index d4c3249f5..938804781 100644 --- a/src/Dodge/Item/Weapon/Booster.hs +++ b/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 diff --git a/src/Dodge/Item/Weapon/Decoration.hs b/src/Dodge/Item/Weapon/Decoration.hs index f1484dd6c..e313b05e4 100644 --- a/src/Dodge/Item/Weapon/Decoration.hs +++ b/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 diff --git a/src/Dodge/Item/Weapon/Grenade.hs b/src/Dodge/Item/Weapon/Grenade.hs index 11f125d09..d2645b180 100644 --- a/src/Dodge/Item/Weapon/Grenade.hs +++ b/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 diff --git a/src/Dodge/Item/Weapon/Laser.hs b/src/Dodge/Item/Weapon/Laser.hs index b96f1d947..a97f958ca 100644 --- a/src/Dodge/Item/Weapon/Laser.hs +++ b/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 diff --git a/src/Dodge/Item/Weapon/Launcher.hs b/src/Dodge/Item/Weapon/Launcher.hs index 6175ffd7e..c1481f366 100644 --- a/src/Dodge/Item/Weapon/Launcher.hs +++ b/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 diff --git a/src/Dodge/Item/Weapon/Targeting.hs b/src/Dodge/Item/Weapon/Targeting.hs index 075e49afe..603889fee 100644 --- a/src/Dodge/Item/Weapon/Targeting.hs +++ b/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 diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 36e2e4df7..0e4aa36db 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/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) diff --git a/src/Dodge/Item/Weapon/UseEffect.hs b/src/Dodge/Item/Weapon/UseEffect.hs index 505e0f89a..0de1a2110 100644 --- a/src/Dodge/Item/Weapon/UseEffect.hs +++ b/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 diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 428d2ab84..c97aaa536 100644 --- a/src/Dodge/Layout.hs +++ b/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 - -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 + --pinc = M.fromList $ pairsToIncidence pairGraph 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 diff --git a/src/Dodge/LevelGen/AutoDoor.hs b/src/Dodge/LevelGen/AutoDoor.hs index db0b4f226..fe2454bac 100644 --- a/src/Dodge/LevelGen/AutoDoor.hs +++ b/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 diff --git a/src/Dodge/LevelGen/Block.hs b/src/Dodge/LevelGen/Block.hs index fe0b8a1fc..46b8f9bc8 100644 --- a/src/Dodge/LevelGen/Block.hs +++ b/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]) diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index b754cd024..812b8289b 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/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 diff --git a/src/Dodge/LevelGen/DoorPane.hs b/src/Dodge/LevelGen/DoorPane.hs index b02c89c1c..be730f9c9 100644 --- a/src/Dodge/LevelGen/DoorPane.hs +++ b/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 diff --git a/src/Dodge/LevelGen/MoveDoor.hs b/src/Dodge/LevelGen/MoveDoor.hs index 50c828bdc..5a7296e2e 100644 --- a/src/Dodge/LevelGen/MoveDoor.hs +++ b/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" diff --git a/src/Dodge/LevelGen/Pathing.hs b/src/Dodge/LevelGen/Pathing.hs index fd094d06b..dbc355559 100644 --- a/src/Dodge/LevelGen/Pathing.hs +++ b/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 diff --git a/src/Dodge/LevelGen/StaticWalls.hs b/src/Dodge/LevelGen/StaticWalls.hs index a74b2e5a0..3cdbabf21 100644 --- a/src/Dodge/LevelGen/StaticWalls.hs +++ b/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 diff --git a/src/Dodge/LevelGen/SwarmPlacement.hs b/src/Dodge/LevelGen/SwarmPlacement.hs index 36762a768..b4e4b2cbb 100644 --- a/src/Dodge/LevelGen/SwarmPlacement.hs +++ b/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 diff --git a/src/Dodge/LevelGen/Switch.hs b/src/Dodge/LevelGen/Switch.hs index 05ead9d10..da35c8ccb 100644 --- a/src/Dodge/LevelGen/Switch.hs +++ b/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 diff --git a/src/Dodge/LevelGen/TriggerDoor.hs b/src/Dodge/LevelGen/TriggerDoor.hs index 950ae9b03..6d0614d5c 100644 --- a/src/Dodge/LevelGen/TriggerDoor.hs +++ b/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 diff --git a/src/Dodge/Particle/Bullet/HitEffect.hs b/src/Dodge/Particle/Bullet/HitEffect.hs index c2c8ea3b4..8fa2920a9 100644 --- a/src/Dodge/Particle/Bullet/HitEffect.hs +++ b/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 diff --git a/src/Dodge/Path.hs b/src/Dodge/Path.hs index ce55b9d77..98dfd2fcc 100644 --- a/src/Dodge/Path.hs +++ b/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 diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index 06200dacb..8580acd14 100644 --- a/src/Dodge/Render/Picture.hs +++ b/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 diff --git a/src/Dodge/Room.hs b/src/Dodge/Room.hs index c5f682d8d..94764f88b 100644 --- a/src/Dodge/Room.hs +++ b/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 diff --git a/src/Dodge/Room/Path.hs b/src/Dodge/Room/Path.hs index 48b3d7b83..ddb3f5289 100644 --- a/src/Dodge/Room/Path.hs +++ b/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 diff --git a/src/Dodge/SoundLogic.hs b/src/Dodge/SoundLogic.hs index 6a0215310..3c2e5a97e 100644 --- a/src/Dodge/SoundLogic.hs +++ b/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 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index e9f2144ed..e676ffd11 100644 --- a/src/Dodge/Update.hs +++ b/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 diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 1c72acbf5..9b4dde504 100644 --- a/src/Dodge/Update/Camera.hs +++ b/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 diff --git a/src/Dodge/WallCreatureCollisions.hs b/src/Dodge/WallCreatureCollisions.hs index eac14547c..cd7d3d464 100644 --- a/src/Dodge/WallCreatureCollisions.hs +++ b/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) diff --git a/src/Dodge/WorldEvent.hs b/src/Dodge/WorldEvent.hs index 3bcceeca4..8ac3fc412 100644 --- a/src/Dodge/WorldEvent.hs +++ b/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 diff --git a/src/Dodge/WorldEvent/Explosion.hs b/src/Dodge/WorldEvent/Explosion.hs index 11e616124..bedc1dae0 100644 --- a/src/Dodge/WorldEvent/Explosion.hs +++ b/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 diff --git a/src/Dodge/WorldEvent/HitEffect.hs b/src/Dodge/WorldEvent/HitEffect.hs index 22d4bfd80..0d7e914af 100644 --- a/src/Dodge/WorldEvent/HitEffect.hs +++ b/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 diff --git a/src/Dodge/WorldEvent/Shockwave.hs b/src/Dodge/WorldEvent/Shockwave.hs index 5c572a23e..91f37dcb5 100644 --- a/src/Dodge/WorldEvent/Shockwave.hs +++ b/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 diff --git a/src/Dodge/WorldEvent/Sound.hs b/src/Dodge/WorldEvent/Sound.hs index fcacc1be1..53acf8bf7 100644 --- a/src/Dodge/WorldEvent/Sound.hs +++ b/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 diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 302a4469e..2deb37db4 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/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 diff --git a/src/Dodge/WorldEvent/ThingsHit.hs b/src/Dodge/WorldEvent/ThingsHit.hs index db2d0ff57..1252ec10f 100644 --- a/src/Dodge/WorldEvent/ThingsHit.hs +++ b/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 diff --git a/src/Dodge/Base/Zone.hs b/src/Dodge/Zone.hs similarity index 65% rename from src/Dodge/Base/Zone.hs rename to src/Dodge/Zone.hs index 91a6dff54..450b4c39e 100644 --- a/src/Dodge/Base/Zone.hs +++ b/src/Dodge/Zone.hs @@ -1,10 +1,8 @@ -{- | Deals with the specific implementations of zoning for Dodge. - - These are not yet fixed down. -} -module Dodge.Base.Zone +module Dodge.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] - , b <- [y - n .. y + n] - ] +zoneOfScreen w = + [(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 --- = 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 -- = wallsNearZones (zoneOfScreen w) w - = foldl' (flip $ IM.union . \i -> innerFold (f i (_wallsZone w))) IM.empty xs +wallsDoubleScreen 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 + (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 -{-# INLINE wallsNearZone' #-} -wallsNearZone' im w = IM.foldrWithKey' g IM.empty im - where g x s = IM.union (IM.unions (IM.restrictKeys (f x $ _wallsZone w) s)) +wallsNearZone :: IM.IntMap IS.IntSet -> World -> IM.IntMap Wall +{-# INLINE wallsNearZone #-} +wallsNearZone im w = IM.foldrWithKey' g IM.empty im + 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 diff --git a/src/Dodge/Zone/Data.hs b/src/Dodge/Zone/Data.hs new file mode 100644 index 000000000..a6197ebce --- /dev/null +++ b/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 diff --git a/src/Hetris/Base.hs b/src/Hetris/Base.hs deleted file mode 100644 index 3a42e70ce..000000000 --- a/src/Hetris/Base.hs +++ /dev/null @@ -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 - } -