diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 055a5e395..bd2c417ab 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -15,7 +15,6 @@ import Dodge.Creature.Perception.Data import Dodge.Creature.Memory.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 @@ -57,7 +56,7 @@ data World = World , _props :: IM.IntMap Prop , _particles :: ![Particle] , _walls :: !(IM.IntMap Wall) - , _doors :: IM.IntMap Door' + , _doors :: IM.IntMap Door , _wallsZone :: Zone (IM.IntMap Wall) , _forceFields :: IM.IntMap ForceField , _floorItems :: IM.IntMap FloorItem @@ -80,7 +79,7 @@ data World = World , _pathPoints :: ~(IM.IntMap (IM.IntMap [(Int,Point2)])) , _savedWorlds :: M.Map SaveSlot World , _menuLayers :: [ScreenLayer] - , _worldTriggers :: S.Set WorldTrigger + , _worldFlags :: S.Set WorldFlag , _carteDisplay :: !Bool , _carteCenter :: !Point2 , _carteZoom :: !Float @@ -236,7 +235,7 @@ data CrMvType , _mvTurnJit :: Float , _mvAimSpeed :: Float -> Float } -data WorldTrigger +data WorldFlag = ResetLevel Int | GameOver deriving (Eq,Ord) @@ -536,12 +535,12 @@ data Prop , _pjTimer :: Int } data Either3 a b c = E3x1 a | E3x2 b | E3x3 c -data Door' = Door' +data Door = Door { _drID :: Int , _drWallIDs :: [Int] , _drStatus :: DoorStatus , _drTrigger :: World -> Bool - , _drMech :: Door' -> World -> World + , _drMech :: Door -> World -> World } data DoorStatus = DoorOpen | DoorClosed | DoorHalfway | DoorInt Int deriving (Eq, Ord, Show) @@ -736,6 +735,10 @@ data Goal | Kill Int | SentinelAt Point2 Float +newtype Zone a = Zone + { _znObjects :: IM.IntMap (IM.IntMap a) + } + makeLenses ''World makeLenses ''Cloud makeLenses ''Creature @@ -761,7 +764,8 @@ makeLenses ''Action makeLenses ''CrGroupParams makeLenses ''CrMvType makeLenses ''Intention -makeLenses ''Door' +makeLenses ''Door +makeLenses ''Zone numColor :: Int -> Color numColor 0 = toV4 (1,0,0,1) numColor 1 = toV4 (0,1,0,1) diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index de870926c..f46a6781b 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -2,7 +2,6 @@ module Dodge.Default.World where import Dodge.Data import Dodge.Base -import Dodge.Zone.Data import Dodge.Config.Data import Dodge.Config.KeyConfig import Dodge.Item.Data @@ -54,7 +53,7 @@ defaultWorld = World , _decorations = IM.empty , _savedWorlds = M.empty , _menuLayers = [] - , _worldTriggers = S.empty + , _worldFlags = S.empty , _clickMousePos = V2 0 0 , _pathGraph = Data.Graph.Inductive.Graph.empty , _pathGraphP = [] diff --git a/src/Dodge/DepthFirst.hs b/src/Dodge/DepthFirst.hs deleted file mode 100644 index 27e3b57e1..000000000 --- a/src/Dodge/DepthFirst.hs +++ /dev/null @@ -1,5 +0,0 @@ -module Dodge.DepthFirst - where - ---dfs :: (a -> Bool) -> (a -> [a]) -> a -> Maybe a ---dfs cond f x diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 2eb42f1a9..fa7c15441 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -85,5 +85,5 @@ initialRoomTree = do t' shiftExpandTree . expandTreeBy id <$> mapM annoToRoomTree t -levx :: RandomGen g => State g [Room] -levx = untilJust initialRoomTree +levx :: RandomGen g => Int -> State g [Room] +levx _ = untilJust initialRoomTree diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index 6fe9fbbed..4837e5bba 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -33,7 +33,7 @@ firstWorld = do -- i <- randomRIO (0,5000) let i = 2 putStrLn $ "Seed for level generation: " ++ show ( i :: Int) - return $ generateLevelFromRoomList levx $ initialWorld {_randGen = mkStdGen i} + return $ generateLevelFromRoomList (levx 1) $ initialWorld {_randGen = mkStdGen i} initialWorld :: World initialWorld = defaultWorld diff --git a/src/Dodge/LevelGen/TriggerDoor.hs b/src/Dodge/LevelGen/TriggerDoor.hs index 7a6cde1d3..fcf5ccc41 100644 --- a/src/Dodge/LevelGen/TriggerDoor.hs +++ b/src/Dodge/LevelGen/TriggerDoor.hs @@ -56,7 +56,7 @@ putDoor putDoor col cond pss w = (drid, addWalls w & doors %~ addDoor) where drid = IM.newKey $ _doors w - addDoor = IM.insert drid $ Door' + addDoor = IM.insert drid $ Door { _drID = drid , _drWallIDs = wlids , _drStatus = DoorInt 0 @@ -77,7 +77,7 @@ putDoor col cond pss w = (drid, addWalls w & doors %~ addDoor) } -- TODO use vector instead of list, perhaps also memoisation of rectanglePairs -- perhaps also remove use of DoorInt in favour of DoorOpen/DoorClosed -doorMechanismStepwise :: Int -> Int -> [Int] -> [(Point2,Point2)] -> Door' -> World -> World +doorMechanismStepwise :: Int -> Int -> [Int] -> [(Point2,Point2)] -> Door -> World -> World doorMechanismStepwise nsteps drid wlids pss dr w | toOpen = case _drStatus dr of DoorInt x | x == nsteps -> w @@ -99,9 +99,8 @@ doorMechanismStepwise nsteps drid wlids pss dr w & (\w'' -> foldr (changeZonedWall (wlLine .~ ps) wlid) w'' (zoneps cps)) -- it is not at all clear that the zoning selects the correct walls - -- TODO think about wall zoning, simplify! -doorMechanism :: Int -> Float -> [(Int,(Point2,Point2),(Point2,Point2))] -> Door' -> World -> World +doorMechanism :: Int -> Float -> [(Int,(Point2,Point2),(Point2,Point2))] -> Door -> World -> World doorMechanism drid speed wlidOpCps dr w | toOpen && dstatus /= DoorOpen = moveUpdate $ foldl' doOpen w wlidOpCps | not toOpen && dstatus /= DoorClosed = moveUpdate $ foldl' doClose w wlidOpCps @@ -135,7 +134,7 @@ putSingleDoor isPathable col cond a b speed w = (drid, addWalls w & doors %~ addDoor) where drid = IM.newKey $ _doors w - addDoor = IM.insert drid $ Door' + addDoor = IM.insert drid $ Door { _drID = drid , _drWallIDs = wlids , _drStatus = DoorClosed @@ -155,4 +154,3 @@ putSingleDoor isPathable col cond a b speed w = (drid, addWalls w shiftedPairs = map (bimap shiftLeft shiftLeft) pairs shiftLeft = (+.+ (a -.- b)) wlids = take 4 [IM.newKey $ _walls w ..] - diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index 1fb4d3969..bc4af245e 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -162,7 +162,7 @@ startNewGame w = Just $ w & worldEvents .~ const aNewGame where aNewGame :: World - aNewGame = updateFramebufferSize $ generateLevelFromRoomList levx $ initialWorld + aNewGame = updateFramebufferSize $ generateLevelFromRoomList (levx 1) $ initialWorld & randGen .~ _randGen w & config .~ _config w & preloadData .~ _preloadData w diff --git a/src/Dodge/Room/Teleport.hs b/src/Dodge/Room/Teleport.hs index 75046975e..42c5685c7 100644 --- a/src/Dodge/Room/Teleport.hs +++ b/src/Dodge/Room/Teleport.hs @@ -14,13 +14,12 @@ import Dodge.WorldEvent.Explosion import Control.Lens import Control.Monad.State import System.Random -import qualified Data.Set as S telRoomLev :: RandomGen g => Int -- ^ Level number to teleport to -> State g Room -telRoomLev i = do +telRoomLev _ = do w <- state $ randomR (200,300) h <- state $ randomR (200,300) return $ roomRectAutoLinks w h & rmPS .~ @@ -38,6 +37,5 @@ telRoomLev i = do } ppFootprint = rectNSEW 20 (-20) 20 (-20) levelReset pp w - | dist (_crPos $ you w) (_ppPos pp) < 20 = makeExplosionAt (_ppPos pp) $ - w & worldTriggers %~ S.insert (ResetLevel i) + | dist (_crPos $ you w) (_ppPos pp) < 20 = makeExplosionAt (_ppPos pp) w | otherwise = w diff --git a/src/Dodge/TransparencyEffects.hs b/src/Dodge/TransparencyEffects.hs deleted file mode 100644 index 66eaa1292..000000000 --- a/src/Dodge/TransparencyEffects.hs +++ /dev/null @@ -1,4 +0,0 @@ -module Dodge.TransparencyEffects - where - - diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index d6b3d0add..639d45de0 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -7,7 +7,6 @@ module Dodge.Update ) where import Dodge.Data import Dodge.Menu -import Dodge.Zone.Data import Dodge.Config.Data import Dodge.Base import Dodge.Zone @@ -16,9 +15,6 @@ import Dodge.LevelGen.Block import Dodge.Update.Camera import Dodge.SoundLogic import Dodge.Inventory -import Dodge.Initialisation -import Dodge.Layout -import Dodge.Floor import Geometry import Geometry.Vector3D @@ -52,7 +48,6 @@ functionalUpdate w = case _menuLayers w of (_ : _) -> w [] -> checkEndGame . updateRadialDistortions - . updateTriggers . ppEvents . updateCamera . colCrsWalls @@ -104,17 +99,6 @@ decreaseBulge (a,b,c,v) | v < 1 = Just (a,b,c,min 1 (v + 0.05) ) | otherwise = Nothing -updateTriggers :: World -> World -updateTriggers w - | ResetLevel 1 `S.member` _worldTriggers w = generateLevelFromRoomList levx $ initialWorld - & randGen .~ _randGen w - & config .~ _config w - & menuLayers .~ [] - & creatures . ix 0 .~ cr - | otherwise = w - where - cr = _creatures w IM.! 0 & crPos .~ V2 0 0 - updateLightSources :: World -> World updateLightSources w = over tempLightSources f w where diff --git a/src/Dodge/Zone.hs b/src/Dodge/Zone.hs index 33d0de319..bf25f1223 100644 --- a/src/Dodge/Zone.hs +++ b/src/Dodge/Zone.hs @@ -17,11 +17,9 @@ module Dodge.Zone , wallsNearZones , zoneOfSight , flattenIMIMIM - , module Dodge.Zone.Data ) where import Dodge.Data -import Dodge.Zone.Data import Dodge.Base.Window import Geometry import Geometry.Zone diff --git a/src/Dodge/Zone/Data.hs b/src/Dodge/Zone/Data.hs deleted file mode 100644 index c4c490e94..000000000 --- a/src/Dodge/Zone/Data.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE StrictData #-} -module Dodge.Zone.Data - where -import Control.Lens -import qualified Data.IntMap.Strict as IM - -newtype Zone a = Zone - { _znObjects :: IM.IntMap (IM.IntMap a) - } - -makeLenses ''Zone