Cleanup

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) 

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 = []

src/Dodge/DepthFirst.hs

@@ -1,5 +0,0 @@
-module Dodge.DepthFirst
-    where
-
---dfs :: (a -> Bool) -> (a -> [a]) -> a -> Maybe a
---dfs cond f x

src/Dodge/Floor.hs

@@ -85,5 +85,5 @@ initialRoomTree = do
             t'
     shiftExpandTree . expandTreeBy id <$> mapM annoToRoomTree t
 
-levx :: RandomGen g => State g [Room]
+levx :: RandomGen g => Int -> State g [Room]
-levx = untilJust initialRoomTree
+levx _ = untilJust initialRoomTree

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

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 ..]
-

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

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) $ 
+        | dist (_crPos $ you w) (_ppPos pp) < 20 = makeExplosionAt (_ppPos pp) w 
-            w & worldTriggers %~ S.insert (ResetLevel i)
         | otherwise = w

src/Dodge/TransparencyEffects.hs

@@ -1,4 +0,0 @@
-module Dodge.TransparencyEffects
-    where
-
-

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 

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

src/Dodge/Zone/Data.hs

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