Reinstate genworld concept

src/Dodge/Data.hs

@@ -199,6 +199,11 @@ data Universe = Universe
     , _uvConfig     :: Configuration
     , _uvTestString :: Universe -> [String]
     }
+data GenWorld = GenWorld
+    { _gwWorld :: World
+    , _genPlacements    :: IM.IntMap [(Placement,Int)]
+    , _genRooms         :: IM.IntMap Room
+    }
 data World = World 
     { _keys             :: S.Set Scancode
     , _mouseButtons     :: M.Map MouseButton Bool
@@ -290,8 +295,6 @@ data World = World
     , _hammers          :: M.Map WorldHammer HammerPosition
     , _backspaceTimer   :: Int
     , _genParams        :: GenParams
-    , _genPlacements    :: IM.IntMap [(Placement,Int)]
-    , _genRooms         :: IM.IntMap Room
     , _deathDelay       :: Maybe Int
     , _testFloat        :: Float
     , _lLine            :: (Point2,Point2)
@@ -497,6 +500,8 @@ makeLenses ''Nozzle
 makeLenses ''Equipment
 makeLenses ''ScreenLayer
 makeLenses ''WorldBeams
+makeLenses ''GenWorld
+
 ----- ROOM LENSES
 
 makeLenses ''Room

src/Dodge/Default/World.hs

@@ -107,8 +107,8 @@ defaultWorld = World
     , _hammers = defaultWorldHammers
     , _backspaceTimer = 0
     , _genParams = GenParams M.empty
-    , _genPlacements = IM.empty
+--    , _genPlacements = IM.empty
-    , _genRooms = IM.empty
+--    , _genRooms = IM.empty
     , _deathDelay = Nothing
     , _testFloat = 0
     , _boundBox = square 100

src/Dodge/Layout.hs

@@ -31,10 +31,10 @@ import qualified Control.Foldl as L
 import Data.Maybe
 import Data.Function
 
-generateLevelFromRoomList :: IM.IntMap Room -> World -> World
+generateLevelFromRoomList :: IM.IntMap Room -> World -> GenWorld
-generateLevelFromRoomList gr' w = initWallZoning 
+generateLevelFromRoomList gr' w = over gwWorld initWallZoning 
-    . randomCompass
+    . over gwWorld randomCompass
-    . setupWorldBounds
+    . over gwWorld setupWorldBounds
     . doAfterPlacements
     . doInPlacements
     . doOutPlacements
@@ -57,19 +57,19 @@ generateLevelFromRoomList gr' w = initWallZoning
 randomCompass :: World -> World
 randomCompass w = w & cameraRot .~ (takeOne [0,0.5*pi,pi,1.5*pi] & evalState $ _randGen w)
 
-putFloorTiles :: World -> World
+putFloorTiles :: GenWorld -> GenWorld
-putFloorTiles gw = gw & floorTiles .~ floorsFromGenWorld gw
+putFloorTiles gw = gw & gwWorld . floorTiles .~ floorsFromGenWorld gw
 
-setFloors :: World -> World
+setFloors :: GenWorld -> GenWorld
 setFloors = putFloorTiles . setTiles
 
 -- note the order of traversal of the rooms is important
 -- hence the reverse
 -- this is not ideal: should do this in some more sensible way
-setTiles :: World -> World
+setTiles :: GenWorld -> GenWorld
 setTiles gw = foldr setTile gw . reverse . IM.elems $ _genRooms gw
 
-setTile :: Room -> World -> World
+setTile :: Room -> GenWorld -> GenWorld
 setTile r gw = case _rmFloor r of
     Tiled {} -> gw
     InheritFloor -> gw & genRooms . ix (fromJust (_rmMID r)) . rmFloor .~ Tiled [t & tilePoly .~ poly]
@@ -84,43 +84,43 @@ shuffleRoomPos rm = do
     newPos <- shuffle $ _rmPos rm
     return $ rm & rmPos .~ newPos
 
-doAfterPlacements :: World -> World
+doAfterPlacements :: GenWorld -> GenWorld
 doAfterPlacements gw = foldr doAfterPlacement gw (_genPlacements gw)
 
-doAfterPlacement :: [(Placement,Int)] -> World -> World
+doAfterPlacement :: [(Placement,Int)] -> GenWorld -> GenWorld
 doAfterPlacement pmntis gw = gRandify gw $ do
     (pmnt,i) <- takeOne pmntis
     let (newgw,rm) = fst $ placeSpot (gw,_genRooms gw IM.! i) pmnt
     return $ newgw & genRooms . ix i .~ rm
 
-doInPlacements :: ( IM.IntMap [Placement],World) -> World
+doInPlacements :: ( IM.IntMap [Placement],GenWorld) -> GenWorld
 doInPlacements (im,w) = 
     let (gw,rms) = mapAccumR (doRoomInPlacements im) w (_genRooms w)
     in gw & genRooms .~ rms
 
-doRoomInPlacements :: IM.IntMap [Placement] -> World -> Room -> (World, Room)
+doRoomInPlacements :: IM.IntMap [Placement] -> GenWorld -> Room -> (GenWorld, Room)
 doRoomInPlacements im w rm = foldr f (w,rm) $ _rmInPmnt rm
   where
     f (InPlacement plf i) (w',r') = fst $ placeSpot (w',r') (plf $ im IM.! i)
 
-doOutPlacements :: World -> ( IM.IntMap [Placement], World)
+doOutPlacements :: GenWorld -> ( IM.IntMap [Placement], GenWorld)
 doOutPlacements w = let ((pmnts,gw),rms) = mapAccumR doRoomOutPlacements (IM.empty,w) (_genRooms w)
     in (pmnts,gw & genRooms .~ rms)
 
-doRoomOutPlacements :: (IM.IntMap [Placement], World) 
+doRoomOutPlacements :: (IM.IntMap [Placement], GenWorld) 
     -> Room 
-    -> ( (IM.IntMap [Placement], World) , Room )
+    -> ( (IM.IntMap [Placement], GenWorld) , Room )
 doRoomOutPlacements imw r = foldr f ( imw, r ) $ _rmOutPmnt r
   where
     f (OutPlacement pl i) ( (im,w) , rm ) = 
         let ((neww,newrm),plmnts) = placeSpot (w,rm) pl
         in ((IM.insert i plmnts im, neww) , newrm )
 
-doIndividualPlacements :: World -> World
+doIndividualPlacements :: GenWorld -> GenWorld
 doIndividualPlacements gw = let (gw', rms) = mapAccumR doRoomPlacements gw (_genRooms gw)
     in gw' & genRooms .~ rms
 
-doRoomPlacements :: World -> Room -> (World, Room)
+doRoomPlacements :: GenWorld -> Room -> (GenWorld, Room)
 doRoomPlacements w rm = foldl' (\wr -> fst . placeSpot wr) (w,rm) $ _rmPmnts rm
 
 setupWorldBounds :: World -> World
@@ -202,7 +202,7 @@ gameRoomFromRoom rm = GameRoom
 floorsFromRooms :: [Room] -> [(Point3,Point3)]
 floorsFromRooms = concatMap (concatMap tileToRenderList . getTiles . _rmFloor . doRoomShift)
 
-floorsFromGenWorld :: World -> [(Point3,Point3)]
+floorsFromGenWorld :: GenWorld -> [(Point3,Point3)]
 floorsFromGenWorld = floorsFromRooms . IM.elems . _genRooms
 
 getTiles :: Floor -> [Tile]

src/Dodge/LevelGen.hs

@@ -28,7 +28,7 @@ generateWorldFromSeed i = do
     (roomList,bounds) <- layoutLevelFromSeed 0 i
     return -- $ saveLevelStartSlot 
         $ postGenerationProcessing
-        $ generateLevelFromRoomList roomList initialWorld{_randGen=mkStdGen i}
+        $ _gwWorld (generateLevelFromRoomList roomList initialWorld{_randGen=mkStdGen i})
         & roomClipping .~ bounds
 
 postGenerationProcessing :: World -> World

src/Dodge/LevelGen/LevelStructure.hs

@@ -16,10 +16,12 @@ import qualified IntMapHelp as IM
 import qualified Data.Map.Strict as M
 --import Control.Lens
 
-worldToGenWorld :: IM.IntMap Room -> World -> World
+worldToGenWorld :: IM.IntMap Room -> World -> GenWorld
-worldToGenWorld rms w = w 
+worldToGenWorld rms w = GenWorld 
-    & genParams .~ evalState generateGenParams (_randGen w)
+    { _gwWorld = w & genParams .~ evalState generateGenParams (_randGen w)
-    & genRooms .~ rms
+    , _genRooms = rms
+    , _genPlacements = mempty
+    }
 
 generateGenParams :: RandomGen g => State g GenParams
 generateGenParams = do

src/Dodge/Placement/PlaceSpot.hs

@@ -28,7 +28,7 @@ import Data.Bifunctor
 
 -- when placing a placement, we update the world and the room and assign an id
 -- to the placement
-placeSpot :: (World,Room) -> Placement -> ( (World,Room), [Placement] )
+placeSpot :: (GenWorld,Room) -> Placement -> ( (GenWorld,Room), [Placement] )
 placeSpot (w,rm) plmnt = case plmnt of
     Placement{_plSpot = PSRoomRand i f} -> placeSpotRoomRand rm i f plmnt w
     Placement{_plSpot = PSPos extract eff fallback} -> placeSpotUsingLink w rm plmnt extract eff fallback
@@ -39,31 +39,31 @@ placeSpot (w,rm) plmnt = case plmnt of
   where
     shift = _rmShift rm
 
-placePickOne :: Int -> Placement -> Room -> World -> World
+placePickOne :: Int -> Placement -> Room -> GenWorld -> GenWorld
 placePickOne i pl rm w = w & genPlacements %~ IM.insertWith (++) i [(pl, fromJust (_rmMID rm))]
 
-placeRandomPlacement :: State StdGen Placement -> World -> Room -> ((World,Room),[Placement])
+placeRandomPlacement :: State StdGen Placement -> GenWorld -> Room -> ((GenWorld,Room),[Placement])
-placeRandomPlacement rplmnt w rm = placeSpot (w & randGen .~ g,rm) plmnt'
+placeRandomPlacement rplmnt w rm = placeSpot (w & gwWorld . randGen .~ g,rm) plmnt'
   where
-    (plmnt', g) = runState rplmnt (_randGen w)
+    (plmnt', g) = runState rplmnt (_randGen (_gwWorld w))
 
-placePlainPSSpot :: World -> Room -> Placement -> DPoint2 -> ((World,Room),[Placement])
+placePlainPSSpot :: GenWorld -> Room -> Placement -> DPoint2 -> ((GenWorld,Room),[Placement])
 placePlainPSSpot w rm plmnt shift = 
     let (i,w') = placeSpotID (shiftPSBy shift (_plSpot plmnt)) (_plType plmnt) w
         newplmnt = plmnt & plMID ?~ i
-    in maybe ((w',rm),[newplmnt]) (recrPlace newplmnt w') (_plIDCont plmnt w' newplmnt)
+    in maybe ((w',rm),[newplmnt]) (recrPlace newplmnt w') (_plIDCont plmnt (_gwWorld w') newplmnt)
   where
     recrPlace newplmnt w' pl = let (wr,newplmnts) = placeSpot (w',rm) pl
                     in (wr,newplmnt:newplmnts)
 
 -- this should be tidied up
-placeSpotUsingLink :: World 
+placeSpotUsingLink :: GenWorld 
     -> Room 
     -> Placement 
     -> (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos))
     -> (RoomPos -> Room -> Room)
     -> Maybe Placement
-    -> ((World, Room), [Placement])
+    -> ((GenWorld, Room), [Placement])
 placeSpotUsingLink w rm plmnt extract eff fallback = case searchedPoss (_rmPos rm) of
     Just (ps,rmposs) -> placeSpot (w, eff (head rmposs) $ rm & rmPos .~ rmposs) (plmnt & plSpot .~ ps)
     Nothing -> case fallback of
@@ -76,14 +76,18 @@ placeSpotUsingLink w rm plmnt extract eff fallback = case searchedPoss (_rmPos r
         Just (ps,rmpos) -> Just ( ps,rmpos:poss)
 
 placeSpotRoomRand :: Room -> Int -> (DPoint2 -> PlacementSpot) 
-    -> Placement -> World -> ((World,Room),[Placement])
+    -> Placement -> GenWorld -> ((GenWorld,Room),[Placement])
 placeSpotRoomRand rm i f plmnt w =
-    let (ps,g) = runState (_rmRandPSs rm !! i) $_randGen w
+    let (ps,g) = runState (_rmRandPSs rm !! i) $_randGen (_gwWorld w)
-    in placeSpot (w & randGen .~ g,rm) (plmnt & plSpot .~ f ps)
+    in placeSpot (w & gwWorld . randGen .~ g,rm) (plmnt & plSpot .~ f ps)
+
+placeSpotID :: PlacementSpot -> PSType -> GenWorld -> (Int, GenWorld)
+placeSpotID ps pt gw = let (i,w) = placeSpotID' ps pt (_gwWorld gw)
+    in (i,gw & gwWorld .~ w)
 
 -- the Int here is some id that is assigned when the placement is placed
-placeSpotID :: PlacementSpot -> PSType -> World -> (Int, World)
+placeSpotID' :: PlacementSpot -> PSType -> World -> (Int, World)
-placeSpotID ps pt w = case pt of
+placeSpotID' ps pt w = case pt of
     PutTrigger  cnd         -> plNewID   triggers cnd w
     PutMod      mdi         -> plNewUpID modifications mdID mdi w
     PutProp     prp         -> plNewUpID props prID (mvProp p rot prp) w
@@ -109,7 +113,7 @@ placeSpotID ps pt w = case pt of
     PutID i                 -> (i, w)
     PutWorldUpdate f        -> (0, w & f ps)
     PutUsingGenParams f     ->  let (w',pt') = f w
-                                in placeSpotID ps pt' w'
+                                in placeSpotID' ps pt' w'
   where 
     p@(V2 px py) = _psPos ps
     p' = V3 px py 0
@@ -120,7 +124,7 @@ shiftDec :: Point2 -> Float -> Picture -> Picture
 shiftDec p r pic = uncurryV translate p $ rotate r pic
 
 evaluateRandPS :: State StdGen PSType -> PlacementSpot -> World -> (Int,World)
-evaluateRandPS rgen ps w = placeSpotID ps evaluatedType (set randGen g w)
+evaluateRandPS rgen ps w = placeSpotID' ps evaluatedType (set randGen g w)
   where 
     (evaluatedType, g) = runState rgen (_randGen w)
 

src/Dodge/Randify.hs

@@ -6,6 +6,6 @@ import System.Random
 import Control.Monad.State
 import Control.Lens
 
-gRandify :: World -> State StdGen World -> World
+gRandify :: GenWorld -> State StdGen GenWorld -> GenWorld
-gRandify gw mw = let (gw',g) = runState mw (_randGen gw)
+gRandify gw mw = let (gw',g) = runState mw (_randGen $ _gwWorld gw)
-    in gw' & randGen .~ g
+    in gw' & gwWorld . randGen .~ g